old/PAS/Graph/slen.pas

const
  N = 7;
  A : array [1..N,1..N] of word =
    ((0,     3,     5,     1,     MaxInt,MaxInt,MaxInt),
     (MaxInt,0,     MaxInt,MaxInt,3,     MaxInt,MaxInt),
     (MaxInt,2,     0,     MaxInt,2,     MaxInt,10    ),
     (MaxInt,MaxInt,3,	   0,     MaxInt,3,     MaxInt),
     (MaxInt,MaxInt,MaxInt,MaxInt,0,     MaxInt,2     ),
     (MaxInt,MaxInt,MaxInt,MaxInt,7,     0,     9     ),
     (MaxInt,MaxInt,MaxInt,MaxInt,MaxInt,MaxInt,0     ));

var
  Path  : array [0..N-1] of 1..N;
  pB,pE : 0..N-1;

Function shortlen(start,en:integer):word;
var
  Len  : array [1..N] of integer;
  From : array [1..N] of 0..N;
  Tree  : set of 1..N;
  cur   : 1..N;
  i,min : integer;
begin
  for i := 1 to N do From[i] := start;
  for i := 1 to N do Len[i]  := MaxInt;
  Len[Start] := 0;
  Tree := [];

  while true do
  begin
    min :=MaxInt;
    for i := 1 to N do if not (i in Tree) then if Len[i] < min then
     begin min := Len[i]; cur := i;end;
    if Cur = en then break;
    Tree := Tree + [Cur];

    for i:= 1 to N do begin
      if not (i in Tree) then
        if (Len[Cur]+A[Cur,i]) < Len[i] then
          begin
            From[I] := Cur;
            Len[i] := Len[Cur]+A[Cur,i];
          end;
    end;
  end;
  ShortLen := Len[en];
  repeat
    Path[pE] := Cur;
    Cur := From[Cur];
    inc(pE);
  until Cur = start;
  Path[pE] := cur;
end;{shortlen}

var
  st, en : 1..n;

BEGIN
  pE :=1;
  sT :=1;
  En :=7;
  WriteLn('Кратчайшее расстояние от ',sT, ' до ',en,' равно ',ShortLen(st,en));
  WriteLn('Путь :');
  repeat
    WriteLn(Path[pE]);
    dec(pE)
  until pE = 0;;
END.