Линейное программирование

Приложение №2

PROGRAM SIMPLEX_METOD;

USES CRT;

LABEL ZN,ST,ELL,_END;

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,Kx,Ky,Kit,NachKell,NachY,K_st:INTEGER;

PriznacY,KLstr,KLst,ErrCode,Dop_X:INTEGER;

P,P1,Mo,F0,

Epsilon,Z:REAL;

VSP,S,PrGomory:STRING;

F:TEXT;

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

{ Функция создания индексов }

FUNCTION SIMVB(V:INTEGER;S:CHAR):STRING;

VAR M,Z:STRING;

BEGIN

STR(V,M);

Z:=S+M;

SIMVB:=Z;

END;

{ Процедура записи данных в файл }

PROCEDURE SAVE(X1:REAL;K:STRING;Mstr:INTEGER);

VAR V:STRING;

BEGIN

ASSIGN(F,'SIMPLEX.DAT');

APPEND(F);

CASE Mstr OF

0:WRITELN(F,'');

1:BEGIN

IF K=' ' THEN STR(X1:1:0,V) ELSE STR(X1:10:4,V);

WRITE(F,V);

WRITE(F,' ');

END;

2:WRITE(F,K);

3:WRITELN(F,K);

END;

CLOSE(F);

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;

END;

{ Процедура сокращения Y }

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;

END;

{ Процедура, выполняющая метод Гомори }

PROCEDURE GOMORY;

VAR MAX,Z:REAL;

BEGIN

KLstr:=1;

MAX:=H[1]-INT(H[1]);

FOR I1:=2 TO Kstr DO

IF (H[I1]-INT(H[I1]))>=MAX THEN BEGIN MAX:=H[I1]; KLstr:=I1;END;

Kstr:=Kstr+1;

Hnew[Kstr]:=H[KLstr]-INT(H[KLstr]);

FOR I1:=1 TO Kell DO

BEGIN

Z:=INT(X[KLstr,I1]);

IF X[KLstr,I1]<0 THEN Z:=Z-1;

Xnew[Kstr,I1]:=X[KLstr,I1]-Z;

END;

ZNAC[Kstr]:='>=';

END;

{ Процедура, выполняющая Симплекс метод }

PROCEDURE SIMPLEX;

LABEL POVZNAC,NACH;

BEGIN

{ Подготовка к вводу данных }

NachKell:=Kell;

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

Kx:=1;Ky:=4;

Epsilon:=0.00001;

CLRSCR;

WRITELN('Введите систему уравнений:');

WRITELN('(коэффициенты при всех Х,знак и свободные члены)');

{ Ввод данных }

FOR I:=1 TO Kstr DO

BEGIN

POVZNAC:

WRITELN('Введите ',I,'-е уравнение:');

{ Ввод коэффициентов при X в I-том уравнении }

FOR J:=1 TO Kell DO

BEGIN

GOTOXY(Kx,Ky);Kx:=Kx+6;

READLN(Xnew[I,J]);

END;

{ Ввод знака в I-том уравнении }

Kx:=Kx+6;GOTOXY(Kx,Ky);READLN(ZNAC[i]);

{Проверка введенного знака на правильность}

IF (ZNAC[i]<>'>=') AND (ZNAC[i]<>'=') AND (ZNAC[i]<>'<=')

THEN BEGIN

WRITELN('Неправильно задан знак');

Ky:=Ky+3;Kx:=1;

GOTO POVZNAC;

END;

IF (ZNAC[i]='=') OR (ZNAC[i]='>=') THEN PriznacY:=1;

{ Ввод свободного члена в I-том уравнении }

Kx:=Kx+6;GOTOXY(Kx,Ky);READ(B[i]);

Kx:=1;

Ky:=Ky+2;

END;

WRITELN('Введите коэффициенты при Х в целевой функции:');

{ Ввод коэффициентов при Х в целевой функции }

FOR J:=1 TO Kell DO

BEGIN

GOTOXY(Kx,Ky);Kx:=Kx+6;

READ(FX[J]);

End;

{ Подготовка индексации X }

FOR J:=1 TO Kell DO

Bvsp[J]:=SIMVB(J,'X');

{ Определение дополнительных переменных }

FOR I1:=1 TO Kstr DO

DOP_PER;

{ Замена оптимальной функции с MAX на MIN при наличии

в базисе Y-ков если идет исследование на минимум }

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;

END;

Kit:=1;

CLRSCR;

{ Подготовка столбцов C,B,H }

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;

END;

NACH:;

REPEAT

PriznacY:=0;

{ Передача данных в исходные переменные c обнулением

чисел, модулю меньших чем 0.00001 }

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;

{ Обнуление и вывод индексации элементов индексной строки }

SAVE(0,' C Б H ',2);

FOR J:=1 TO Kell DO

BEGIN

SAVE(0,Bvsp[J],2);

P1:=LENGTH(Bvsp[J]);

IF P1=2 THEN SAVE(0,' ',2);

SAVE(0,' ',2);

Fo[J]:=0;

END;

SAVE(0,'',0);

{ Вывод Симплекс-таблицы }

P1:=0;

FOR I:=1 TO Kstr DO

BEGIN

IF CPr[i]=1 THEN

IF C[i]<0 THEN SAVE(0,'-M ',2)

ELSE SAVE(0,'+M ',2)

ELSE SAVE(C[i],'',1);

SAVE(0,BS[i],2);

P1:=LENGTH(BS[i]); IF P1=2 THEN SAVE(0,' ',2);

SAVE(0,' ',2);SAVE(H[i],'',1);

FOR J:=1 TO Kell DO

SAVE(X[I,J],'',1);

SAVE(0,'',0);

END;

{ Вычисление значений в индексной строке }

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;

{ Вывод значений целевой функции }

SAVE(0,' ',2);SAVE(F0,'',1);

FOR J:=1 TO Kell DO

BEGIN

IF PriznacY<>1 THEN Fo[J]:=Fo[J]-FX[J];

SAVE(Fo[J],'',1);

END;

SAVE(0,'',0);

{ Проверка условия оптимальности }

 Скачать реферат