Оптимизация производственной программы заданной комплектности

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