本文介绍了Delphi中Dijkstra最短路径搜索的优化的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在寻找建议，以加快在权重图上执行Dijkstra最短路径搜索的过程，权重图是一个N x N的方矩阵.水平顶点的权重称为H(垂直顶点的权重为V). /p>
一张图片值一千字:
(来源: free.fr )
当然，这是更大应用程序的一部分，但是我在这里提取了相关内容:
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.代码在例程GetNodeFromID和GetNodeOfMiniWeight中花费了大部分时间，并且在创建节点上花费了大量时间.
我认为我可以使用二进制搜索，但是由于它需要对列表进行排序，因此我认为我会浪费时间对列表进行排序.欢迎任何建议.
解决方案我为稀疏图实现了Dijkstra最短路径算法的修改.您的图非常稀疏(E<< V ^ 2).此代码使用基于二进制堆的优先级队列，该队列包含(VerticeNum，DistanceFromSource)对作为TPoint，并按Distance(Point.Y)进行排序.它揭示了对数线性(接近线性)渐近行为.小图示例:
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代码:
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;TQPriorityQueue是内部使用的类，但是您可以尝试任何基于堆的优先级队列的实现.例如，此.您必须在此模块中将Pointer更改为TPoint，将Word更改为Integer.
Edit2: 我已经用BinaryHeap方法替换了过程中的专有队列方法名称.
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:
(source: free.fr)
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.
解决方案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 consumptioncode:
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.
更多推荐
Delphi中Dijkstra最短路径搜索的优化
发布评论