可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效，请关闭广告屏蔽插件后再试):

问题:

I'm looking for advices to speed up my implementation of Dijkstra Shortest Path Search on a weighted graph which is a square matrix N x N. The weight on horizontal vertice is called H (resp. V on vertical ones).

A picture is worth a thousand words:

A picture is worth a thousand words! http://lionelgermain.free.fr/img/graphe.png

Of course, this is part of a bigger application, but I've extracted the relevant bit here:

unit Unit1;  interface  uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls;  const  N = 200; //Working on a grid of N x N, here for a quick test, in practice, it's more 10000  type   TForm1 = class(TForm)     Button1: TButton;     procedure FormCreate(Sender: TObject);     procedure Button1Click(Sender: TObject);   end;    TNode = class   public     ID, //Number of the Node     origin, //From which Node did I came?     weight : integer; //The total weight of the path to Node ID     done : boolean; //Is the Node already explored?     constructor Create(myID, myOrigin, myweight: integer);   end;  var   Form1: TForm1;  implementation  var   H, V : array of integer; {$R *.dfm}  constructor TNode.Create(myID, myOrigin, myweight: integer); begin   ID:=MyID;   origin:=MyOrigin;   weight:=MyWeight; end;  {------------------------------------------------------------------------------}  Function GetNodeFromID(ID: integer; NodeList: TList) : TNode; overload; var   I: Integer;   Node: TNode; begin   result:=nil;   for I := 0 to NodeList.count-1 do   begin     Node := NodeList[i];     if Node.ID=ID then     begin       result:=Node;       break;     end;   end; end;  {------------------------------------------------------------------------------}  Function GetNodeOfMiniWeight(NodeList: TList) : TNode; overload; var   I, min: Integer;   Node: TNode; begin   result:=nil;   min :=maxint;   for I := 0 to NodeList.count-1 do   begin     Node := NodeList[i];     if Node.done then continue;     if Node.weight < min then     begin       result:=Node;       min := Node.weight;     end;   end; end;  {------------------------------------------------------------------------------}  procedure SearchShortestPath(origin,arrival: integer); var   NewWeight: integer;   NodeList : Tlist;   NodeFrom, //The Node currently being examined   NodeTo :TNode; //The Node where it is intented to go   s : string; begin   NodeList := Tlist.Create;   NodeFrom := TNode.Create(origin,MaxInt,0);   NodeList.Add(NodeFrom);    while not (NodeFrom.ID = arrival) do //Arrived?   begin     //Path toward the top     if (NodeFrom.ID > N-1) //Already at the top of the grid     and not(NodeFrom.origin-NodeFrom.ID = N) then //Coming from the top     begin       NewWeight:=NodeFrom.weight + H[NodeFrom.ID-N];       NodeTo := GetNodeFromID(NodeFrom.ID-N, NodeList);       if NodeTo <> nil then       begin         if NodeTo.weight > NewWeight then         begin           NodeTo.Origin:=NodeFrom.ID;           NodeTo.weight:=NewWeight;         end;       end       else       begin         NodeTo := TNode.Create(NodeFrom.ID-N,NodeFrom.ID,NewWeight);         NodeList.Add(NodeTo);       end;     end;      //Path toward the bottom     if (NodeFrom.ID < N*N-N) //Already at the bottom of the grid     and not(NodeFrom.Origin- NodeFrom.ID = N) then //Coming from the bottom     begin       NewWeight:=NodeFrom.weight + H[NodeFrom.ID];       NodeTo := GetNodeFromID(NodeFrom.ID+N, NodeList);       if NodeTo <> nil then       begin         if NodeTo.weight > NewWeight then         begin           NodeTo.Origin:=NodeFrom.ID;           NodeTo.weight:=NewWeight;         end;       end       else       begin         NodeTo := TNode.Create(NodeFrom.ID+N,NodeFrom.ID,NewWeight);         NodeList.Add(NodeTo);       end;     end;      //Path toward the right     if not(NodeFrom.ID mod N = N-1) //Already at the extrem right of the grid     and not(NodeFrom.Origin - NodeFrom.ID = 1) then  //Coming from the right     begin       NewWeight:=NodeFrom.weight + V[NodeFrom.ID];       NodeTo := GetNodeFromID(NodeFrom.ID+1, NodeList);       if NodeTo <> nil then       begin         if NodeTo.weight > NewWeight then         begin           NodeTo.Origin:=NodeFrom.ID;           NodeTo.weight:=NewWeight;         end;       end       else       begin         NodeTo := TNode.Create(NodeFrom.ID+1,NodeFrom.ID,NewWeight);         NodeList.Add(NodeTo);       end;     end;      //Path toward the left     if not (NodeFrom.ID mod N = 0) //Already at the extrem right of the grid     and not(NodeFrom.Origin - NodeFrom.ID = -1) then //Coming from the left     begin       NewWeight:=NodeFrom.weight + V[NodeFrom.ID-1];       NodeTo := GetNodeFromID(NodeFrom.ID-1, NodeList);       if NodeTo <> nil then       begin         if NodeTo.weight > NewWeight then         begin           NodeTo.Origin:=NodeFrom.ID;           NodeTo.weight:=NewWeight;         end;       end       else       begin         NodeTo := TNode.Create(NodeFrom.ID-1,NodeFrom.ID,NewWeight);         NodeList.Add(NodeTo);       end;     end;     NodeFrom.done :=true;     NodeFrom:=GetNodeOfMiniWeight(NodeList);   end;    s:='The shortest path from '     + inttostr(arrival) + ' to '     + inttostr(origin) + ' is : ';   //Get the path   while (NodeFrom.ID <> origin) do   begin     s:= s + inttostr(NodeFrom.ID) + ', ';     NodeFrom:=GetNodeFromID(NodeFrom.Origin, NodeList);   end;   s:= s + inttostr(NodeFrom.ID);   ShowMessage(s); end;  procedure TForm1.Button1Click(Sender: TObject); begin   SearchShortestPath(Random(N*N),Random(N*N)); end;  procedure TForm1.FormCreate(Sender: TObject); var   I: Integer; begin   //Initialisation   randomize;   SetLength(V,N*N);   SetLength(H,N*N);   for I := 0 to N*N-1 do   begin     V[I]:=random(100);     H[I]:=random(100);   end; end;  end.

The code spend most of the time in the routines: GetNodeFromID and GetNodeOfMiniWeight, and a substantial time to create nodes.

I thought that I could use a binary search, but since it requires the list to be sorted, I think that I'll loose the time in sorting the list. Any advice is welcome.

回答1:

I've implemented modification of Dijkstra Shortest Path algorithm for sparsed graphs. Your graph is very sparsed (E << V^2). This code uses priority queue based on binary heap, that contains (VerticeNum, DistanceFromSource) pairs as TPoints, ordered by Distance (Point.Y). It reveals loglinear (close to linear) asymptotic behavior. Example for small graph:

Times for i5-4670

N      V          time, ms 100    10^4       ~15 200    4*10^4     ~50-60  //about 8000 for your implementation  400    1.6*10^5   100 1600   2.5*10^6   1300  6400   4*10^7     24000 10000  10^8       63000  //~max size in 32-bit OS due to H,V arrays memory consumption

code:

function SparseDijkstra(Src, Dest: integer): string; var   Dist, PredV: array of integer;   I, j, vert, CurDist, toVert, len: integer;   q: TBinaryHeap;   top: TPoint;    procedure CheckAndChange;   begin     if Dist[vert] + len < Dist[toVert] then begin       Dist[toVert] := Dist[vert] + len;       PredV[toVert] := vert;       q.Push(Point(toVert, Dist[toVert]));       //old pair is still stored but has bad (higher) distance value     end;   end;  begin   SetLength(Dist, N * N);   SetLength(PredV, N * N);   for I := 0 to N * N - 1 do     Dist[I] := maxint;   Dist[Src] := 0;   q := TBinaryHeap.Create(N * N);   q.Cmp := ComparePointsByY;   q.Push(Point(Src, 0));   while not q.isempty do begin     top := q.pop;     vert := top.X;     CurDist := top.Y;     if CurDist > Dist[vert] then       continue; //out-of-date pair (bad distance value)      if (vert mod N) <> 0 then begin // step left       toVert := vert - 1;       len := H[toVert];       CheckAndChange;     end;     if (vert div N) <> 0 then begin // step up       toVert := vert - N;       len := V[toVert];       CheckAndChange;     end;     if (vert mod N) <> N - 1 then begin // step right       toVert := vert + 1;       len := H[vert];       CheckAndChange;     end;     if (vert div N) <> N - 1 then begin // step down       toVert := vert + N;       len := V[vert];       CheckAndChange;     end;   end;   q.Free;    // calculated data may be used with miltiple destination points   result := '';   vert := Dest;   while vert <> Src do begin     result := Format(', %d', [vert]) + result;     vert := PredV[vert];   end;   result := Format('%d', [vert]) + result; end;   procedure TForm1.Button2Click(Sender: TObject); var   t: Dword;   I, row, col: integer; begin   t := GetTickCount;   if N < 6 then // visual checker     for I := 0 to N * N - 1 do begin       col := I mod N;       row := I div N;       Canvas.Font.Color := clBlack;       Canvas.Font.Style := [fsBold];       Canvas.TextOut(20 + col * 70, row * 70, inttostr(I));       Canvas.Font.Style := [];       Canvas.Font.Color := clRed;       if col < N - 1 then         Canvas.TextOut(20 + col * 70 + 30, row * 70, inttostr(H[I]));       Canvas.Font.Color := clBlue;       if row < N - 1 then         Canvas.TextOut(20 + col * 70, row * 70 + 30, inttostr(V[I]));     end;   Memo1.Lines.Add(SparseDijkstra({0, n*n-1}random(N * N), random(N * N)));   Memo1.Lines.Add('time ' + inttostr(GetTickCount - t)); end;

Edit: TQPriorityQueue is class for internal use, but you can try any implementation of heap-based priority queue. For example, this one. You have to change Pointer to TPoint, Word to Integer in this module.

Edit2: I've replaced proprietary queue method names in my procedure by BinaryHeap methods.

回答2:

First of all, use a profiler! For instance, see http://www.delphitools.info/samplingprofiler

Your current code has several weaknesses:

It leaks memory (TNode/TNodeList instances);
You may use dynamic arrays of records instead of individual class instances for nodes (with a count stored outside);
I was not able to recognize your algorithm just by reading the code - so I guess you may enhance the code design.

The pseudo-code of this algorithm is as followed:

for all vertices v, dist(v) = infinity; dist(first) = 0; place all vertices in set toBeChecked; while toBeChecked is not empty   {in this version, also stop when shortest path to a specific destination is found}   select v: min(dist(v)) in toBeChecked;   remove v from toBeChecked;   for u in toBeChecked, and path from v to u exists   {i.e. for unchecked adjacents to v}   do     if dist(u) > dist(v) + weight({u,v}),     then        dist(u) = dist(v) + weight({u,v});        set predecessor of u to v        save minimum distance to u in array "d"      endif   enddo endwhile

Did you try this library from DelphiForFun ? Sounds like something already proven, updated recently, and well written. May be improved (e.g. using an array of bits instead array of boolean), but sounds pretty correct for a start.

文章来源: Optimisation of a Dijkstra Shortest Path Search in Delphi

标签

dijkstra