2014-03-12 5 views
4

사각형 행렬 N x N 인 가중 그래프에서 Dijkstra Shortest Path Search의 구현 속도를 높이는 조언을 찾고 있습니다. 수평 꼭지점의 가중치를 H 수평 수직선에 수직선). 이 더 큰 응용 프로그램의 일부입니다, 물론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.가 필요합니까 (예 : Floyd 's algo와 같은) 또는 두 개의 선택된 노드 사이에 S.P.가 하나만 필요합니까 (예 : A * (A-Star)와 같은)? – MBo

답변

3

스파 스 그래프에 대한 Dijkstra 최단 경로 알고리즘의 수정을 구현했습니다. 그래프가 매우 희박합니다 (E < < V^2). 이 코드는 Distance (Point.Y)로 정렬 된 TPoints (VerticeNum, DistanceFromSource) 쌍을 포함하는 바이너리 힙 기반의 우선 순위 큐를 사용합니다. 그것은 loglinear (linear에 가까운) asymptotic 행동을 보여준다. 작은 그래프의 예 :

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는 내부 용 클래스입니다,하지만 당신은 시도 할 수

Wr

시간 코드

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 

i5-4670에 대한 힙 기반 우선 순위 큐 구현 예 : this one. 이 모듈에서 포인터를 TPoint, Word에서 Integer로 변경해야합니다.

편집 2 : 내 프로 시저에서 독점 큐 메서드 이름을 BinaryHeap 메서드로 바꿨습니다.

+0

이것은 내가 찾고있는 것에 아주 가깝게 보인다. 그러나 TQPriorityQueue 없기 때문에 코드를 테스트 할 수 없습니다. 이걸 좀 도와 주실 래요? –

+0

죄송합니다, 그것은 내부 사용 클래스입니다. 교체 제안. – MBo

+0

당신이 제안한 방법을했지만 BinaryHeap 코드에 하나의 보완 수정을해야합니다 : fouchems [I] = x, // <- E2015' if this ' fItems [I] .x = xx) 그리고 (fItems [I] .y = xy) then'' 'ComparePointsByY 함수와도 붙어 있습니다. 나는 그것을 만들었지 만 포인터 메서드와 일반 프로 시저 사이에 confilct –

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이 메모리 누수에 도움이되지 않는 이유를 알고 있습니다. 또한이 누설은 쉽게 고칠 수 있습니다. 나는 과거에는 이것을 결코 신경 쓰지 않는다. 많은 프로그램에서 메모리 누수가 발생할 수 있습니다. 그러나 샘플링 프로파일 러가 제대로 작동하지는 않습니다. 소스 파일을 찾지 못했습니다. 여기에 프로그램의 스크린 샷이 게시됩니다. [Screenshot1] (http://lionelgermain.free.fr/img/screenshot1.png) [Screenshot2] (http://lionelgermain.free.fr/img/screenshot2.png). 네가 나를 도울 수 있다면. –

관련 문제