2014-03-12 89 views
4

我正在尋找建議,以加速我在加權圖上實現Dijkstra最短路徑搜索,這是一個方矩陣N×N。水平頂點上的權重稱爲H(對垂直的V)。Delphi中Dijkstra最短路徑搜索的優化

一張圖片勝過千言萬語:

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

當然,這是一個更大的應用程序的一部分,但我已經提取的相關位的位置:

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. 

的代碼大部分時間都用在例程中:GetNodeFromIDGetNodeOfMiniWeight,以及創建節點的大量時間。

我以爲我可以使用二進制搜索,但因爲它需要列表排序,我認爲我會放棄排序列表的時間。任何建議是受歡迎的。

+0

其他實現使用哪些算法優化? –

+0

我在網上看到的實現是隨機圖並使用特定的容器。在我的程序中,N,H和V已經存儲在內存中,如果我正在使用另一個容器,我將失去它的內存以及構建圖形的時間。 –

+0

Dijkstra算法找到從一個選定節點到所有其他節點的最短路徑。您正在任意一對節點之間搜索S.P.你需要所有節點之間的所有S.P.(如弗洛伊德的算法)還是隻需要兩個選定節點之間的一個S.P.(如A *(A-Star))? – MBo

回答

3

我已經實現了針對稀疏圖的Dijkstra Shortest Path算法的修改。您的圖形非常稀疏(E < < V^2)。此代碼使用基於二進制堆的優先級隊列,該隊列包含(VerticeNum,DistanceFromSource)對作爲TPoints,按Distance(Point.Y)排序。它揭示了對數線性(接近線性)漸近行爲。例如,對於小圖:

Wr

時報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是供內部使用的類,但你可以嘗試任何基於堆的優先級隊列的實現。例如,this one。您必須將指針更改爲TPoint,將Word更改爲整數。

編輯2: 我已經用BinaryHeap方法替換了我的過程中的專有隊列方法名稱。

+0

這看起來非常接近我要找的東西。但是我無法測試你的代碼,因爲我沒有TQPriorityQueue。你能幫我解決這個問題嗎? –

+0

對不起,這是內部使用類。建議更換。 – MBo

+0

我已經提出瞭如何建議,但是必須在BinaryHeap代碼中添加一個補充修改: 如果f(t) fItems [I] .x = xx)和(fItems [I] .y = xy)然後' 我也被'ComparePointsByY函數卡住了。我已經創建了它,但是我已經在指針方法和常規過程之間進行了確認 –

9

首先,使用探查器!例如,看到http://www.delphitools.info/samplingprofiler

您當前的代碼中有幾個弱點:

  • 它泄漏內存(TNode/TNodeList實例);
  • 您可以使用記錄的動態數組而不是單個的類節點實例(外部存儲計數);
  • 我不能通過閱讀代碼來識別你的算法 - 所以我想你可能會加強代碼設計。

該算法的僞代碼如下:

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 

你嘗試this library from DelphiForFun?聽起來像已經證明,最近更新,並寫得很好。可以改進(例如使用一個位數組來代替array of boolean),但是聽起來非常正確。

+0

作爲分析器,我使用的是在Radstudio中構建的AQTime,應該足夠了嗎? –

+0

我忘了謝謝你的回答。關於德爾福樂趣,這實際上是我開始我的工作,我重新使用該代碼的一部分。但是我開始使用我自己的代碼的原因是我認爲我的網格的規律可以在實現中爲我節省很多。 –

+0

所以我明白爲什麼AQTime無法幫助我解決內存泄漏問題。此漏洞很容易修復。我從來沒有注意到這一點。我的許多程序可能有內存泄漏。但是,我無法使Sampling Profiler正常工作。 它沒有找到源文件。我在這裏張貼這個程序的屏幕截圖:[Screenshot1](http://lionelgermain.free.fr/img/screenshot1.png)[Screenshot2](http://lionelgermain.free.fr/img/screenshot2.png )。如果你能幫助我。 –