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

Question

我正在寻求建议，以加快在加权图上实现 Dijkstra 最短路径搜索，该加权图是 N x N 方阵。水平顶点上的权重称为 H(垂直顶点上的权重称为 V)。

一图胜千言:

_{(来源: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，以及创建节点的大量时间。

我认为我可以使用二分搜索，但由于它需要对列表进行排序，所以我认为我会浪费对列表进行排序的时间。欢迎任何建议。

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 ？听起来像是已经被证明、最近更新并且写得很好的东西。可能会得到改进(例如，使用位数组代替 bool 数组)，但一开始听起来相当正确。