Курсовая работа: Линейное программирование

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);

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

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

 SAVE(0,'В ',2);SAVE(Kit,' ',1);

 SAVE(0,'-й итерации было получено оптимальное решение',3);

 SAVE(0,'т.к. при исследовании на ',2);

 IF Fm=1 THEN

 SAVE(0,'МАКСИМУМ индексная строка не содержит отицательных элементов.',3)

 ELSE

 SAVE(0,'МИНИМУМ индексная строка не содержит положительных элементов.',3);

 FOR I1:=1 TO Kstr DO

 IF BS[I1][1]='Y' THEN

 BEGIN

 SAVE(0,'Но т.к. из базиса не выведены все Y, то ',3);

 SAVE(0,'можно сделать вывод, что РЕШЕНИЙ НЕТ',3);

 HALT;

 END;

{округление значений массива Х до целого числа, если разность округленного и обычного значений по модулю меньше чем 0.00001}

FOR I:=1 TO Kstr 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 Kstr 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 Kstr DO

 IF ABS(FRAC(X[I1,J]))>=Epsilon THEN BEGIN P1:=1;CONTINUE; END;

 END;

 { Составление новой базисной строки для целочисленного решения }

 IF (PrGomory='Y') AND (P1=1) THEN

 BEGIN

 GOMORY;

 NachKell:=Kell;

 I1:=Kstr;DPy:=1;

 DOP_PER;

 BS[Kstr]:=Bvsp[Kell];

Страницы: 1, 2, 3, 4, 5