Question

我正在寻找建议来加速我在加权图上实现Dijkstra最短路径搜索，该加权图是方形矩阵N x N.水平顶点上的权重称为H（垂直方向上的权重为V）。 / p>

一张图片胜过千言万语：

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.

代码大部分时间都花在例程中：GetNodeFromID和GetNodeOfMiniWeight，以及创建节点的大量时间。

我认为我可以使用二进制搜索，但由于它需要对列表进行排序，我认为我将节省排序列表的时间。欢迎任何建议。

Answer 1

首先，使用分析器！例如，请参阅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），但听起来非常正确。

Answer 2

我已经为稀疏图实现了Dijkstra最短路径算法的修改。您的图表非常稀疏（E

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更改为整数。

<强> EDIT2：我已经通过BinaryHeap方法在我的过程中替换了专有的队列方法名称。

Delphi中Dijkstra最短路径搜索的优化

2 个答案: