Улучшенный симплекс-метод, обладает значительными преимуществами по сравнению со стандартной формой. Это относится к точности, скорости и требованиям к памяти. Большая часть этих преимуществ определяется тем фактором, что, как правило, матрицы больших линейных задач (то есть с n>m>100) являются слабозаполненными, содержат малый процент ненулевых элементов.

Обычной является плотность 5% или менее. Улучшенная форма симплекс-метода в большей степени способна использовать преимущества, вытекающие из этого факта. В этой форме характеристические разности и ведущий вектор вычисляются непосредственно по исходным данным. Поскольку исходная матрица слабозаполнена, а перемножение следует производить только тогда, когда оба сомножителя отличны от нуля, то время вычислений значительно сокращается.

В дополнение к этому использование только исходных данных приводит к тому, что уменьшается возможность накопления ошибок округления. Наоборот, стандартные симплексные таблицы, даже если они первоначально являются слабозаполненными, в ходе итеративного процесса быстро заполняются ненулевыми элементами. Таким образом, время вычислений увеличивается, и, поскольку каждая таблица вычисляется из предшествующей, накопление ошибок может начать играть более серьезную роль.

3. Математическая постановка задачи

{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 Dob 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, ' ');

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.

Заключение

Данный проект был первым, необходимым для закрепления навыков в умении программировать. Здесь были заложены основы математических методов решения задач. Будущей специализацией курсового проекта являлось разработка программы на языке TURBO PASCAL. Поэтому большее внимание уделялась следующим разделам:

Основы математических методов и их применение;

Решение задач с помощью улучшенного симплекс - метода;

Основы программирования (язык Turbo Pascal).

Пользователю предлагается ввести расчетные данные, чтобы получить конкретные характеристики.

Программа разработана на языке Turbo Pascal 7.0, что предполагает минимальные системные требования для работы с ней.

pascal симплекс листинг линейный

Список литературы