Шпоры по МПиПА / Графы / Путь минимального веса в нагруженном графе / Pascal / Исходник / MinWay

Program minimal_lehgth_way;

const max = 100;
type myVector = array[0..max-1] of integer;
type myMatrix = array[0..max-1, 0..max-1] of integer;

var weightMatrix : myMatrix;
i, j : integer;
fromNode, toNode, dimension : integer;
way : myVector;
length, weight : integer;

function minimalLengthWay( fromNode, toNode, dimension : integer; weightMatrix : myMatrix; var length, weight : integer ) : myVector;
var minWeights : myMatrix; // Для хранения фронта волны
i, j, k : integer;
way : myVector; // Для хранения найденного пути и уже однажды пройденных вершин
find : boolean;
tempLength : integer;
currNode : integer;
begin
for i := 0 to dimension - 1 do
for j := 0 to dimension - 1 do
minWeights[i,j] := -1;
for i := 0 to dimension - 1 do begin
way[i] := -1;
end;

find := false;

// заполняем матрицу минимальных весов
for i := 0 to dimension - 1 do
minWeights[fromNode,i] := 0;

for k := 0 to dimension - 2 do begin
for i := 0 to dimension - 1 do begin
tempLength := minWeights[i,k];
for j := 0 to dimension - 1 do begin
if ( minWeights[j,k] <> -1 ) and ( weightMatrix[j,i] <> -1 ) then begin
if ( ( tempLength <> -1 ) and ( tempLength > minWeights[j,k] + weightMatrix[j,i] ) ) or ( tempLength = -1 ) then begin
tempLength := minWeights[j,k] + weightMatrix[j,i];
end;
end;
end;
minWeights[i,k+1] := tempLength;
end;
end;

if minWeights[toNode,dimension-1] <> -1 then begin // проверяем найден ли какй-либо путь
find := true;
weight := minWeights[toNode,dimension-1];
end
else begin
find := false;
end;

if find then begin // если путь найден - вычисляем его но в обратной последовательности
j := 0;
way[0] := toNode;
currNode := toNode;
for k := dimension - 2 downto 0 do begin
if minWeights[currNode, k] <> minWeights[currNode, k + 1] then begin
for i := 0 to dimension - 1 do begin
if minWeights[i,k] + weightMatrix[i, currNode] = minWeights[currNode, k + 1] then begin
j := j + 1;
way[j] := i;
currNode := i;
break;
end;
end;
end;
end;
length := j;
end;

minimalLengthWay := way;
end;

begin
writeln('Wave algoritm.');
write('Enter graph dimension: '); readln( dimension );
writeln('Enter graph weightMatrix: ');
for i := 0 to dimension-1 do begin
write('Enter '); write( i + 1 ); write(' row: ');
for j := 0 to dimension-1 do begin
read(weightMatrix[i,j]);
end;
end;
readln;
write('Enter From Node: '); readln( fromNode );
write('Enter To Node: '); readln( toNode );
write('Question: Exist way from '); write( fromNode ); write(' to '); write( toNode ); writeln('?');
way := minimalLengthWay( fromNode - 1, toNode - 1, dimension, weightMatrix, length, weight );
write('Answer: way from '); write( fromNode ); write(' to '); write( toNode ); write(': ');
if ( way[0] = -1 ) then begin
writeln('not found.');
end
else begin
for i := length downto 0 do begin
if i <> length then write(' -> ');
write( way[i] + 1 );
end;
writeln;
write('Weight: '); writeln( weight );
end;
writeln('Press Enter to continue...');
readln;
end.