Вопрос # 4 237: …ксперты! А вы сможете немного помочь? У меня есть код симплекс метода… (Прочее)

Здравствуйте, уважаемые эксперты!
А вы сможете немного помочь? У меня есть код симплекс метода, но там выдаются ошибки, в программировании я очень слаба, его косяки нужно немного поправить. Он написан на паскале, на делфи это будет очень трудно переделать? я посмотрела, вроде синтаксис такой же...
Это вопрос жизни и смерти((((

Приложение:

{ Reshenie zadachi lin prog-ya modifiz simplex-metodom }
Program Simpl_ST;
uses crt;
label 500, 1800, 1900, 2000, Zikl,{} 2500, 1960;
const M1_K = 30; M2_K = 30; P_K = 30; M_K = 30;
var i, j, k, zz, GC, EC, LC, N, MM, M, MK, N1, P, M1, M2, N0: integer;
A: array[1..M2_K,0..P_K] of integer;
B: array[1..M2_K,0..M1_K] of integer;
BS: array[1..M_K] of integer;
V: array[1..M2_K] of integer;
NB, SL, C: array[1..P_K] of integer;
PB, PA, L, ML, NI, SS: integer;
Zero, NILL, MIN, RT, DF: real;
S, PV, R: integer;
P_str, PE_str: string;
cc: integer;
Dop: boolean;
buf:array[1..36] of byte absolute 0:$41a;
procedure clearkeybuf;{ ochistka bufera klaviatury}
begin
inline($fa); {cli - preryvaniya nado zapretit pri }
buf[1] := buf[3]; { vmeshatelstve v bufer }
inline($fb); {sti }
end;
procedure Init;
begin
for i:=1 to M2_K do for j:=0 to P_K do A[i,j]:=0;
end;
function DelZero(X: Real): string;{Udalenie nulei posle zapyatoi}
var i, l, sp: integer;
Drob, Space: boolean;
Xst, Res: string;
begin
Xst:=''; Drob:=False;
Str(X:13:10, Xst);
for i:=1 to Length(Xst) do if Xst[i]='.' then Drob:=True;
if Drob then begin
for i:=Length(Xst) downto 1 do begin
if Xst[i]='0' then Xst[i]:='Z';
if Xst[i]='.' then begin Xst[i]:='Z'; Break end;
if Xst[i] in ['1'..'9'] then Break;
{case XS[j] of
'0': XS[j]:='Z';
'.': XS[j]
1..9: Break;
end; }
end;
for i:=1 to Length(Xst) do if Xst[i]='Z' then begin l:=i;Break end;
Res := Copy(Xst,1,l-1);
end
else Res := Xst;
Space := False;
for i:=1 to Length(Res) do if Res[i]=' ' then
begin l:=i; Space := True end; {del spaces}
if Space then Res := Copy(Res,l+1,Length(Res)-l);
{sp:=0;
for i:=1 to Length(Res) do begin
if Res[i] = ' ' then inc(sp);
end;
if (X>=0)and(sp=0) then Res := ' ' + Res; }
if X >= 0 then Res := ' ' + Res;
DelZero := Res;
end;
procedure Gosub9000;
var PE, PEint: real;
PC, PD: integer;
MID, RIGHT: string;
begin
PC := round(int(PB/100));
P_str:='';
if PC=0 then write(' ') else write(Copy(P_str,1,PC)); { LEFT$(P$,PC) }
PC := PB - 100*PC;
PD := round(int(PC/10));
PC := PC - 10*PD;
if PD = 0 then PD := 1;
if PA < 0 then P_str := P_str+'-';
PE := abs(PA); { A^X=EXP(X*LN(A)) }
PE := PE + 5 * EXP((-1-PC)*LN(10)); { PE := PE + 5*10^(-1-PC) }
if PE >= EXP(PD*LN(10)) then begin write(PA); Exit end; { PE>=10^PD }
{Str(PE:13:10, PE_str); { Copy(Str,1,N); Left }
PEint := int(PE);
PE_str:=DelZero(PEint);
MID := Copy(PE_str,2,PD);{ MID$(PE_str,2,PD) }
P_str := P_str + MID;
{PRINT RIGHT$(P$,PD+1)}
RIGHT := Copy(P_str,Length(P_str)-(PD+1)+1,PD+1);
GotoXY(WhereX+3,WhereY);
write(RIGHT); { RIGHT$(P$,PD+1) Copy(Astr,Length(Astr)-N+1,N); Right }
if PC = 0 then Exit;
write('.');
PE:=int((PE-int(PE)) * EXP(PC*LN(10)));
P_str:='000000000';
PE_str:=DelZero(PE);
{PE_str := KillZero(PE_Str);}
{P_str:=P_str+Copy(KillZero(PE_str),2,PC);}
MID := Copy(PE_str,2,PC);
P_str := P_str + MID;
RIGHT := Copy(P_str,Length(P_str)-PC+1,PC);{RIGHT(P$,PC) }
write(RIGHT,' ');
end;
procedure Gosub3000;
begin
write('Bazis Znachenie ');
for j:=1 to N+3 do write(' X',j,' ');
writeln;
PB := 122;
for i:=1 to ML do begin
if i=M1 then write(' tselev func');
if i=M2 then write(' iskust func');
if (i<>M1)and(i<>M2)then begin write(' ',i,' '); PA:=A[i,0]; Gosub9000 end;
for j:=0 to N0 do begin
PA:=A[i,j];
Gosub9000;
end;
writeln(' ');
end;
write(' ');
end;
procedure Gosub3500;
begin
If L=1 then writeln('ETAP 1 vsyo esho prodolzhaetsya');
PB:=122;
for j:=1 to N0 do write(' C',j,' ');
writeln;
for j:=1 to N0 do begin PA:=C[j]; Gosub9000 end;
writeln;
if SS<>1 then writeln('X',S,' Vhodit B,X',BS[R],' v uslovii ',R,' vyveden iz bazisa');
writeln('Bazis Znachenie Obrashenie Bazisa');
if SS=1 then write(' ');
{write(' A'iS');}
for i:=1 to ML do begin
if i=M1 then write('Reshenie dlya tselevoy functii');
if i=M2 then write('Reshenie dlya iskustven functii');
if (i<>M1)and(i<>M2) then write(' ',BS[i]);
for j:=0 to M do begin
PA:=B[i,j];
Gosub9000;
end;
if SS<>1 then begin PA:=V[i]; Gosub9000 end;
writeln(' ');
end;
writeln(' ');
end;
begin
clearkeybuf;
Init;
textbackground(0); textcolor(15);
clrscr;{promezhut tablitsa pri zz = +1 vyvod, -1 net }
writeln('Reshenie zadachi lin prog-ya simplex-metodom');
{write('Vvedite zz '); readln(zz);} zz:=1;
{Vvesti kol-vo vidov ogranicheniy i kolvo peremennyh}
{write('Vvedite cherez probel GC, EC, LC, N ');
Readln(GC, EC, LC, N); { 2, 0, 2, 2 }
GC:=0; EC:=0; LC:=3; N:=2;
MM:=GC+EC; M:=MM+LC; MK:=GC+LC; N1:=MK+N;
P:=N1+MM; M1:=M+1; M2:=M+2; N0:=N1;
{Vvesti koeff-ty dlya ogranicheniy i tselevoy functii}
{matriza: vvodit stroku matrizy cherez probel,v konze stroki press Enter}
{writeln('Input matrix ',M1, 'x', N);
for i:=1 to M1 do begin
for j:=1 to N do read(A[i,j]);
readln;
end; }
A[1,1]:=1; A[1,2]:=-2; A[2,1]:=2; A[2,2]:=-1; A[3,1]:=1; A[3,2]:=1;
A[4,1]:=-3; A[4,2]:=1; {A[5,1]:=0; A[5,2]:=0; }
{ vyvod matrix na ekran }
writeln('Matrix ',M1,'x',N);
for i:=1 to M1 do begin
for j:=1 to N do write(A[i,j],' ');
writeln;
end;
cc := 0;
{Zadat oslablennye, iskustvenye peremennye, pometit bazis i vvesti
peremennye v nulevoi stolbez}
writeln('Zadaite oslablennye, iskustvennye peremennye'); { 10, 5, 20, 20 }
if GC <> 0 then begin
for i:=1 to GC do begin {1 2}
A[i,N+1]:=-1; A[i,N1+i]:=1; B[M2,i]:=-1;
B[i,i]:=1; A[M2,N1+i]:=1; BS[i] := N1+i;
write(' ? ');read(A[i,0]); B[i,0]:=A[i,0]
{ if i=1 then A[i,0]:=10;
if i=2 then A[i,0]:=5; }
{ inc(cc) }
end
end;
if EC <> 0 then begin
for i:=GC+1 to MM do begin
A[i,N1+i]:=1; B[i,i]:=1; A[M2,N1+i]:=1;
BS[i]:=N1+i; B[M2,i]:=-1; write(' ? ');read(A[i,0]);
B[i,0]:=A[i,0]
{inc(cc); }
end;
end;
if LC <> 0 then begin
for i:=MM+1 to M do begin {3 4}
A[i,N+i-EC]:=1; B[i,i]:=1; BS[i]:=N+i-EC; write(' ? '); read(A[i,0]);
B[i,0]:=A[i,0]
{ if i=3 then A[i,0]:=20;
if i=4 then A[i,0]:=20; }
{inc(cc);}
end;
end;
if MM = 0 then writeln('Otsutstvuet ETAP 1 resheniya zadachi ');
{writeln(cc);}
{Zadat iskustvenuyu function for ETAP 1 }
L := 1; N0 := P; { N0 yavlyaetsya nomerom nuzhnogo stolbza }
for i:=1 to MM do B[M2,0] := B[M2,0] - B[i,0];
ML:=M1+L; { ML=M+2 dlya ETAPA 1; ML=M+1 dlya ETAPA 2 }
if zz >= 0 then writeln('Pervonachalnaya tabliza');
Gosub3000;
{Repeat until keypressed;}
{ Vyhod iz progi }
{Pometit nebazisnye peremennye, NB[j]=0, esli j-nebazisnaya peremennaya}
for i:=1 to M do NB[BS[i]]:=1;
Zero := 0.00000001; NILL := 1E-20;
{Exit; { Halt(0) }
{ Naiti naimenshiy koef-t v stroke zelevoy functii, t.e. stroku ML }
500: MIN := -Zero; S:=0; PV:=0; ML:=M1+L;
for j:=1 to N0 do begin
C[j]:=0;
if NB[j] <> 1 then begin
{ Vychislit C[j] }
for i:=1 to M do C[j]:=C[j]+B[ML,i]*A[i,j];
C[j]:=C[j]+A[ML,j];
if C[j]<MIN then begin MIN:=C[j]; S:=j end
end
end;
{ Esli S = 0, to vse koef-ty polozhitelny i minimum naiden }
if S = 0 then goto 1900;
{ Naiti stroku peremennyh, kotoruyu sleduet iskluchit iz bazisa
po usloviyu minimuma BI/A'[iS] }
MIN := 1E20; R:=0;
{Vychislit A'[iS] i pomestit v stolbez V }
for i:=1 to M1 do begin
V[i]:=0;
for k:=1 to M1 do V[i]:=V[i]+B[i,k]*A[k,s]
end;
V[ML]:=C[S];
for i:=1 to M do begin
if V[i]<=Zero then Continue;
k:=0;
Zikl:
RT:=B[i,k]/V[i];
DF:=RT-MIN;
if DF<0 then begin
R:=i;
MIN:=B[i,0]/V[i];
Continue
end;
if DF<>0 then Continue;
k:=k+1;
MIN:=B[R,k]/V[R];
goto Zikl
end; {NEXT i}
{ Esli R = 0, to imeet mesto reshenie bez ogranicheniy }
if R = 0 then goto 1800;
if zz>=0 then Gosub3500;
Repeat Until keypressed; {pervoe reshenie}
{ Obnovit obratnyi i simplex- mnozhiteli }
PV := V[R];
for j:=0 to M1 do B[R,j]:=Round(B[R,j]/PV);
{ Perenaznachit B povtorno pometit bazisnye i nebazisnye peremennye }
NB[BS[R]]:=0; NB[S]:=1; BS[R]:=S; NI:=NI+1;
Goto 500;
1800: writeln('Peremennaya "S" ne imeet ogranicheniy ');
Gosub3500; readkey;
Goto 2500;
1900:if L=0 then Goto 2000;
{ Dlya ETAPA 2 eta tochka yavl-sya minimumom. Esli my nahodimsya na ETAPE 1,
to pereiti k ETAPU 2, proverit, chto W stalo ravno 0 }
if abs(A[ML,0]) >= 1E-08 then Goto 1960;
writeln('ETAP 1 uspeshno zavershon');
L:=0; N0:=N1; { Zadat L i nomer stolbza dlya ETAPA 2 }
Goto 500;
1960: writeln('Ogranicheniya ne imeyut dopustimogo resheniya');
writeln('summa iskustvennyh peremennyh ravna ',-B[ML,0]);
Gosub3500;
2000:writeln('Okonchatelnoe reshenie');
writeln('Ogranichenie Bazis Znachenie');
PB := 144;
for i:=1 to M do begin
SL[BS[i]]:=B[i,0];
write(' ',i,' ',BS[i],' ');
PA:=B[i,0];
Gosub9000;
writeln(' ');
end;
writeln('Minimum functii Z raven ',-B[M1,0]);
writeln('Ogranichenie Sostoyanie Dopolnitelnye peremennye');
for i:=1 to M do begin
Dop:=False;
write(' ',i,' ');
if (i>GC)and(i<=MM) then begin write('Uravnenie ne resheno');Continue end;
if NB[N+i]=1 then begin write(' dopoln.perem. '); Dop:=True end;
PA:=SL[N+i];
Gosub9000;
write(' '); {Continue; }
if not Dop then begin gotoXY(whereX-8,WhereY);writeln('Ogranichenie 0') end else writeln;
end; writeln;
SS:=1;
Gosub3500;
2500:writeln('The End.');
Clearkeybuf;
Repeat until keypressed
end.