Поможем написать учебную работу
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Program Curs;
Uses Crt,dos,MyWin;
Const size=10;
mastype : mastype=('Ввод платежной матрицы','Чтение из файла',
Запись в файл','Просмотр платежной матрицы','Рассчет',
'Результаты','Выход');
Type
mmtype=array[1..size,1..size,] of integer;
mtype=array[1..size] of integer;
tr=1..3;
ftype=Record
n,m:integer;
mas;mmtype;
end;
Var
mm:mmtype;{Платежная матрица}
j,m,n:1..size;
i,z:integer;
dd:ftype;
mfile:file of ftype;
MA,MB,SA,SB:mtype;{Данные по итерациям}
pos:_dy;
v1,v2,v:real;{оценки цен игры нижняя,верхняя и средняя}
f,a:boolean;
key:char;
k:integer;{Кол-во итераций}
s:real;{Cумма игры по матрице}
Procedyre Test(Var a:boolean);
{Проверяет ошибку ввода}
Begin
If IOResult=0 then f:=false;
else a:=true;
end;
Prosedure OutputRes;
{Вывод результатов итерационного процесса на экран}
Var max,min:1..size;
Begin
Full;
ClearWin(20,10,52,18);
Window(2,9,70,21);
TextBackGround(15);
TextColor(2);
clrscr;
Gotoxy(2,2);
Write('Bероятности стратегий:');
for i:=1 to n do
Begin
Gotoxy(2,2+i);
Write('P(A',i,') : ',MA[i]/k)
end;
for i:=1 to m do
Begin
Gotoxy(42,2+i);
Write('P(B',i,') :',MB[i]/k
end;
Gotoxy(2,11);
Write('Кол-во итераций: ',k);
max:=1;
for i:=2 to n do
if SA[i]>SA[max] then max:=i;
min:=1;
for i:=2 to m do
if SB[i]>SB[max] then min:=i;
v2:=SA[max]/k;
v1:=SB[min]/k;
v:=(v1+v2)/2;
Gotoxy(2,12);
Write('оценка цены игры:',v);
Full;
Goto(2,23);
Write('Для выхода нажмите Esc');
Key:=ReadKey;
While Key<>#27 do
Begin
Key:=ReadKey;
end;
Procedure Output;
{'Вывод на экран платежной матрицы'}
Begin
for i:=1 to m do
Begin
Gotoxy(7+(i-1)*7,3);
Write('B',i);
end;
for i:=1 to n do
Begin
Gotoxy(2,5+(i-1));
Write('A',i)
end;
Window(5,5,5+m*7,4+n);
TextBackGround(15);
TextColor(2);
clrscr;
for i:=1 to m do
for j:=1 to n do
Begin
Gotoxy(3+(i-1)*7,j);
Write(MM[i,j]);
end;
end;
Procedure Input;
{Процедура ввода платежной матрицы}
Var x,y,x1,y1:byte;
f:boolean;
key:char;
Procedure DCurs(x,y:byte;f:tr);
Begin
Window((x-1)*7+5,y+4,x*7+4,y+4);
case f of
1:Begin
TextBackGround(15);
TextColor(2);
end;
2:Begin
TextBackGround(2);
TextColor(15);
end;
3:Begin
TextBackGround(2);
TextColor(Red);
end;
end;
Clrscr;
Gotoxy(3,1);
Write(MM[y,x]);
end;
Begin
{$I-}
Full;
TextBackGround(0);
TextColor(2);
CkearWin(20,10,52,18);
Gotoxy(10,10);
Write('Введите размерность платежной матрицы n*m');
Gotoxy(10,11);
Write('Максимальная размерность 10*10)');
a:=true;
While a do
Begin
ClearWin(14,20,80,12);
Gotoxy(14,12);
Write('n:');
Read(n);
Test(a);
if n>size then a:=true;
end;
a:=True;
While a do
Begin
ClearWin(14,13,80,13);
Gotoxy(14,13);
Write('m:');
read(m);
Test(a);
if m>size then a:=true;
end;
CkearWin(10,10,50,14);
Full;
Output;
x:=1;
y:=1;
DCurs(x,y,2);
F:=True;
While f do
Begin
Key:=ReadKey;
Case Key of
#72:Begin
if y=1 then y1:=n else y1:=y-1;
DCurs(x,y,1);
DCurs(x,y1,2);
y:=y1:
end;
#80:Begin
if y=n then y1:=y else y1:=y+1;
DCurs(x,y,1);
DCurs(x,y1,2);
y:=y1;
end;
#75:Begin
if x=1 then x1:=m else x1:=x-1;
DCurs(x,y.1);
DCurs(x1,y,2);
x:=x1;
end;
#77:Begin
if x=m x1:=1 else x1:=x+1;
DCurs(x,y,1);
DCurs(x1,y,2);
x:=x1;
end;
#13:Begin
a:=True;
While a do
Begin
DCurs(x,y,3);
Gotoxy(3,1);
Read(MM[y,x]);
Test(a);
end;
#27:f:=false;
end;
end;
Full;
ClearWin(1,1,5+m*7,4+n);
{$I+)
end;
Procedure FileWrite;
Begin;
{'Процедура записи данных в файл}
Assign(mfile,'mdata.txt);
Rewrite(mfile);
dd.n:=n;
dd.m:=m:
for i:=1 to n do
for j:=1 to m do
Begin
dd.mas[i,j]:=MM[i,j]
end;
Write(mfile,dd);
Close(mfile);
end;
Procedure Fileread;
Begin
{'Процедура чтения данных из файла}
{$I-}
a:=false;
Assign(mfile,'mdata.txt);
Reset(mfile);
Read(mfile.dd);
Test(a);
If not (a) Then
Begin
n:=dd.n;
m:=dd.m;
for i:=1 to n do
for j:=1 to m do
Begin
MM[i,j]:=dd.mas[i,j]
end;
end;
Close(mfile);
end;
Procedure CalcA;
Var min:1..size;
{Вычисление по данной итерации для стратегии В}
Begin
min:=1;
for j:=2 to m do if SB[j]<SB[min] then min:=j;
MB[min]:=MB[min]+1;
for j:=1 to n do SA [j]:=SA[j]+MM[j,min];
end;
Procedure CalcB;
Var max:1..size;
{Вычисление по данной итерации для стратегии А}
Begin
max:=1;
for j:=2 to n do if SA[j]>SA[max] then max:=j;
MA[max]:=MA[max]+1;
for j:=1 to m do SB[j]:=SB[j]+MM[max,j];
end;
Procedure Calculation;
{Расчет итерационного процесса}
Var d:1..size;
Begin
Full;
ClearWin(20,10,52,18);
Gotoxy(20,10);
Write('Введите кол-во итераций');
a:=True;
{$I-}
While a do
Begin
ClearWin(24,11,80,11);
Gotoxy(20,11);
Write('K:');
Read(K);
test(a);
end;
{$+}
Randomize;
d:=Round(Random(n));
MA[d]:=1;
for i:=1 to m do SB[i]:=MM[d,i];
CalcA;
For i:=1 to k-1 do
Begin
CalcB;
CalcA;
end;
end;
Begin
textbackground(0);
clrscr;
for:=1 to 29 do
Begin
gotoxy(z*40+1,i);
textcolor(7);
Write('.....');
end;
end;
f:=true;
While f do
Begin
Full;
gotoxy(20,10);
create(2,15,14,data,30,7,pos);
case pos of
1:Input;
2:FileRead;
3:FileWrite;
4:Begin;
Full;
ClearWin(20,10,52,18);
Output;
Repeat Until Keypressed;
Full;
ClearWin(1,1,5+m*7,4+n);
end;
5:Calculation;
6:OutputRes;
7:f:=false;
end;
end;
end.
Unit MyWin;
Interffce
Uses Crt;
Type
mastype=arrsy[1..7] of string[30];
color=1..15;
_dX=1..80;
_dY=1..25;
Var x:_dX;
y:_dy;
Procedure Full;
Procedure ClearWin(x1:_dx;y1:_dy;x2:_dx;y2:_dy);
Procedure Create(wc,cc,tc,:color;masinf:mastype;dX:_dX;dY:_dY;Var Pos:_dy)
Implementation
Procedure ClearWin;
Var
i:_dx;
j:_dy;
Begin
for i:=x1 to x2 do
for j:=y1 to y2 do
Begin
TextBackGround(0);
Textcolor(7);
gotoxy(i,j);
Write(' ');
end;
end;
Procedure Full;
Begin
Window(1,1,80,25);
end;
Procedure Cursor(wc,cc,tc:color;masinf:mastype;dX:_dX;dY:_dY;past,now:_dY);
Begin
window(x,y+past-1,x+dx,y+past-1);
textbackground(wc);
clrscr;
textcolor(tc);
Gotoxy(x,y+past-1);
Write(masinf[past]);
window(x,y+now-1,x+dx,y+now-1);
textbackground(cc);
clrscr;
textcolor(wc);
Gotoxy(x,y+now-1);
Write(masinf[now]);
end;
Procedure Create;
Var
i:_dy;
a:boolean;
Key:char;
Begin
x:=WhereX;y:=WhereY;
Window(X+1,Y+1,X+dX+1,Y+dY+1);
textbackground(0);
clrscr;
Window(X,Y,X+dX,Y+dY);
textbackground(wc);
clrscr;
for i:=2 to dY do
Begin
textcolor(tc);
window(x,i+y-1,x+dx,y+i-1);
textbackground(wc);
clrscr;
GotoXY(x,i+y-1);
Write(masinf[i]);
end;
Window(X,Y,X+dX,Y);
textbackground(cc);
clrscr;
textcolor(wc0;
Gotoxy(x,y);
Write(masinf[1]);
a:=True;
pos:=1;
While a do
Begin
Key:=ReadKey;
case key of
#72:if pos=1 then
Begin
pos:=dy;
Curcor(wc,cc,tc,masinf,dX,dY,pos,pos-1);
pos:=pos-1;
end;
#80: if pos dY then
Begin
pos:=1;
Curcor(wc,cc,tc,masinf,dx,xy,dy,pos);
end;
else
Begin
Cursor(wc,cc,tc,masinf,dx,dy,pos,pos+1);
pos:=pos+1
end;
#13:a:=false;
end
end
end;
end.