阅读:3165回复:7
最短路径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. |
|
1楼#
发布于:2003-09-30 11:47
good
|
|
|
2楼#
发布于:2003-10-29 08:46
兄弟你的程序没有注释,不太容易懂啊
|
|
|
3楼#
发布于:2004-08-12 11:58
![]() |
|
|
4楼#
发布于:2004-10-28 15:20
shi a
|
|
5楼#
发布于:2005-03-17 12:50
|
|
6楼#
发布于:2005-03-17 12:51
|
|
7楼#
发布于:2005-04-16 19:46
没有注释看不懂呀 不过比没有好呵呵 |
|