Алгоритм Форда-Беллмана. - Pascal - Ответ 2129994

var a:array[1..20,1..20] of word; {матрица смежности}
c,pred,fl,d:array[1..20] of word;{c - массив кратчайших расстояний; pred - массив предыдущих вершин; fl - массив флагов; d - массив для записи пути}
i,j,k,n,first,last:byte;
f:text;{переменная для открытия in.txt}
 
{процедура обхода графа вглубь для поиска всех путей}
 
Procedure Dfs(x:word); {в качестве параметра передаём текущую вершину}
var i:byte; {локальная переменная}
begin
 if x=last then {если конечная вершина, то вводим путь}
  begin
   write(first,' ');
   for i:=1 to j do {выводим путь}
    write(d[i],' ');
    writeln;
    exit;{выходим из процедуры}
  end;
 fl[x]:=1; {помечаем что были в вершине}
 for i:=1 to n do {если не были в вершине и существует дуга в неё}
  if (fl[i]=0)and(a[x,i]<>32767) then
   begin
    inc(j);
    d[j]:=i; {записываем в путь вершину}
    dfs(i); 
    dec(j);
   end;
 fl[x]:=0; {помечаем что вершина свободна}
end;
 
{основная программа}
 
begin
     assign(f,'in.txt'); {открываем файл для чтения}
     reset(f);
     readln(f, n); {считываем количество вершин}
     for i:=1 to n do
          for j:=1 to n do
          read(f,a[i,j]); {считываем матрицу смежности}
     writeln('Mатрица:');
     for i:=1 to n do  {выводим матрицу на экран}
          for j:=1 to n do
           if j=n then writeln(a[i,j])
           else write(a[i,j],' ');
     for i:=1 to n do {заменяем нули бесконечностью}
          for j:=1 to n do
          if a[i,j]=0 then a[i,j]:=32767;
     writeln('Введите 1 вершину: ');
     readln(first);
     writeln('Введите 2 вершину');
     readln(last);
     close(f); {закрываем файл in.txt}
     for j:=1 to n do
     begin
           c[j]:=a[first,j]; {записываем начальные значения}
           if a[first,j]<32767 then
           pred[j]:=first; {если существует дуга то записываем предыдущую вершину}
     end;
     for i:=3 to n do
         for j:=1 to n do
             if j<>first then
             for k:=1 to n do  {если не бесконечность и путь более выгодный}
                 if (c[k]<32767) and (c[k]+a[k,j]<c[j]) then
                  begin
                   c[j]:=c[k]+a[k,j]; {записываем новое значение}
                   pred[j]:=k; {записываем pred вершину}
                  end;
     if c[last]=32767 then writeln('Нет путей') 
     else {если бесконечность то нет пути}
      begin
          writeln;
          writeln('Кратчайший путь:');
          write(first,' ');
          i:=last;
          k:=1;
          while i<>first do {в обратном порядке обходим путь}
           begin
               d[k]:=i; {записываем путь в массив}
               k:=k+1;
               i:=pred[i];
           end;
          for i:=k-1 downto 1 do {выводим кратчайший путь}
          write(d[i],' ');
          writeln;
          writeln('Все пути:');
          j:=0;
          Dfs(first); {вызываем процедуру поиска всех путей}
      end;
     readln;
     readln;
end.