Автор работы: Пользователь скрыл имя, 06 Января 2011 в 12:10, реферат
Решение задач математического программирования при помощи симплекс-метода традиционными способами требует затрат большого количества времени. В связи с бурным развитием компьютерной техники в последние десятилетия естественно было ожидать, что вычислительная мощность современных ЭВМ будет применена для решения указанного круга задач.
Bvsp[Kell]:=MakeIndex (DPy, 'Y');
DPy:=DPy+1;
Xnew[I1,Kell]:=1;
if MinMax=1 then FX [Kell]:=-1
else FX [Kell]:=1;
FunctPr[Kell]:=1;
for I:=1 to SNom do
if I<>I1 then Xnew [I,Kell]:=0;
end;
if ZNAC[I1]='>=' then
begin
Kell:=Kell+1;
Bvsp[Kell]:=MakeIndex(DPx,'X')
DPx:=Dpx+1; Dop_X:=Dop_X+1;
Xnew[I1,Kell]:=-1; FX[Kell]:=0;
for I:=1 to SNom do
if I<>I1 then Xnew[I,Kell]:=0;
Kell:=Kell+1;
Bvsp[Kell]:=MakeIndex(DPy,'Y')
DPy:=DPy+1;
Xnew[I1,Kell]:=1;
if MinMax=1 then FX[Kell]:=-1
else FX[Kell]:=1;
FunctPr[Kell]:=1;
for I:=1 to SNom do
if I<>I1 then Xnew[I,Kell]:=0;
end;
if ZNAC[I1]='<=' then
begin
Kell:=Kell+1;
Bvsp[Kell]:=MakeIndex(DPx,'X')
DPx:=DPx+1; Dop_X:=Dop_X+1;
Xnew[I1,Kell]:=1; FX[Kell]:=0;
for I:=1 to SNom do
if I<>I1 then Xnew[I,Kell]:=0;
end;
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 SNom do Xnew[I,J]:=Xnew[I,J+1];
end;
end;
procedure OPER;
var
MAX, Z:real;
begin
KLstr:=1;
MAX:=H[1]-INT(H[I1]);
for I1:=2 to SNom do
if (H[I1]-int(H[I1]))>=MAX then
begin
MAX:=H[I1];
KLstr:=I1;
end;
SNom:=SNom+1;
Hnew[SNom]:=H[KLstr]-INT(H[
for I1:=1 to Kell do
begin
Z:=INT(X[KLstr,I1]);
if X[KLstr,I1]<0 then Z:=Z-1;
Xnew[SNom,I1]:=X[KLstr,I1]-Z;
end;
ZNAC[SNom]:='>=';
end;
begin
clrscr;
Kit:=0;
Dop_X:=0;
Kx:=1;
Ky:=3;
enter;
for J:=1 to Kell do Bvsp[J]:=MakeIndex(J,'X');
for I1:=1 to SNom do DOP_PER;
MIN:=0;
if (MinMax=1) and (PriznacY=1) then
begin
MIN:=MinMax;
MinMax:=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 SNom do
begin
P:=Xnew[I,I1];
Xnew[I,I1]:=Xnew[I,J];
Xnew[I,J]:=P;
end;
end;
Kit:=1;
clrscr;
for I:=1 to SNom 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;
end;
NACH:;
repeat
PriznacY:=0;
for I:=1 to SNom do
begin
if INT(10000*Hnew[I])=0 then H[I]:=+0
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
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 SNom 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 MinMax=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
writeln('В ', Kit,'-й итерации было получено оптимальное решение');
for I1:=1 to SNom do
if BS[I1][1]='Y' then
begin
writeln('Но так как из базиса не введены все Y, то ');
writeln('можно сделать вывод, что РЕШЕНИЙ НЕТ');
exit;
end;
for I:=1 to SNom do
begin
Z:=round(H[I]);
if ABS(Z-H[I])<Epsilon then H[I]:=round(H[I]);
for J:=1 to Kell do
begin
if X[I,J]<0 then Z:=round(X[I,J]);
if ABS (Z-X[I,J])<Epsilon then X[I,J]:=round(X[I,J]);
end;
end;
P1:=0;
for I:=1 to SNom do
begin
if INT(10000*FRAC(H[I]))<>0 then
begin
P1:=1;
continue;
end;
for J:=1 to Kell do
if BS[I]=Bvsp[J] then
for I1:=1 to SNom do
if ABS (FRAC(X[I1,J]))>=Epsilon then
begin
P:=1;
continue;
end;
end;
if (PrOper='Y') and (P1=1) then
begin
oper;
NachKell:=Kell;
I1:=SNom; DPy:=1;
DOP_PER;
BS[SNom]:=Bvsp[Kell];
CPrnew[SNom]:=FunctPr[Kell];
Cnew[SNom]:=FX[Kell];
goto NACH;
end;
if P1=0 then writeln('Решение целочисленное.');
if MIN=1 then
begin
F0:=-F0;
MinMax:=MIN;
end;
KLst:=1; Mo:=0;
for J:=1 to Kell do
if MinMax=1 then
if Fo[J]<Mo then Mo:=Fo[J];
for J:=1 to Kell do
begin
if Bvsp[J][1]<>'Y' then
if MinMax=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;
end;
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 SNom 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;
end;
if P1=SNom*K_st then
begin
writeln('Решений нет, так как невозможно определить ключевую строку');
exit;
end;
P1:=0;
for J:=1 to Kell do
if ABS (Mo-Fo[J])<Epsilon then
for I:=1 to Snom 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;
for I:=1 to SNom do
if Bvsp[KLst]=BS[I] then
begin
writeln('Решений нет, так как в базисном столбце уже есть ');
writeln('такая переменная.');
exit;
end;
if CPr[KLstr]=1 then SOKR;
BS[KLstr]:=Bvsp[KLst];
Cnew[KLstr]:=FX[KLst];
CPrnew[KLstr]:=FunctPr[KLst];
for I:=1 to SNom do
begin
if I=KLstr then Hnew[I]:=H[I]/X[KLstr,KLst]
else Hnew[I]:=H[I]-(H[KLstr]*X[I,