最短路径delphi

unit short;

interface

uses
    Sysutils,Dialogs,contnrs,windows,classes;
type
  Arrayinteger = array of integer;
  ArrayBoolean =array of boolean;
  Arraysingle = array of single;
  TLineInfo = Record
    MUSERID: Integer;
    MFNode: integer;
    MTNode: integer;
    FTNLT:string;
    TFNLT:string;
    FTP:double;
    TFP:double;
    length:double;
    NLT:string;
  end;
  ArrayLineInfo = array of TLineInfo;

  PTEdge=^TEdge;
  TEdge=Record
    AnotherNode:integer;
    LineInfo:TLineInfo;
    YCflag:boolean;
    JGflag:boolean;
    pNext:PTEdge;
  end;
  ArrayTpEdge = array of PTEdge;

type
  Tshortpath = class(TObject)
  private
  protected
    mTop: ArrayTpEdge;
    Max_size:integer;
    function CreateNode(aNode:integer;templineinfo:Tlineinfo):PTEdge;
    procedure AddNode(idNode:integer;aNode:integer;templineinfo:Tlineinfo);
    function GetNodeAdjNodes(NodeFID: integer; var AdjNodes: ArrayInteger):boolean;
    function GetNodeAdjLines(NodeFID: integer; var AdjLines: Arraylineinfo):boolean;
    function GetNodeAdjNodesLines(NodeFID: integer;var AdjNodes: ArrayInteger; var AdjLines: Arraylineinfo):boolean;
  public
    function findshortpath(startnode,endnode:integer;var Anodes:Arrayinteger;var distance:single):boolean;
    constructor Create(const ATopDataSource: ArrayLineInfo;MAXNode:integer);
    Destructor Destroy;override;

  end;

implementation


procedure  Tshortpath.AddNode(idNode:integer;aNode:integer;templineinfo:Tlineinfo);
var
  pEdge:pTEdge;
begin
  new(pEdge);
  pEdge.AnotherNode:=aNode;
  pEdge.lineinfo:=templineinfo;
  pEdge.YCflag:=false;
  pEdge.JGflag:=false;
  pEdge.pNext:=mTop[idNode];
  mTop[idNode]:=pEdge;
end;

constructor  Tshortpath.Create(const ATopDataSource: ArrayLineInfo;MAXNode:integer);
var
  fNode, tNode: integer;
  i:integer;
begin
  if MAXNode<=0 then exit;
  Max_size:=MAXNode;
  setlength(MTop,MAXNode+1);
  for i:=low(ATopDataSource) to high(ATopDataSource) do
  begin
    fNode:=ATopDataSource.MFNode;
    tNode:=ATopDataSource.MTNode;
    if mTop[fNode]=nil then
      mTop[fNode]:=CreateNode(tNode,ATopDataSource)
    else
      AddNode(fNode,tNode,ATopDataSource);
    if mTop[tNode]=nil then
      mTop[tNode]:=CreateNode(fNode,ATopDataSource)
    else
      AddNode(tNode,fNode,ATopDataSource);
  end;
end;

function  Tshortpath.CreateNode(aNode:integer;templineinfo:Tlineinfo):pTEdge;
var
  pEdge:pTEdge;
begin
  new(pEdge);
 pEdge.AnotherNode:=aNode;
  pEdge.lineinfo:=templineinfo;
  pEdge.YCflag:=false;
  pEdge.JGflag:=false;
  pEdge.pNext:=nil;
  result:=pEdge;
end;

destructor  Tshortpath.Destroy;
var
  pEdge,pNextEdge:pTEdge;
  i:integer;
begin
    for i:=0 to MAX_size do
    begin
      pNextEdge := mTop;
      while pNextEdge<>nil do
      begin
        pEdge:=pNextEdge;
        pNextEdge:=pNextEdge.pNext;
        dispose(pEdge);
      end;
    end;
  inherited;
end;


function  Tshortpath.findshortpath(startnode, endnode: integer;
  var Anodes:Arrayinteger;var distance:single): boolean;
var
templineinfos:arraylineinfo;
tempnode:integer;
XLtempnode:integer;
tempnodes:arrayinteger;
tempAdistance:arraysingle;
XLtempAdistance:arraysingle;
preresultNodes:arrayinteger;
aa,i,j,k,ii,kk:integer;
s:single;
min:single;
minpoint:integer;
no:arrayinteger;
begin
  result:=true;
  s:=0;
  k:=0;
  setlength(preresultNodes,MAX_size);
  setlength(tempAdistance,MAX_size+1);
  setlength(XLtempAdistance,MAX_size+1);
  for i:=0 to MAX_size do  tempAdistance:=1e+30;
  MTop[startnode].YCflag:=true;
  tempnode:=startnode;
  tempAdistance[tempnode]:=0;
  preresultNodes[tempnode]:=0;
  for aa:=0 to Max_size do
  begin
    if not GetNodeAdjNodesLines(tempnode,tempnodes,templineinfos) then continue;
    //判断单行道
    for j:=low(templineinfos) to high(templineinfos) do
    begin
      if tempnode=templineinfos[j].MFNode then
      begin
        templineinfos[j].length:=templineinfos[j].FTP;
        if templineinfos[j].length=0 then templineinfos[j].length:=1E+30;
      end
      else
      begin
        templineinfos[j].length:=templineinfos[j].TFP;
        if templineinfos[j].length=0 then templineinfos[j].length:=1E+30;
      end;
    end;
    //判断禁止转向
    for j:=low(templineinfos) to high(templineinfos) do
    begin
      if tempnode=templineinfos[j].MFNode then
      begin
        if preresultNodes[tempnode]=templineinfos[j].MTNode then
        begin
          for i:=low(tempnodes) to high(tempnodes) do
          begin
            if pos(inttostr(tempnodes),templineinfos[j].TFNLT)>0 then
            begin
              for kk:=low(templineinfos) to high(templineinfos) do
              begin
                 if templineinfos[kk].MTNode = tempnodes then
                 templineinfos[kk].length:=1E+30;
              end;
            end;
          end;
        end;
      end
      else
      begin
        if preresultNodes[tempnode]=templineinfos[j].MFNode then
        begin
          for i:=low(tempnodes) to high(tempnodes) do
          begin
            if pos(inttostr(tempnodes),templineinfos[j].FTNLT)>0 then
            begin
              for kk:=low(templineinfos) to high(templineinfos) do
              begin
                 if templineinfos[kk].MFNode = tempnodes then
                 templineinfos[kk].length:=1E+30;
              end;
            end;
          end;
        end;
      end;
    end;
    //求解最优路径
    for j:=low(tempnodes) to high(tempnodes) do
    begin
      XLtempnode:=tempnodes[j];
      s:=templineinfos[j].length+tempAdistance[tempnode];
      if MTop[XLtempnode].YCflag then continue;
      if MTop[XLtempnode].JGflag then
      begin
        if tempAdistance[XLtempnode]>=s then
        begin
          tempAdistance[XLtempnode]:=s;
          preresultNodes[XLtempnode]:=tempnode;
        end;
        continue;
      end;
      MTop[XLtempnode].JGflag:=true;
      tempAdistance[XLtempnode]:=s;
      preresultNodes[XLtempnode]:=tempnode;
      inc(k);
      if (k>length(no)) then setlength(no,length(no)+500);
      no[k-1]:=XLtempnode;
    end;
    min:=1E+30;
    minpoint:=0;
    for i:=aa to k-1 do
    begin
      if min>tempAdistance[no] then
      begin
        ii:=i;
        min:=tempAdistance[no];
        minpoint:=no;
      end;
    end;

    if min>=1E+30 then
    begin
      result:=false;
      exit;
    end;
    no[ii]:=no[aa];
    no[aa]:=minpoint;
    MTop[minpoint].YCflag:=true;
    tempnode:=minpoint;
    if tempnode = endnode then
    begin
      distance:=tempAdistance[endnode];
      setlength(Anodes,100);
      Anodes[0]:=endnode;
      i:=1;
      while preresultNodes[endnode]<>0 do
      begin
         inc(i);
         if length(Anodes)<i then
         setlength(Anodes,length(Anodes)+100);
         Anodes[i-1]:=preresultNodes[endnode];
         endnode:=preresultNodes[endnode];
      end;
      setlength(Anodes,i);
      exit;
    end;
  end;
end;

function  Tshortpath.GetNodeAdjLines(NodeFID: integer;
  var AdjLines:Arraylineinfo): boolean;
var
  pEdge: pTEdge;
  numLine: integer;

begin
  numLine := 0;
  pEdge := mTop[NodeFID];
  while pEdge <> nil do
  begin
    setlength(AdjLines,numLine + 1);
    AdjLines[numLine] := pEdge.lineinfo;
    inc(numLine);
    pEdge := pEdge.pNext;
  end;
  if numLine > 0 then
    result := True
  else
    result := False;
end;

function  Tshortpath.GetNodeAdjNodes(NodeFID: integer;
  var AdjNodes: ArrayInteger): boolean;
var
  pEdge: pTEdge;
  numNode: integer;
begin
  numNode := 0;
  pEdge := mTop[NodeFID];
  while pEdge <> nil do
  begin
    setlength(AdjNodes,numNode + 1);
    AdjNodes[numNode] := pEdge.AnotherNode;
    inc(numNode);
    pEdge := pEdge.pNext;
  end;
  if numNode > 0 then
    result := True
  else
    result := False;
end;

function Tshortpath.GetNodeAdjNodesLines(NodeFID: integer;
  var AdjNodes: ArrayInteger; var AdjLines: Arraylineinfo): boolean;

var
  pEdge: pTEdge;
  numNode: integer;
begin
  numNode := 0;
  pEdge := mTop[NodeFID];
  while pEdge <> nil do
  begin
    setlength(AdjNodes,numNode + 1);
    setlength(AdjLines,numNode + 1);
    AdjNodes[numNode] := pEdge.AnotherNode;
    AdjLines[numNode] := pEdge.lineinfo;
    inc(numNode);
    pEdge := pEdge.pNext;
  end;
  if numNode > 0 then
    result := True
  else
    result := False;
end;

end.

good

兄弟你的程序没有注释，不太容易懂啊

<img src="images/post/smile/dvbbs/em01.gif" />

shi a

<P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em05.gif" />,正在写一个通用的线形网络分析,可以参考参考,谢谢了</P>

<P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em05.gif" />,正在写一个通用的线形网络分析,可以参考参考,谢谢了</P>

<P>没有注释看不懂呀</P><P>不过比没有好呵呵</P>