Математическая теория игр

Автор работы: Пользователь скрыл имя, 26 Февраля 2013 в 04:52, курсовая работа

Описание работы

Актуальность курсовой работы обусловлена тем, что математическая теория игр позволяет различным экономическим субъектам (поставщикам, руководителям организаций, конкурентам и т.д.) принимать оптимальные стратегические решения в условиях неопределенности, связанной с поведением игроков на конкурентном рынке. Руководители компаний должны помнить: если они вовремя не совершат нужный шаг, это сделают их соперники. Многие проблемы олигополистической стратегии – установление товарных цен, управление производственными мощностями, проведение маркетинговой политики, выход на новые рынки, выставление тендерных заявок и составление контрактов – можно представить в виде простых, поддающихся количественному определению игровых моделей.

Скачать архив (580.29 Кб) Сколько стоит заказать работу?

Файлы: 1 файл

математическая теория игр.doc

— 1.04 Мб (Скачать файл)

for j := 1 to 30 do begin

X[i,j] := 0;

Xnew[i,j] := 0;

end;

BS[i] := '';

Bvsp[i] := '';

ZNAC[i] := '';

end;

Kstr := StringGrid1.ColCount;

Kell := StringGrid1.RowCount;

Fm := 2;

Memo.Add('Модель для обратной задачи:');

for I:=1 to Kstr do begin

str1 := '';

for J:=1 to Kell do begin

if length(str1) > 0 then str1 := str1 + ' + ';

str1 := str1 + StringGrid1.Cells[I - 1, J - 1] + '*' + 'y' + IntToStr(J);

Xnew[I,J] := StrToFloat(StringGrid1.Cells[I - 1, J - 1]);

end;

str1 := str1 + ' >= 1';

ZNAC[I] := '>=';

if (ZNAC[I]='=') or (ZNAC[I]='>=') then PriznacY:=1;

B[I] := 1;

Memo.Add(str1);

end;

str1 := '';

for J:=1 to Kell do begin

if length(str1) > 0 then str1 := str1 + ' + ';

str1 := str1 + 'y' + IntToStr(J);

FX[J] := 1;

end;

str1 := 'F = ' + str1 + ' -> MIN';

Memo.Add(str1);

Memo.Add('');

//Memo.Add('Решение для обратной задачи:');

SIMPLEX;

Memo.Add('');

for i := round(Memo.Count * 3 / 4) to Memo.Count - 1 do begin

str1 := Memo[i];

if pos('X', str1) <> 0 then str1[pos('X', str1)] := 'Y';

Memo[i] := str1;

end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);

begin

StringGrid1.RowCount := UpDown2.Position;

end;

end.

ПРИЛОЖЕНИЕ 2

unit Unit2;

interface

uses

Classes, SysUtils;

type

MAS=array[1..30] of REAL;

MASB=array[1..30] of string[3];

MASX=array[1..30,1..30] of REAL;

var

Fo,FunctPr,B,H,Hnew,C,Cnew,CPr,CPrnew,FX:MAS;

X,Xnew:MASX;

BS,Bvsp,ZNAC:MASB;

MIN,I1,I,J,Kit,NachKell,K_st:INTEGER;

PriznacY,KLstr,KLst,dop_X:INTEGER;

P,P1,Mo,F0,Epsilon:REAL;

VSP,S:string;

F:TEXT;

DPx,DPy,Fm,Kell,Kstr:INTEGER;

Memo: TStrings;

procedure SIMPLEX;

implementation

function SIMVB(V:INTEGER;S:CHAR):string;

var

M,Z:string;

begin

STR(V,M);

Z:=S+M;

SIMVB:=Z;

end;

procedure SAVE(K:string);

begin

Memo.Add(K);

end;

procedure doP_PER;

begin

if ZNAC[I1]='=' then begin

Kell:=Kell+1;

Bvsp[Kell]:=SIMVB(DPy,'Y');

DPy:=DPy+1;

Xnew[I1,Kell]:=1;

if Fm=1 then FX[Kell]:=-1 else FX[Kell]:=1;

FunctPr[Kell]:=1;

for I:=1 to Kstr do

if I<>I1 then Xnew[I,Kell]:=0;

end;

if ZNAC[I1]='>=' then begin

Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPx,'X');

DPx:=DPx+1;dop_X:=dop_X+1;

Xnew[I1,Kell]:=-1;FX[Kell]:=0;

for I:=1 to Kstr do

if I<>I1 then Xnew[I,Kell]:=0;

Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPy,'Y');

DPy:=DPy+1;

Xnew[I1,Kell]:=1;

if Fm=1 then FX[Kell]:=-1 else FX[Kell]:=1;

FunctPr[Kell]:=1;

for I:=1 to Kstr do

if I<>I1 then Xnew[I,Kell]:=0;

end;

if ZNAC[I1]='<=' then begin

Kell:=Kell+1;Bvsp[Kell]:=SIMVB(DPx,'X');

DPx:=DPx+1;dop_X:=dop_X+1;

Xnew[I1,Kell]:=1;FX[Kell]:=0;

for I:=1 to Kstr do

if I<>I1 then Xnew[I,Kell]:=0;

end;

procedure SOKR;

var

P:INTEGER;

begin

Kell:=Kell-1;

for P:=NachKell+doP_X to Kell do

if Bvsp[P]=BS[KLstr] then begin

for J:=P to Kell do

Bvsp[J]:=Bvsp[J+1];

FunctPr[J]:=FunctPr[J+1];

Fx[J]:=Fx[J+1];

for I:=1 to Kstr do

Xnew[I,J]:=Xnew[I,J+1]

end;

procedure SIMPLEX;

label NACH, endSim;

var

iNew, jNew, priz: integer;

begin

NachKell:=Kell;

DPx:=Kell+1;DPy:=1;

Epsilon:=0.00001;

for J:=1 to Kell do Bvsp[J]:=SIMVB(J,'X');

for I1:=1 to Kstr do doP_PER;

MIN:=0;

if (Fm=1) and (PriznacY=1) then begin

MIN:=Fm;Fm:=2;

for J:=1 to Kell do FX[J]:=-FX[J];

end;

for I1:=NachKell+1 to Kell do

for J:=I1+1 to Kell do

if Bvsp[J]<Bvsp[I1] then begin

VSP:=Bvsp[J];Bvsp[J]:=Bvsp[I1];Bvsp[I1]:=VSP;

P:=FX[J];FX[J]:=FX[I1];FX[I1]:=P;

P:=FunctPr[J];FunctPr[J]:=FunctPr[I1];FunctPr[I1]:=P;

for I:=1 to Kstr do begin

P:=Xnew[I,I1];Xnew[I,I1]:=Xnew[I,J];Xnew[I,J]:=P;

end;

Kit:=1;

for I:=1 to Kstr do begin

Hnew[I]:=B[I];

for J:=NachKell+1 to Kell do

if Xnew[I,J]=1 then begin

BS[I]:=Bvsp[J];

Cnew[I]:=FX[J];

CPrnew[I]:=FunctPr[J];

end;

NACH:;

REPEAT

PriznacY:=0;

for I:=1 to Kstr do begin

if INT(10000*Hnew[I])=0 then H[I]:=+0 else H[I]:=Hnew[I];

C[I]:=Cnew[I];

CPr[I]:=CPrnew[I];

if BS[I][1]='Y' then PriznacY:=1;

for J:=1 to Kell do

if INT(10000*Xnew[I,J])=0 then X[I,J]:=+0 else X[I,J]:=Xnew[I,J];

end;

for J:=1 to Kell do Fo[J]:=0;

F0:=0;

for J:=1 to Kell do Fo[J]:=0;

for I1:=1 to Kstr do begin

if PriznacY=1 then

if BS[I1][1]='Y' then begin

F0:=F0+H[I1];

for J:=1 to Kell do Fo[J]:=Fo[J]+X[I1,J];

end;

if PriznacY=0 then begin

F0:=F0+H[I1]*C[I1];

for J:=1 to Kell do Fo[J]:=Fo[J]+C[I1]*X[I1,J];

end;

for J:=1 to Kell do

if Bvsp[J][1]='Y' then Fo[J]:=+0

else if ABS(Fo[J])<Epsilon then Fo[J]:=+0;

end;

for J:=1 to Kell do

if PriznacY<>1 then Fo[J]:=Fo[J]-FX[J];

P:=0;

for J:=1 to Kell do

if Fm=1 then

if Fo[J]<-Epsilon then begin

P:=1;

CONTINUE;

end

else

else if Fo[J]>Epsilon then begin

P:=1;

CONTINUE;

end;

if P<>1 then begin

if MIN=1 then begin

F0:=-F0;

Fm:=MIN;

end;

if Fm=1 then begin

SAVE('');

SAVE('Пропорция товаров:');

for jNew := 1 to Kell do begin

iNew := 1;

priz := 0;

while BS[iNew] <> '' do begin

if BS[iNew] = 'X' + IntToStr(jNew) then begin

SAVE(FloatToStr(H[iNew] / F0));

priz := 1;

end;

iNew := iNew + 1;

end;

if priz = 0 then SAVE(FloatToStr(0));

end;

end

else begin

SAVE('');

SAVE('Состояния спроса будут наблюдаться с частотами:');

for jNew := 1 to Kell do begin

iNew := 1;

priz := 0;

while BS[iNew] <> '' do begin

if BS[iNew] = 'X' + IntToStr(jNew) then begin

SAVE(FloatToStr(H[iNew] / F0));

priz := 1;

end;

iNew := iNew + 1;

end;

if priz = 0 then SAVE(FloatToStr(0));

end;

SAVE('');

SAVE('Средняя прибыль на вложенную денежную единицу: ' + FloatToStr(1/F0))

end;

//for I1:=1 to Kstr do begin

// SAVE(BS[I1] + '=' + FloatToStr(H[I1]));

//end;

goto endSim;

end;

KLst:=1;Mo:=0;

for J:=1 to Kell do

if Fm=1 then

if Fo[J]<Mo then Mo:=Fo[J];

for J:=1 to Kell do begin

if Bvsp[J][1]<>'Y' then

if Fm=1 then begin

if Fo[J]<0 then

if Fo[J]>=Mo then begin

Mo:=Fo[J];

KLst:=J;

end;

end

else begin

if Fo[J]>0 then

if Fo[J]>=Mo then

begin

Mo:=Fo[J];

KLst:=J;

end;

P1:=0;K_st:=0;

for J:=1 to Kell do

if ABS(Mo-Fo[J])<Epsilon then begin

K_st:=K_st+1;

for I:=1 to Kstr do

if X[I,KLst]>0 then begin

B[I]:=H[I]/X[I,KLst];

P:=B[I];

KLstr:=I;

end

else begin

B[I]:=-1;

P1:=P1+1;

end;

P1:=0;

for J:=1 to Kell do

if ABS(Mo-Fo[J])<Epsilon then

for I:=1 to Kstr do

if B[I]>=0 then begin

if B[I]<P then if Bvsp[KLst]<>BS[I] then begin P:=B[I]; KLstr:=I; end;

if INT(10000*B[I])=INT(10000*P) then

if (BS[I][1]='Y') and (BS[KLstr][1]='X') then

if Bvsp[KLst]<>BS[I] then begin P:=B[I]; KLstr:=I; end;

end;

if CPr[KLstr]=1 then SOKR;

BS[KLstr]:=Bvsp[KLst];

Cnew[KLstr]:=FX[KLst];

CPrnew[KLstr]:=FunctPr[KLst];

for I:=1 to Kstr do begin

if I=KLstr then Hnew[I]:=H[I]/X[KLstr,KLst]

else Hnew[I]:=H[I]-(H[KLstr]*X[I,KLst]/X[KLstr,KLst]);

for J:=1 to Kell do begin

if (I=KLstr) and (J=KLst) then Xnew[I,J]:=1;

if (I=KLstr) and (J<>KLst) then Xnew[I,J]:=X[I,J]/X[KLstr,KLst];

if (I<>KLstr) and (J=KLst) then Xnew[I,J]:=0;

if (I<>KLstr) and (J<>KLst) then Xnew[I,J]:=X[I,J]-(X[KLstr,J]*X[I,KLst]/X[KLstr,KLst]);

end;

KLst:=0;KLstr:=0;

Kit:=Kit+1;

until (Kit=0);

endSim:;

end;

end.

Информация о работе Математическая теория игр