[Skiph]

Приветствую! У меня есть уже работающая процедура нахождения кратчайших путей методом Дейкстры, но она неправильно формирует кратчайшие пути, то есть, например из 1 --> 6 --> 5 --> 9

На самом деле эта процедура используется в комплексе который решает транспортную задачу и она справляется с этой задачей. Входная матрица смежности (С) имеет размерность 108х108

Что я делаю не так? Очень нужна ваша помощь, скоро нужно сдавать. Если там что-то сверх сложное готов заплатить за помощь! Ну очень нужно поскорее сделать. У самого уже мозги кипят

Код:

//
// Вызов процедуры поиска кратчайших расстояний
//
procedure TMainView.btnFindShortcutsClick(Sender: TObject);
var
 i, j: Integer;
begin
  for i:=1 to Ai do
   begin
     Dijkstra(i); //найти кратчайшее расстояние
     for j:=1 to Bj do
       StGr.Cells[j,i]:=FloatToStr(MatrRas[i,j]);
   end;
 
  for i:=1 to Ai do
   for j:=1 to bj do
       MatrRas[i,j] := StrToFloat(StGr.Cells[j,i]);
 
  btnBasicPlan.Enabled := True;
  btnFindShortcuts.Enabled  := False;
  //btn6.Enabled  :=True;
  //btnOptimize.Enabled := True;
 
end;

Код:

//
// Процедура нахождения кратчайших расстояний (Дейкстра)
//
procedure TMainView.Dijkstra(Ver: Integer);
var
 v, s: array[1..nn] of integer;
 d, d2, b: array[1..nn] of real;
 k: Array[1..nn,1..nn] of Real;
 i, g, z, j, w: integer;
 l: Real;
 str, str2 ,str3: String;
begin
//---------Начальный шаг------------------
 w := 1;
 s[ver] := ver;  //добавляем вершину источник
 
 str := IntToStr(ver);
 
 // первая строка, первых три столбца
 StGD.Cells[0,1]:='Нач.';
 StGD.Cells[1,1]:='{'+IntToStr(s[ver])+'}';
 StGD.Cells[2,1]:='-';
 
 for i:=1 to n do begin
   d[i]:=c[ver,i];
   v[i]:=ver;
 end;
 
 //----Поиск минимального значения
  a := d[1];
  For i:=2 To n Do
    If (d[i] < a) Then
      a := d[i];
 
  for i:=1 to n do begin
   if d[i]=a then begin
    w:=i;  // № вершины
   end;
  end;
 
 //---Добавить строку в D
  j:=1;
  for i:=1 to n do
   if i<>ver then begin
    if d[i]=sum then StgD.Cells[j+2,1]:=' ~ '
    else StgD.Cells[j+2,1]:=FloatToStr(d[i]);
    k[1,j+1]:=d[i];
    Inc(j);
   end;
 
//------Cледующий шаг
 for g:=1 to n do begin
   for i:=1 to n do begin
    b[i]:=min(d[i],(d[w]+c[w,i]));
    v[g+1]:=w;
   end;
 
   for i:=1 to n do begin
    if s[i]=0 then
     d2[i]:=b[i];
   end;
 
   s[w]:=w;
 
   str:=str+', '+IntToStr(w);
   StGD.Cells[0,g+1]:=IntToStr(g);
   StGD.Cells[1,g+1]:='{'+str+'}';
   StGD.Cells[2,g+1]:=IntToStr(w);
 
   for i:=1 to n do begin
    d[i]:=b[i];
   end;
 
  j:=1;
  for i:=1 to n do
   if i<>ver then begin
    if d[i] = sum then StgD.Cells[j+2,g+1]:=' ~ '
    else StgD.Cells[j+2,g+1]:=FloatToStr(d[i]);
    k[g+1,j+1]:=d[i];
    Inc(j);
   end;
 
  for i:=1 to n do begin
   if s[i]<>0 then
     d2[i]:=sum;
  end;
 
  a := d2[1];
  For i:=2 To n Do
    If (d2[i] < a) Then
      a := d2[i];
 
  for i:=1 to n do begin
   if s[i]=0 then
    if d2[i]=a then begin
     w:=i;  // № вершины
    end;
  end;
 end; //g
 
// Записать матрицу кратчайших расстояний
 j:=1;
 for i:=ai+1 to n do begin
  MatrRas[ver,j]:=d[i];
  inc(j);
 end;
 
 //последовательность вершин входящих в путь
 for j:=1 to n do begin
 str2:=IntToStr(ver);
  if j<>ver then begin
  for i:=1 to n do begin
   if k[i,j]=k[i+1,j] then
     str2:=str2
   else if k[i,j]<>k[i+1,j] then
     str2:=str2+' --> '+IntToStr(v[i+1]);
  end;
    str2:=str2+' --> '+ IntToStr(j);
    l:=k[n,j];
    if l = 0 then
     str3:='нет пути'
    else str3:=str2+' = '+FloatToStr(k[n,j]);
 
    LBox1.Items.Add(str3);
  end;
 end;
end;

Последний фрагмент ( //последовательность вершин входящих в путь) по идее выводит все возможные маршруты и пути должны состоять как минимум из 3-5 узлов и максимум из 10-20, но в листбоксе выводится почему то не все вершины, а только первая, предпоследняя и последняя:

Снимок2.jpg