Комбинаторная задача на Delphi

[vejlin]

Здравствуйте, пожалуйста, помогите решить задачу. Дано N пунктов и матрица расстояний между ними. Найти кратчайший маршрут перехода из одного пункта в другой. Большое спасибо заранее.

[mMAg]

Алгоритм Дейкстры

[vejlin]

Алгоритм понятен, спасибо. Непонятно, как выполнить обход матрицы? Не силен в синтаксисе. Подскажите.

[mMAg]

выложите код объявления переменных, ввода матрицы и прочего, опишите функцию Dejkstra();, в которую будет передана матрица, а я вам напишу тело этой функции, не вопрос. При условии, что всё остальное увижу здесь.

[vejlin]

procedure TForm1.Button1Click(Sender: TObject);
  const m=6;
  const n=6;
 var a: array [1..m,1..n] of integer;
begin
With StringGrid1 do begin       
      Cells[0,0]:='ïóíêòû'; 
       Cells[0,8]:='ñóììà';
       For j:=1 to n do begin
          Cells[j,0]:= IntToStr(j); 
          For i:=1 to m do begin
            Cells[0,i]:=IntToStr(i);  
                a[i,j]:=4+Random(9);
                a[1,1]:=0;
                a[2,2]:=0;
                a[3,3]:=0;
                a[4,4]:=0;
                a[5,5]:=0;
            Cells[j,i]:=FloatToStr(a[i,j]);
          end;
         end;
      end;

end;
так,наброски

[mMAg]

Амм, простите, мне что-то вдруг перехотелось писать вам этот алгоритм Дейкстры. Вот, я тут порылся немного, код одной из прог, которые на 1 курсе писал, какой тут алгоритм используется я не помню (есть ещё матричный алгоритм, может быть я его использовал вместо поочерёдного запуска алгоритма Дейкстры для каждой вершины):

procedure TForm1.ButtonGClick(Sender: TObject);
var
  z,x,i,a,p,tr1:integer;
  s:string;
  tr:boolean;
begin
  tr:=true;
  a:=length(graph);
  ButtonGr.Click;
  if ComboBoxV.Text=''
    then
      begin
        ShowMessage('?');
        exit;
      end;
  ListBoxDl.Clear;
  ListBoxPu.Clear;
  tr1:=SGraph(graph,put);
  p:=StrtoInt(ComboBoxV.Text);
  if tr1=-1
    then
      begin
        for i:=0 to a-1 do
          if graph[p-1,i]<>oo
            then
                ListBoxDl.Items.Add(InttoStr(p)+' -> '+InttoStr(i+1)+' : '+
                                      InttoStr(graph[p-1,i]))
            else
              ListBoxDl.Items.Add(InttoStr(p)+' -> '+InttoStr(i+1)+' : '+'нет пути');
        for i:=0 to a-1 do
          begin
            z:=p-1;
            x:=i;
            s:=InttoStr(p);
            while tr=true do
              begin
                if put[z,x]=z
                  then
                    if x=i
                      then
                        begin
                          tr:=false;
                          s:=s+' -> '+InttoStr(x+1);
                        end
                      else
                        begin
                          z:=x;
                          x:=i;
                          s:=s+' -> '+Inttostr(z+1);
                        end
                  else
                    begin
                      x:=put[z,x]
                    end;
              end;
            ListBoxPu.Items.Add(s);
            tr:=true;
          end
      end
    else
      begin
        z:=tr1;
        x:=z;
        s:=InttoStr(z+1);
        while tr=true do
          begin
            if put[z,x]=z
              then
                if x=tr1
                  then
                    begin
                      tr:=false;
                      s:=s+' -> '+InttoStr(x+1);
                    end
                  else
                    begin
                      z:=x;
                      x:=tr1;
                      s:=s+' -> '+Inttostr(z+1);
                    end
              else
                begin
                  x:=put[z,x]
                end;
          end;
        ListBoxDl.Items.Add('Найден отрицательный цикл: '+InttoStr(graph[tr1,tr1]));
        ListBoxPu.Items.Add(s);
      end;

end;

[shelest]

Пример вот готовая задача

[mMAg]

Точно, вспомнил, там не алгоритм Дейкстры. Алгоритм Дейкстры не работает, если есть отрицательный цикл. А у меня отрицательный цикл ищется. Следовательно скорее всего алгоритм Флойда реализован... И что-то мне подсказывает, что вот здесь, а в той функции просто результат выводится:

function SGraph(var gr,pu:M):integer;
var
  a,i,j,k: integer;
begin
  Result:=-1;
  a:=Length(gr);
  i:=0;
  while (i<=a-1) and (Result=-1) do
    begin
      j:=0;
      while (j<=a-1) and (Result=-1) do
        begin
          if gr[j,j]<0 then
            begin
              Result:=j;
              i:=a;
              j:=a;
            end;
          inc(j);
        end;
      if Result=-1 then
        for j:=0 to a-1 do
          for k:=0 to a-1 do
            if (gr[i,j]<>oo) and (gr[k,i]<>oo) and (gr[i,j]+gr[k,i]<gr[k,j])
              then
                begin
                  pu[k,j]:=i;
                  gr[k,j]:=gr[i,j]+gr[k,i];
                end;
      inc(i);
    end;
end;

[vejlin]

Программа выдает наименьшее расстояние между 2 и 5 пунктом. Подскажите плиз, как отобразить в листбоксе через какой пункт нужно пройти из 2 к 5-му по этому наикратчайшему расстоянию(у меня например 2->5:13, а надо 2->3->5:13). Спасибо заранее
procedure TForm15.Button1Click(Sender: TObject);

var
a:array[1..n,1..n] of longint;//матрица смежности
b:array[1..n]of boolean;//список просмотренных вершин
d:array[1..n] of longint;//расстояния между пунктами
q, i, j, jmin, min, m, v: integer;

begin
for i := 0 to n - 1 do StringGrid1.Cells[i, i] := '0';
for i := 0 to n - 1 do
for j := i + 1 to n - 1 do
begin
StringGrid1.Cells[i, j] := IntToStr(Random(100));
StringGrid1.Cells[j, i] := StringGrid1.Cells[i, j];
end;
q := StrToIntDef(Edit1.Text, 2); //начальная вершина
if (q < 1) or (q > n) then q := 1;

for i := 1 to n do
for j := 1 to n do
a[j, i] := StrToIntDef(StringGrid1.Cells[i - 1, j - 1], -1);

//Расчет
fillchar(b,sizeof(b),0);
fillchar(d,sizeof(d), 10000); //бесконечность
d[q] := 0;//расстояние до начальной вершины
for i:=1 to n do
begin
min:=a[v,j];
jmin:=1;
m:=1000;
for j:=1 to n do
if ( (d[j] <= m) and (not b[j]) ) then
begin
m:=d[j];
v:=j;
end;
b[v] := true;
for j:=1 to n do
if ((a[v,j]<>-1)and(not b[j])and (d[v]+a[v,j]<d[j])) then
d[j]:=d[v]+a[v,j];
end;

//Вывод результата
ListBox1.Clear;
for i := 5 downto 5 do
ListBox1.Items.Append(IntToStr(q) + '->' + IntToStr(i) + ': ' + IntToStr(d[i]));

end;

end.

[mMAg]

Алгоритм Дейкстры организован правильно, только, чтобы выводить полный путь, необходимо добавить дополнительный массив и одну строчку в в сам алгоритм:

var prev : array [1..n] of integer;
for j:=1 to n do
if ( (d[j] <= m) and (not b[j]) ) then
begin
m:=d[j];
v:=j;
end;
b[v] := true;
for j:=1 to n do
if ((a[v,j]<>-1)and(not b[j])and (d[v]+a[v,j]<d[j])) then
begin
d[j]:=d[v]+a[v,j];
prev[j] = v;
end;
end;

Ну, это без предварительной инициализации. Думаю, разберётесь. Суть в том, чтобы запомнить, из какой вершины в текущую мы попали. Поскольку, на каждом шаге алгоритма Дейкстры в каждую вершину из источника найден минимальный путь, то раскрутка пути в искомую вершину выглядит как обратная раскрутка массива вершин, из которых мы пришли. т.е. Если у вас путь минимальной длины 1->6->3, то в массиве будет храниться для вершины с индексом 3 позиция 6. А для вершины с индексом 6 позиция 1. Что и будет отражать тот факт, что вы попали в 3 таким путём.