Транспортная задача

← →
тихий вовочка © (2004-02-25 22:24) [0]

Помогите, пожалуйста, я уже постил, но мне никто не ответил по делу. Надо решить транспортную задачу имея таблицу стоимости, запасы и заявки. На бумаге ее решил за полчаса, а с реализацией не продвигаюсь. Я так глуп, что дальше составления опорного плана методом северо-западного угла не продвигаюсь. Алгоритм расчета псевдостоимостей и улучшения таблицы мне не составить. А в инете растиражирована только одна программа, код которой мне не понять.
Вы же сдавали линейное программирование!

← →
reticon © (2004-02-25 22:33) [1]

а самому поискать?

http://mgkip.narod.ru/files/KM_TR_ZAD.ZIP

← →
тихий вовочка © (2004-02-25 23:29) [2]

Так это и есть та прога, которую растиражировали в инете. Работать она работает, да я ничего понять не могу. И в инете уже 4 дня ищу. Мне вовсе не нужен готовый код, мне алгоритма достаточно.

← →
reticon © (2004-02-25 23:41) [3]

тем более, алгоритмов в сети еще больше, чем сырцов...

в конце концов, в литературе по высшей математике, например, на бумажном носителе...

У меня есть книги, но опять же, надо сканировать итп...

Короче, не можешь найти в сети - сходи в библиотеку :-)

← →
тихий вовочка © (2004-02-26 17:09) [4]

Решил писать транспортную задачу сам. Програ правильное решение находит(сверял в других прогах и со своими расчетами на бумажке), но она не ловит то, что решение правилное. Я так туп, что сам ничего найти не могу. Помогите, пожалуйста.
Вот код:
program transport;
uses crt;
type TMatrix = array[1..3,1..4] of integer;
TRow = array[1..3] of integer;
TCol = array[1..4] of integer;
TPoint = record row,col : integer; end;
TCells = array [1..12] of TPoint;
procedure DebugInput(var CM : TMatrix; var A : TRow; var B : TCol);
const c : TMatrix = ( (25,10,2,30),(5,15,20,30),(100,65,2,2 ));
al : TRow = (10,15,20);
bt : TCol = (5,12,13,15);
begin
CM:=c;
a:=al;
b:=bt;
end;
procedure ZeroMatrix(var matrix : TMatrix);
var i,j : integer;
begin
for i:=1 to 3 do
for j:=1 to 4 do matrix[i][j]:=0;
end;
procedure DrawCTable(data : TMatrix; baza : TRow; predpr : TCol; Symbol : string);
var i,j,k : integer;
begin
ClrScr;
write("Ъ");
for i:=1 to 15 do write("Д");
write("В");
for i:= 17 to 70 do write("Д");
writeln("ї");
write("і");
for i:=1 to 15 do write(" ");
write("і");
for i:= 17 to 30 do write(" ");
write("Predprijatija");
for i:= 44 to 70 do write(" ");
writeln("і");
write("Г");
for i:=1 to 15 do write("Д");
write("Е");
for i:=1 to 3 do
begin
for j:=1 to 13 do write("Д");
write("В");
end;
for j:=1 to 12 do write("Д");
writeln("ґ");
write ("і Bases і");
write (" B1 =",predpr[1]:4,"і");
write (" B2 =",predpr[2]:4,"і");
write (" B3 =",predpr[3]:4,"і");
writeln(" B4 =",predpr[4]:4,"і");
write("Г");
for i:=1 to 15 do write("Д");
write("Е");
for i:=1 to 3 do
begin
for j:=1 to 13 do write("Д");
write("Е");
end;
for j:=1 to 12 do write("Д");
writeln("ґ");
for i:=1 to 3 do
begin
write("і A",i,"=",baza[i]:2," і");
write (" ",Symbol,i,"1 =",data[i,1]:4,"і");
write (" ",Symbol,i,"2 =",data[i,2]:4,"і");
write (" ",Symbol,i,"3 =",data[i,3]:4,"і");
writeln(" ",Symbol,i,"4 =",data[i,4]:4,"і");
if(i=3) then break;
write("Г");
for j:=1 to 15 do write("Д");
write("Е");
for j:=1 to 3 do
begin
for k:=1 to 13 do write("Д");
write("Е");
end;
for j:=1 to 12 do write("Д");
writeln("ґ");
end;
write("А");
for j:=1 to 15 do write("Д");
write("Б");
for j:=1 to 3 do
begin
for k:=1 to 13 do write("Д");
write("Б");
end;
for j:=1 to 12 do write("Д");
writeln("Щ");

end;
procedure DataInput(var price : TMatrix; var baza : TRow; var predpr : TCol);
var i, j : integer;
begin
for i:=1 to 3 do
begin
for j:=1 to 4 do
begin
write("C",i,j,": ");
read(price[i,j]);
end;
writeln;
end;
for i:=1 to 3 do
begin
write(" Input A",i,": ");
read(baza[i]);
end;
for j:=1 to 4 do
begin
write("Input B",j,": ");
readln(predpr[j]);
end;
end;
procedure NorthWestAngle(var XMatrix : TMatrix; A : TRow; B : TCol);
var i,j : integer;
begin
i:=1; j:=1;
while(B[j]>0) do
begin
if(B[j]>=A[i]) then
begin
B[j]:=B[j]-A[i];
XMatrix[i,j]:=A[i];
A[i]:=0;
inc(i);
end
else
begin
A[i]:=A[i]-B[j];
XMatrix[i,j]:=B[j];
B[j]:=0;
inc(j);
end;
end;
end;

← →
тихий вовочка © (2004-02-26 17:09) [5]

procedure PseudoPrice(X : TMatrix; C : TMatrix; var a : TRow;var b : TCol; var Pseudo : TMatrix);
var
i,j,step : integer;
def_b : array[1..4] of boolean;
def_a : array[1..3] of boolean;
begin
for i:=1 to 4 do
begin
if i<4 then def_a[i]:=false;
def_b[i]:=false;
end;
i:=3; j:=4;
while(X[i,j]=0)
do
begin
dec(j);
end;
b[j]:=0;
def_b[j]:=true;
a[i] := C[i,j]-b[j];
def_a[i] := true;
step:=j;
for j:=step downto 1 do
if X[i,j]<>0 then
begin
b[j]:=C[i,j]-a[i];
def_b[j]:=true;
end;
while(i>1) do begin
dec(i);
for j:=1 to 4 do
if ((X[i,j]<>0)and(def_b[j])) then
begin
a[i]:=C[i,j]-b[j];
def_a[i]:=true;
break;
end;
if def_a[i] then
for j:=1 to 4 do if(X[i,j]<>0) then
begin
b[j]:=C[i,j]-a[i];
def_b[j]:=true;
end;
end;
writeln;
for i:=1 to 3 do
for j:=1 to 4 do
begin
Pseudo[i,j]:=a[i]+b[j];
end;
end;
procedure ShowMatrix(XMatrix : TMatrix; comment : string);
var row : integer;
begin
for row:=1 to 3 do
Writeln(" і",XMatrix[row,1]:3,XMatrix[row,2]:3,XMatrix[row,3]:3,XMatrix[row,4]:3,"і");
end;
function TotalSum(XMatrix : TMatrix; CMatrix : TMatrix) : integer;
var i,j : integer;
Sum : integer;
begin
Sum:=0;
for i:=1 to 3 do
for j:=1 to 4 do Sum:=Sum+CMatrix[i,j]*XMatrix[i,j];
TotalSum:=Sum;
end;
function IsOptimal(C : TMatrix; PseudoPrice : TMatrix) : boolean;
var i,j : integer;
result : boolean;
begin
result:=true;
for i:=1 to 3 do
for j:=1 to 4 do
if PseudoPrice[i,j]>C[i,j] then result:=false;
IsOptimal:=result;
end;
procedure GetNonOptimalCells(C:TMatrix;PseudoPrice:TMatrix;var NOptCells:TCells;var count:integer);
var i,j : integer;
begin
count:=0;
for i:=1 to 3 do
for j:=1 to 3 do
if PseudoPrice[i,j]>C[i,j] then
begin
inc(count);
NOptCells[count].row:=i;
NOptCells[count].col:=j;
end;
end;
procedure GetCycleCell(XM : TMatrix; Price : TMatrix; var r : integer; var c : integer);
var i,j : integer;
max : integer;
begin
max:=-200;
for i:=1 to 3 do
for j:=1 to 4 do if ((XM[i,j]=0)and(Price[i,j]>max))
then
begin
r:=i;
c:=j;
max:=Price[i,j];
end;
end;
procedure Optimize(var XM : TMatrix; r : integer; c : integer);
var
i,j : integer;
min : integer;
ctype : integer;
mn : integer;
begin
if(r-1>0)AND(c-1>0) then
if(XM[r-1,c-1]<>0)AND(XM[r-1,c]<>0)AND(XM[r,c-1]<>0) then
begin i:=r-1; j:=c-1; ctype:=1; end;

if(r+1<4)AND(c-1>0) then
if(XM[r,c-1]<>0)AND(XM[r+1,c-1]<>0)AND(XM[r+1,c]<>0) then
begin i:=r; j:=c-1;ctype:=2; end;
if(r-1>0)AND(c+1<5) then
if(XM[r-1,c]<>0)AND(XM[r-1,c+1]<>0)AND(XM[r,c+1]<>0) then
begin i:=r-1; j:=c;ctype:=3; end;
if(r+1<4)AND(c+1<5) then
if(XM[r,c+1]<>0)AND(XM[r+1,c]<>0)AND(XM[r+1,c+1]<>0) then
begin i:=r; j:=c;ctype:=4; end;
case ctype of
1,4 : begin
if XM[i+1,j]>XM[i,j+1] then min:=XM[i,j+1] else min:=XM[i+1,j];
mn:=1;
end;
2,3 : begin
if XM[i,j]>XM[i+1,j+1] then min:=XM[i+1,j+1] else min:=XM[i,j];
mn:=-1;
end;
end;
XM[i,j]:=XM[i,j]+min*mn;
XM[i,j+1]:=XM[i,j+1]-min*mn;
XM[i+1,j]:=XM[i+1,j]-min*mn;
XM[i+1,j+1]:=XM[i+1,j+1]+min*mn;
end;
var C : TMatrix;
X : TMatrix;
PsPrice : TMatrix;
Zapas : TRow;
Zajavka : TCol;
Alpha : TRow;
Beta : TCol;
row,col : integer;
res : boolean;
count : integer;
ncells : TCells;
BEGIN
ZeroMatrix(C);
ZeroMatrix(X);
ZeroMatrix(PsPrice);
ClrScr;
Writeln("Transportnaja zadacha");

{DataInput(C,Zapas,Zajavka);} (* Manual values input *)
DebugInput(C,Zapas,Zajavka); (*Programme will input values automatically*)
DrawCTable(C,Zapas,Zajavka,"C");
Writeln("Press any key...");
readln;
Writeln;
Writeln("Opornaja tablica");
NorthWestAngle(X,Zapas,Zajavka);
ShowMatrix(X,"X=");
writeln("Stoimost");
Writeln("T(X)=",TotalSum(X,C));
PseudoPrice(X,C,Alpha,Beta,PsPrice);
res:=IsOptimal(C,PsPrice);
if not res then writeln("Plan ne optimalen! Press any key to continue...");
while not res do
begin

GetNonOptimalCells(C,PsPrice,ncells,count);
if count=1 then
begin
row:=ncells[1].row;
col:=ncells[1].col;
end
else
begin
GetCycleCell(X,PsPrice,row,col);
end;
Optimize(X,row,col);
Writeln("Sledujustchaja tablica");
ShowMatrix(X,"X=");
Writeln("Stoimost");
Writeln("T(X)=",TotalSum(X,C));
PseudoPrice(X,C,Alpha,Beta,PsPrice);
res:=IsOptimal(C,PsPrice);
if not res then writeln("Plan ne optimalen! Press any key to continue...");
readln;
{res:=true; { DEBUG!!!!!!!! }
end;
writeln("Plan optimalen!");
Readln;
END.

← →
icWasya © (2004-02-26 18:49) [6]

в процедуре Optimize
идут четыре if .. если ни один не выполнится, то чему равен ctype, i, j??.

Так устроена задача, что один обязательно выполнится. Но ошибка не в этом. У меня не срабатывает подсчет псевдостоимостей. Дебаггером смотрел, все идет как надо, но когда достигается правильное решение при формировании таблицы псевдостоимостей расчет идет вкривь и вкось(хотя матрица груза X в порядке, а матрица стоимостей неизменна с самого начала)

← →
Burmistroff (2004-02-27 00:13) [8]

Нашел у себя какой-то симплесный метод http://mc.webm.ru/5/simplexx.rar

Спасибо. Но я уже САМ! САМ сделал. и ошибку нашел свою.

Транспортная задача Найти похожие ветки