Дипломная работа: Разработка математической модели и ПО для задач составления расписания

end;

procedure Full_Integer_Simplex(var x:MyArray_X; a:MyArray; m,n:integer);

{Полностью целочисленный алгоритм задачи линейного целочисленного

программирования,

см. Ху Т. "Целочисленное программирование и потоки в сетях", стр. 300-309,

a - матрица размером m+n+2*n+1, по аналогии:

Требуется найти максимум

z= - 10x1 - 14x2 - 21x3

2x1 + 2x2 + 7x3 >= 14

8x1 + 11x2 + 9x3 >= 12

9x1 + 6x2 + 3x3 >=10,

тогда матрица а будет выглядеть:

1 10 14 21

0 -1 0 0

0 0 -1 0

0 0 0 -1

-14 -2 -2 -7

-12 -8 -11 -9

-10 -9 -6 -3

0 0 0 0,

процедура возвращает вектор X, первые m компонент которого - искомое решение,

если последняя компонента вектора = 1, то решения не существует или оно = бесконечности}

var i,i1:integer;

j,j1:integer;

alfa:real;

begin

repeat

i:=1;

while (i=0) do Inc(i); {производящая строка}

if i

j:=1;

while (j=0) do Inc(j);

if j

for i1:=1 to n-1 do if (a[i,i1]<0) and Lexikogr_few(a,m,n,i1,j) then j:=i1; {лексикографически

минимальный столбец}

{выбор альфа}

if j

{Writeln(i,' ',j);readln;}

alfa:=0;

for i1:=1 to n-1 do if a[i,i1]<0 then

begin

j1:=Find_nu(a,m,n,j,i1);

if (j1>0) and (-a[i,i1]/j1>alfa) then alfa:=-a[i,i1]/j1;

end;

{writeln(alfa,' ',i,' ',j);readln;}

{получение отсечения Гомори}

for i1:=0 to n-1 do if a[i,i1]>0 then a[m-1,i1]:=round(Int(a[i,i1]/alfa))

else begin

a[m-1,i1]:=round(Int(a[i,i1]/alfa));

if Frac(a[i,i1]/alfa)<>0 then a[m-1,i1]:=a[m-1,i1]-1;

end;

Step_Dual_simplex(a,m,n,m-1,j);

end;

end;

until (i>=m-1) or (j>=n);

for i:=0 to m-1 do x[i]:=round(a[i,0]);

if j>=n then x[m-1]:=1 else x[m-1]:=0;

end;

procedure Step_One_Simplex(var a:MyArray; m,n,i:integer);

var i1,i2:integer;

{Один шаг прямого целочисленного метода (производящая строка - последняя

i - производящий столбец)}

begin

for i1:=0 to m-2 do a[i1,i]:=a[i1,i]/(-a[m-1,i]);

for i2:=0 to n-1 do

for i1:=0 to m-2 do

if i2<>i then a[i1,i2]:=a[i1,i2]+a[i1,i]*a[m-1,i2];

end;

procedure Direct_Integer_Simplex(var x:MyArray_X; a:MyArray; m,n:integer);

{Прямой целочисленный алгоритм задачи целочисленного линейного программирования,

см. Ху Т. "Целочисленное программирование и потоки в сетях", стр. 344-370,

a - матрица размером m+n+3*n+1 по аналогии:

требуется максимизировать

z = x1 + x2 + x3

-4x1 + 5x2 + 2x3 <= 4

-2x1 + 5x2 <= 5

3x1 - 2x2 + 2x3 <= 6

2x1 - 5x2 <= 1

тогда матрица а будет выглядеть:

0 -1 -1 -1

4 -4 5 2

5 -2 5 0

6 3 -2 2

1 2 -5 0

0 -1 0 0

0 0 -1 0

0 0 0 -1

10 1 1 1 - в этой строке первое число - грубая max суммы небазисных переменных

0 0 0 0 - строка для отсечения Гомори,

алгоритм работает только при a[i,0]>=0

возвращает вектор X - на месте единичной матрицы искомое решение,

если в последней компоненте единица - ошибка при расчетах}

var i,j,i1,j1:integer;

bool:boolean;

b,b1,b2:array of byte;

r:real;

begin

SetLength(b,m);SetLength(b1,m);

for i:=0 to m-1 do b1[i]:=0;

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

bool:=false;

for j:=1 to n-1 do if a[0,j]<0 then bool:=true;

while bool do begin

{поиск производящего столбца}

bool:=false;j1:=0;

for j:=1 to n-1 do begin

if a[m-2,j]>0 then

begin

for i:=0 to m-3 do a[i,j]:=a[i,j]/a[m-2,j];

if not bool then begin j1:=j;bool:=true;end else if Lexikogr_few(a,m,n,j,j1)

then j1:=j;

end;

end;

{поиск производящей строки}

for j:=1 to n-1 do

if a[m-2,j]>0 then

for i:=0 to m-3 do a[i,j]:=a[i,j]*a[m-2,j];

for i:=0 to m-1 do b[i]:=0;

i:=1; while (i

i1:=i;

while (i

if (a[i,j1]>0) and (a[i,0]/a[i,j1]

Inc(i);

end;

if i1

if a[i1,0]/a[i1,j1]<1 then begin

b[i1]:=1;

for i:=1 to m-2 do

if (a[i,j1]>0) and (a[i,0]/a[i,j1]<1) then b[i]:=1;

for i:=1 to m-2 do if (b[i]=1) and (b1[i]=1) then i1:=i;

end;

{формирование отсечения Гомори}

for i:=0 to n-1 do if a[i1,i]>0 then a[m-1,i]:=round(Int(a[i1,i]/a[i1,j1]))

else begin

a[m-1,i]:=round(Int(a[i1,i]/a[i1,j1]));

if Frac(a[i1,i]/a[i1,j1])<>0 then a[m-1,i]:=a[m-1,i]-1;

end;

Step_One_Simplex(a,m,n,j1);

end;

bool:=false;

if i1

b2:=b1;b1:=b;b:=b2;

for j:=1 to n do if a[0,j]<0 then bool:=true;

end;

{for j1:=0 to n-1 do Write(a[0,j1]:1:0,' ');Writeln;readln;}

end;

for i:=0 to m-2 do x[i]:=round(a[i,0]);

if i1>=m-1 then x[m-1]:=1 else x[m-1]:=0;

Finalize(b);Finalize(b1);

end;