/components/codetools/codegraph.pas

http://github.com/graemeg/lazarus · Pascal · 1003 lines · 853 code · 77 blank · 73 comment · 150 complexity · bd91af9f079447cfeb8d5db6aaedc03d MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Author: Mattias Gaertner
  21. Abstract:
  22. An arbitrary graph for TCodeTreeNode.
  23. }
  24. unit CodeGraph;
  25. {$mode objfpc}{$H+}
  26. interface
  27. uses
  28. Classes, SysUtils, CodeTree, FileProcs, AVL_Tree;
  29. type
  30. { TCodeGraphNode }
  31. TCodeGraphNode = class
  32. private
  33. FInternalFlags: integer;
  34. public
  35. Node: TCodeTreeNode;
  36. InTree: TAVLTree;// tree of TCodeGraphEdge sorted for FromNode (ToNode = Self)
  37. OutTree: TAVLTree;// tree of TCodeGraphEdge sorted for ToNode (FromNode = Self)
  38. Data: Pointer; // custom data
  39. Flags: cardinal;// custom flags
  40. function OutTreeCount: integer;
  41. function InTreeCount: integer;
  42. end;
  43. TCodeGraphNodeClass = class of TCodeGraphNode;
  44. PCodeGraphEdgeKey = ^TCodeGraphEdgeKey;
  45. TCodeGraphEdgeKey = record
  46. FromNode: TCodeTreeNode;
  47. ToNode: TCodeTreeNode;
  48. end;
  49. { TCodeGraphEdge }
  50. TCodeGraphEdge = class
  51. private
  52. FInternalFlags: integer;
  53. public
  54. FromNode: TCodeGraphNode;
  55. ToNode: TCodeGraphNode;
  56. Data: Pointer; // custom data
  57. Flags: cardinal;// custom flags
  58. end;
  59. TCodeGraphEdgeClass = class of TCodeGraphEdge;
  60. { TCodeGraph }
  61. TCodeGraph = class
  62. private
  63. FEdgeClass: TCodeGraphEdgeClass;
  64. FNodeClass: TCodeGraphNodeClass;
  65. procedure ClearInternalNodeFlags;
  66. public
  67. Nodes: TAVLTree; // tree of TCodeGraphNode sorted for Node
  68. Edges: TAVLTree; // tree of TCodeGraphEdge sorted for FromNode,ToNode
  69. constructor Create(ANodeClass: TCodeGraphNodeClass = nil;
  70. AnEdgeClass: TCodeGraphEdgeClass = nil);
  71. destructor Destroy; override;
  72. procedure Clear;
  73. procedure ClearNodeFlags;
  74. procedure ClearEdgeFlags;
  75. procedure Assign(Source: TCodeGraph);
  76. function CreateCopy: TCodeGraph;
  77. function AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
  78. function GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
  79. ): TCodeGraphNode;
  80. procedure DeleteGraphNode(Node: TCodeTreeNode);
  81. function FindGraphNodeWithNumberOfOutEdges(MinNumber, MaxNumber: integer
  82. ): TCodeGraphNode;
  83. function FindGraphNodeWithNumberOfInEdges(MinNumber, MaxNumber: integer
  84. ): TCodeGraphNode;
  85. function PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
  86. function AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
  87. function GetEdge(FromNode, ToNode: TCodeTreeNode;
  88. CreateIfNotExists: boolean): TCodeGraphEdge;
  89. procedure DeleteEdge(FromNode, ToNode: TCodeTreeNode);
  90. procedure DeleteEdge(Edge: TCodeGraphEdge);
  91. procedure DeleteSelfCircles;
  92. procedure CombineNodes(ListOfGraphNodes: TFPList; GraphNode: TCodeGraphNode);
  93. function GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
  94. InEdgeDirection, // true=start with source nodes (no InEdges)
  95. SetTopologicalLvl,// true=set Node.Flags to level
  96. SortForStartPos: boolean// true=secondary sort order is Node.StartPos
  97. ): TCodeGraphEdge;// is a circle edge (if found, else nil)
  98. procedure GetMaximumCircle(StartNode: TCodeGraphNode;
  99. out ListOfGraphNodes: TFPList);
  100. function FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
  101. function FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
  102. ): TAVLTreeNode;
  103. function FindAVLNodeOfFromNode(OutTree: TAVLTree; FromNode: TCodeTreeNode
  104. ): TAVLTreeNode;
  105. function FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode): TAVLTreeNode;
  106. property NodeClass: TCodeGraphNodeClass read FNodeClass;
  107. property EdgeClass: TCodeGraphEdgeClass read FEdgeClass;
  108. procedure ConsistencyCheck;
  109. end;
  110. function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
  111. function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
  112. function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
  113. function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
  114. function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
  115. function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
  116. function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
  117. function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
  118. implementation
  119. function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
  120. var
  121. Node1: TCodeTreeNode;
  122. Node2: TCodeTreeNode;
  123. begin
  124. Node1:=TCodeGraphNode(GraphNode1).Node;
  125. Node2:=TCodeGraphNode(GraphNode2).Node;
  126. if Pointer(Node1)>Pointer(Node2) then
  127. Result:=1
  128. else if Pointer(Node1)<Pointer(Node2) then
  129. Result:=-1
  130. else
  131. Result:=0;
  132. //DebugLn(['CompareGraphNodeByNode ',Node1.DescAsString,' ',Node2.DescAsString,' ',Result]);
  133. end;
  134. function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
  135. var
  136. Node: TCodeTreeNode;
  137. begin
  138. Node:=TCodeGraphNode(GraphNode).Node;
  139. if p>Pointer(Node) then
  140. Result:=1
  141. else if p<Pointer(Node) then
  142. Result:=-1
  143. else
  144. Result:=0;
  145. //DebugLn(['ComparePointerWithGraphNodeNode ',TCodeTreeNode(p).DescAsString,' ',Node.DescAsString,' ',Result]);
  146. end;
  147. function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
  148. var
  149. Node1: TCodeTreeNode;
  150. Node2: TCodeTreeNode;
  151. begin
  152. Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
  153. Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
  154. if Pointer(Node1)>Pointer(Node2) then
  155. Result:=1
  156. else if Pointer(Node1)<Pointer(Node2) then
  157. Result:=-1
  158. else
  159. Result:=0;
  160. end;
  161. function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
  162. var
  163. Node: TCodeTreeNode;
  164. begin
  165. Node:=TCodeGraphEdge(GraphEdge).FromNode.Node;
  166. if p>Pointer(Node) then
  167. Result:=1
  168. else if p<Pointer(Node) then
  169. Result:=-1
  170. else
  171. Result:=0;
  172. end;
  173. function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
  174. var
  175. Node1: TCodeTreeNode;
  176. Node2: TCodeTreeNode;
  177. begin
  178. Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
  179. Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
  180. if Pointer(Node1)>Pointer(Node2) then
  181. Result:=1
  182. else if Pointer(Node1)<Pointer(Node2) then
  183. Result:=-1
  184. else
  185. Result:=0;
  186. end;
  187. function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
  188. var
  189. Node: TCodeTreeNode;
  190. begin
  191. Node:=TCodeGraphEdge(GraphEdge).ToNode.Node;
  192. if p>Pointer(Node) then
  193. Result:=1
  194. else if p<Pointer(Node) then
  195. Result:=-1
  196. else
  197. Result:=0;
  198. end;
  199. function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
  200. var
  201. Node1: TCodeTreeNode;
  202. Node2: TCodeTreeNode;
  203. begin
  204. Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
  205. Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
  206. if Pointer(Node1)>Pointer(Node2) then
  207. exit(1)
  208. else if Pointer(Node1)<Pointer(Node2) then
  209. exit(-1);
  210. Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
  211. Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
  212. if Pointer(Node1)>Pointer(Node2) then
  213. exit(1)
  214. else if Pointer(Node1)<Pointer(Node2) then
  215. exit(-1);
  216. Result:=0;
  217. end;
  218. function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
  219. var
  220. Key: PCodeGraphEdgeKey;
  221. Edge: TCodeGraphEdge;
  222. Node1: TCodeTreeNode;
  223. Node2: TCodeTreeNode;
  224. begin
  225. Key:=PCodeGraphEdgeKey(EdgeKey);
  226. Edge:=TCodeGraphEdge(GraphEdge);
  227. Node1:=Key^.FromNode;
  228. Node2:=Edge.FromNode.Node;
  229. if Pointer(Node1)>Pointer(Node2) then
  230. exit(1)
  231. else if Pointer(Node1)<Pointer(Node2) then
  232. exit(-1);
  233. Node1:=Key^.ToNode;
  234. Node2:=Edge.ToNode.Node;
  235. if Pointer(Node1)>Pointer(Node2) then
  236. exit(1)
  237. else if Pointer(Node1)<Pointer(Node2) then
  238. exit(-1);
  239. Result:=0;
  240. end;
  241. function CompareGraphNodesForTopoLvlAndStartPos(
  242. GraphNode1, GraphNode2: Pointer): integer;
  243. // 1 if lower Level (FInternalFlags) or if lvl is the same and lower Node.StartPos
  244. var
  245. Level1: LongInt;
  246. Level2: LongInt;
  247. StartPos1: LongInt;
  248. StartPos2: LongInt;
  249. begin
  250. Level1:=TCodeGraphNode(GraphNode1).FInternalFlags;
  251. Level2:=TCodeGraphNode(GraphNode2).FInternalFlags;
  252. if Level1<Level2 then
  253. Result:=1
  254. else if Level1>Level2 then
  255. Result:=-1
  256. else begin
  257. StartPos1:=TCodeGraphNode(GraphNode1).Node.StartPos;
  258. StartPos2:=TCodeGraphNode(GraphNode2).Node.StartPos;
  259. if StartPos1<StartPos2 then
  260. Result:=1
  261. else if StartPos1>StartPos2 then
  262. Result:=-1
  263. else
  264. Result:=0;
  265. end;
  266. end;
  267. { TCodeGraph }
  268. procedure TCodeGraph.ClearInternalNodeFlags;
  269. var
  270. AVLNode: TAVLTreeNode;
  271. begin
  272. AVLNode:=Nodes.FindLowest;
  273. while AVLNode<>nil do begin
  274. TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
  275. AVLNode:=Nodes.FindSuccessor(AVLNode);
  276. end;
  277. end;
  278. constructor TCodeGraph.Create(ANodeClass: TCodeGraphNodeClass;
  279. AnEdgeClass: TCodeGraphEdgeClass);
  280. begin
  281. if ANodeClass<>nil then
  282. FNodeClass:=ANodeClass
  283. else
  284. FNodeClass:=TCodeGraphNode;
  285. if AnEdgeClass<>nil then
  286. FEdgeClass:=AnEdgeClass
  287. else
  288. FEdgeClass:=TCodeGraphEdge;
  289. Nodes:=TAVLTree.Create(@CompareGraphNodeByNode);
  290. Edges:=TAVLTree.Create(@CompareGraphEdgeByNodes);
  291. end;
  292. destructor TCodeGraph.Destroy;
  293. begin
  294. Clear;
  295. FreeAndNil(Nodes);
  296. FreeAndNil(Edges);
  297. inherited Destroy;
  298. end;
  299. procedure TCodeGraph.Clear;
  300. var
  301. AVLNode: TAVLTreeNode;
  302. GraphNode: TCodeGraphNode;
  303. begin
  304. AVLNode:=Nodes.FindLowest;
  305. while AVLNode<>nil do begin
  306. GraphNode:=TCodeGraphNode(AVLNode.Data);
  307. if GraphNode.InTree<>nil then begin
  308. GraphNode.InTree.FreeAndClear;// free the TCodeGraphEdge objects
  309. FreeAndNil(GraphNode.InTree);// free the InTree
  310. end;
  311. if GraphNode.OutTree<>nil then
  312. FreeAndNil(GraphNode.OutTree);// free the OutTree
  313. AVLNode:=Nodes.FindSuccessor(AVLNode);
  314. end;
  315. Nodes.FreeAndClear;// free the TCodeGraphNode objects
  316. Edges.Clear;
  317. end;
  318. procedure TCodeGraph.ClearNodeFlags;
  319. var
  320. AVLNode: TAVLTreeNode;
  321. begin
  322. AVLNode:=Nodes.FindLowest;
  323. while AVLNode<>nil do begin
  324. TCodeGraphNode(AVLNode.Data).Flags:=0;
  325. TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
  326. AVLNode:=Nodes.FindSuccessor(AVLNode);
  327. end;
  328. end;
  329. procedure TCodeGraph.ClearEdgeFlags;
  330. var
  331. AVLNode: TAVLTreeNode;
  332. begin
  333. AVLNode:=Edges.FindLowest;
  334. while AVLNode<>nil do begin
  335. TCodeGraphEdge(AVLNode.Data).Flags:=0;
  336. TCodeGraphEdge(AVLNode.Data).FInternalFlags:=0;
  337. AVLNode:=Edges.FindSuccessor(AVLNode);
  338. end;
  339. end;
  340. procedure TCodeGraph.Assign(Source: TCodeGraph);
  341. var
  342. AVLNode: TAVLTreeNode;
  343. GraphNode: TCodeGraphNode;
  344. SrcGraphNode: TCodeGraphNode;
  345. SrcGraphEdge: TCodeGraphEdge;
  346. GraphEdge: TCodeGraphEdge;
  347. begin
  348. if Source=Self then exit;
  349. Clear;
  350. FNodeClass:=Source.FNodeClass;
  351. FEdgeClass:=Source.FEdgeClass;
  352. // copy nodes
  353. AVLNode:=Source.Nodes.FindLowest;
  354. while AVLNode<>nil do begin
  355. SrcGraphNode:=TCodeGraphNode(AVLNode.Data);
  356. GraphNode:=AddGraphNode(SrcGraphNode.Node);
  357. GraphNode.Data:=SrcGraphNode.Data;
  358. AVLNode:=Source.Nodes.FindSuccessor(AVLNode);
  359. end;
  360. // copy edges
  361. AVLNode:=Source.Edges.FindLowest;
  362. while AVLNode<>nil do begin
  363. SrcGraphEdge:=TCodeGraphEdge(AVLNode.Data);
  364. GraphEdge:=AddEdge(SrcGraphEdge.FromNode.Node,SrcGraphEdge.ToNode.Node);
  365. GraphEdge.Data:=SrcGraphEdge.Data;
  366. AVLNode:=Source.Edges.FindSuccessor(AVLNode);
  367. end;
  368. end;
  369. function TCodeGraph.CreateCopy: TCodeGraph;
  370. begin
  371. Result:=TCodeGraph.Create;
  372. Result.Assign(Self);
  373. end;
  374. function TCodeGraph.AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
  375. begin
  376. Result:=GetGraphNode(Node,true);
  377. end;
  378. function TCodeGraph.GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
  379. ): TCodeGraphNode;
  380. var
  381. AVLNode: TAVLTreeNode;
  382. begin
  383. if Node=nil then exit(nil);
  384. AVLNode:=FindAVLNodeOfNode(Node);
  385. if AVLNode<>nil then
  386. Result:=TCodeGraphNode(AVLNode.Data)
  387. else if CreateIfNotExists then begin
  388. Result:=FNodeClass.Create;
  389. Result.Node:=Node;
  390. Nodes.Add(Result);
  391. end else
  392. Result:=nil;
  393. end;
  394. procedure TCodeGraph.DeleteGraphNode(Node: TCodeTreeNode);
  395. var
  396. AVLNode: TAVLTreeNode;
  397. GraphNode: TCodeGraphNode;
  398. OutAVLNode: TAVLTreeNode;
  399. Edge: TCodeGraphEdge;
  400. InTree: TAVLTree;
  401. OutTree: TAVLTree;
  402. InAVLNode: TAVLTreeNode;
  403. begin
  404. AVLNode:=FindAVLNodeOfNode(Node);
  405. if AVLNode=nil then exit;
  406. GraphNode:=TCodeGraphNode(AVLNode.Data);
  407. OutTree:=GraphNode.OutTree;
  408. if OutTree<>nil then begin
  409. // remove all edges coming from this Node
  410. OutAVLNode:=OutTree.FindLowest;
  411. while OutAVLNode<>nil do begin
  412. Edge:=TCodeGraphEdge(OutAVLNode.Data);
  413. InTree:=Edge.ToNode.InTree;
  414. InTree.Remove(Edge);
  415. Edges.Remove(Edge);
  416. Edge.Free;
  417. OutAVLNode:=OutTree.FindSuccessor(OutAVLNode);
  418. end;
  419. OutTree.Free;
  420. end;
  421. InTree:=GraphNode.InTree;
  422. if InTree<>nil then begin
  423. // remove all edges going to this Node
  424. InAVLNode:=InTree.FindLowest;
  425. while InAVLNode<>nil do begin
  426. Edge:=TCodeGraphEdge(InAVLNode.Data);
  427. OutTree:=Edge.FromNode.OutTree;
  428. OutTree.Remove(Edge);
  429. Edges.Remove(Edge);
  430. Edge.Free;
  431. InAVLNode:=InTree.FindSuccessor(InAVLNode);
  432. end;
  433. InTree.Free;
  434. end;
  435. Nodes.Delete(AVLNode);
  436. GraphNode.Free;
  437. end;
  438. function TCodeGraph.FindGraphNodeWithNumberOfOutEdges(MinNumber,
  439. MaxNumber: integer): TCodeGraphNode;
  440. var
  441. AVLNode: TAVLTreeNode;
  442. Cnt: LongInt;
  443. begin
  444. AVLNode:=Nodes.FindLowest;
  445. while AVLNode<>nil do begin
  446. Result:=TCodeGraphNode(AVLNode.Data);
  447. Cnt:=Result.OutTreeCount;
  448. if ((MinNumber<0) or (MinNumber<=Cnt))
  449. and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
  450. exit;
  451. AVLNode:=Nodes.FindSuccessor(AVLNode);
  452. end;
  453. Result:=nil;
  454. end;
  455. function TCodeGraph.FindGraphNodeWithNumberOfInEdges(MinNumber,
  456. MaxNumber: integer): TCodeGraphNode;
  457. var
  458. AVLNode: TAVLTreeNode;
  459. Cnt: LongInt;
  460. begin
  461. AVLNode:=Nodes.FindLowest;
  462. while AVLNode<>nil do begin
  463. Result:=TCodeGraphNode(AVLNode.Data);
  464. Cnt:=Result.InTreeCount;
  465. if ((MinNumber<0) or (MinNumber<=Cnt))
  466. and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
  467. exit;
  468. AVLNode:=Nodes.FindSuccessor(AVLNode);
  469. end;
  470. Result:=nil;
  471. end;
  472. function TCodeGraph.PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
  473. function Search(GraphNode: TCodeGraphNode): boolean;
  474. var
  475. AVLNode: TAVLTreeNode;
  476. GraphEdge: TCodeGraphEdge;
  477. begin
  478. Result:=false;
  479. if GraphNode=nil then exit;
  480. if GraphNode.Node=ToNode then exit(true);
  481. if GraphNode.FInternalFlags>0 then exit;
  482. GraphNode.FInternalFlags:=1;
  483. if GraphNode.OutTree=nil then exit;
  484. AVLNode:=GraphNode.OutTree.FindLowest;
  485. while AVLNode<>nil do begin
  486. GraphEdge:=TCodeGraphEdge(AVLNode.Data);
  487. if Search(GraphEdge.ToNode) then exit(true);
  488. AVLNode:=GraphNode.OutTree.FindSuccessor(AVLNode);
  489. end;
  490. end;
  491. begin
  492. Result:=false;
  493. ClearInternalNodeFlags;
  494. Result:=Search(GetGraphNode(FromNode,false));
  495. end;
  496. function TCodeGraph.AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
  497. begin
  498. Result:=GetEdge(FromNode,ToNode,true);
  499. end;
  500. procedure TCodeGraph.DeleteEdge(FromNode, ToNode: TCodeTreeNode);
  501. begin
  502. DeleteEdge(GetEdge(FromNode,ToNode,false));
  503. end;
  504. procedure TCodeGraph.DeleteEdge(Edge: TCodeGraphEdge);
  505. begin
  506. if Edge=nil then exit;
  507. Edge.FromNode.OutTree.Remove(Edge);
  508. Edge.ToNode.InTree.Remove(Edge);
  509. Edges.Remove(Edge);
  510. Edge.Free;
  511. end;
  512. procedure TCodeGraph.DeleteSelfCircles;
  513. var
  514. AVLNode: TAVLTreeNode;
  515. NextNode: TAVLTreeNode;
  516. Edge: TCodeGraphEdge;
  517. begin
  518. AVLNode:=Edges.FindLowest;
  519. while AVLNode<>nil do begin
  520. NextNode:=Edges.FindSuccessor(AVLNode);
  521. Edge:=TCodeGraphEdge(AVLNode.Data);
  522. if Edge.FromNode=Edge.ToNode then
  523. DeleteEdge(Edge);
  524. AVLNode:=NextNode;
  525. end;
  526. end;
  527. procedure TCodeGraph.CombineNodes(ListOfGraphNodes: TFPList;
  528. GraphNode: TCodeGraphNode);
  529. // combines all nodes in ListOfGraphNodes into the super node Node
  530. var
  531. i: Integer;
  532. CurGraphNode: TCodeGraphNode;
  533. AVLNode: TAVLTreeNode;
  534. Edge: TCodeGraphEdge;
  535. begin
  536. if ListOfGraphNodes=nil then exit;
  537. // create for each edge to/from the List an edge to the super node
  538. for i:=0 to ListOfGraphNodes.Count-1 do begin
  539. CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
  540. if CurGraphNode=GraphNode then continue;
  541. if CurGraphNode.InTree<>nil then begin
  542. AVLNode:=CurGraphNode.InTree.FindLowest;
  543. while AVLNode<>nil do begin
  544. Edge:=TCodeGraphEdge(AVLNode.Data);
  545. // add an edge to super node
  546. if Edge.FromNode<>GraphNode then
  547. AddEdge(Edge.FromNode.Node,GraphNode.Node);
  548. AVLNode:=CurGraphNode.InTree.FindSuccessor(AVLNode);
  549. end;
  550. end;
  551. if CurGraphNode.OutTree<>nil then begin
  552. AVLNode:=CurGraphNode.OutTree.FindLowest;
  553. while AVLNode<>nil do begin
  554. Edge:=TCodeGraphEdge(AVLNode.Data);
  555. // add an edge from super node
  556. if Edge.ToNode<>GraphNode then
  557. AddEdge(GraphNode.Node,Edge.ToNode.Node);
  558. AVLNode:=CurGraphNode.OutTree.FindSuccessor(AVLNode);
  559. end;
  560. end;
  561. end;
  562. // delete list nodes
  563. for i:=0 to ListOfGraphNodes.Count-1 do begin
  564. CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
  565. if CurGraphNode=GraphNode then continue;
  566. // remove list node
  567. DeleteGraphNode(CurGraphNode.Node);
  568. end;
  569. end;
  570. function TCodeGraph.GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
  571. InEdgeDirection, SetTopologicalLvl, SortForStartPos: boolean): TCodeGraphEdge;
  572. { returns nil if there is no circle
  573. else: returns a circle edge
  574. ListOfTGraphNodes are all those GraphNodes, that could be sorted topologically
  575. if InEdgeDirection=true then the list starts with the nodes without in-edges
  576. else the list start with the nodes without out-edges
  577. if SetTopologicalLvl=true then the GraphNode.Flags will be set to the
  578. topological level, starting at 0 for nodes with no in edges.
  579. if SortForStartPos=true the nodes will be sorted for Node.StartPos
  580. as secondary order, keeping the topologically order
  581. }
  582. var
  583. NodeQueue: array of TCodeGraphNode;
  584. QueueStart: Integer;
  585. QueueEnd: Integer;
  586. procedure AddNode(GraphNode: TCodeGraphNode);
  587. begin
  588. //DebugLn(['AddNode ',GraphNode.Node.DescAsString]);
  589. NodeQueue[QueueEnd]:=GraphNode;
  590. inc(QueueEnd);
  591. end;
  592. var
  593. AVLNode: TAVLTreeNode;
  594. GraphNode: TCodeGraphNode;
  595. GraphEdge: TCodeGraphEdge;
  596. CurGraphNode: TCodeGraphNode;
  597. EdgeAVLNode: TAVLTreeNode;
  598. i: Integer;
  599. CurTree: TAVLTree;
  600. SortedNodes: TAVLTree;
  601. begin
  602. //DebugLn(['TCodeGraph.GetTopologicalSortedList START']);
  603. Result:=nil;
  604. ListOfGraphNodes:=TFPList.Create;
  605. if (Nodes=nil) or (Nodes.Count=0) then exit;
  606. ListOfGraphNodes.Capacity:=Nodes.Count;
  607. try
  608. // init queue
  609. SetLength(NodeQueue,Nodes.Count);
  610. QueueStart:=0;
  611. QueueEnd:=0;
  612. // add all nodes without incoming edges and set all FInternalFlags to
  613. // the number of incoming nodes
  614. AVLNode:=Nodes.FindLowest;
  615. while AVLNode<>nil do begin
  616. GraphNode:=TCodeGraphNode(AVLNode.Data);
  617. if InEdgeDirection then
  618. CurTree:=GraphNode.InTree
  619. else
  620. CurTree:=GraphNode.OutTree;
  621. if (CurTree=nil) or (CurTree.Count=0) then begin
  622. GraphNode.FInternalFlags:=0;
  623. AddNode(GraphNode);
  624. end else begin
  625. GraphNode.FInternalFlags:=CurTree.Count;
  626. end;
  627. AVLNode:=Nodes.FindSuccessor(AVLNode);
  628. end;
  629. // add all nodes without incoming edges from the queue into the list
  630. while QueueStart<>QueueEnd do begin
  631. GraphNode:=NodeQueue[QueueStart];
  632. inc(QueueStart);
  633. ListOfGraphNodes.Add(GraphNode);
  634. // update the FInternalFlags counter
  635. if InEdgeDirection then
  636. CurTree:=GraphNode.OutTree
  637. else
  638. CurTree:=GraphNode.InTree;
  639. if (CurTree<>nil) then begin
  640. EdgeAVLNode:=CurTree.FindLowest;
  641. while EdgeAVLNode<>nil do begin
  642. GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
  643. if InEdgeDirection then
  644. CurGraphNode:=GraphEdge.ToNode
  645. else
  646. CurGraphNode:=GraphEdge.FromNode;
  647. dec(CurGraphNode.FInternalFlags);
  648. if CurGraphNode.FInternalFlags=0 then
  649. // a new node has no incoming edges => add to the queue
  650. AddNode(CurGraphNode);
  651. EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
  652. end;
  653. end;
  654. end;
  655. if ListOfGraphNodes.Count<Nodes.Count then begin
  656. // there is a circle
  657. // find a node of a circle
  658. AVLNode:=Nodes.FindLowest;
  659. while (AVLNode<>nil) and (Result=nil) do begin
  660. GraphNode:=TCodeGraphNode(AVLNode.Data);
  661. if InEdgeDirection then
  662. CurTree:=GraphNode.OutTree
  663. else
  664. CurTree:=GraphNode.InTree;
  665. if (GraphNode.FInternalFlags>0) and (CurTree<>nil) and (CurTree.Count>0)
  666. then begin
  667. // find an edge of a circle
  668. EdgeAVLNode:=CurTree.FindLowest;
  669. while EdgeAVLNode<>nil do begin
  670. GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
  671. if (InEdgeDirection and (GraphEdge.ToNode.OutTreeCount>0))
  672. or ((not InEdgeDirection) and (GraphEdge.FromNode.InTreeCount>0))
  673. then begin
  674. Result:=GraphEdge;
  675. break;
  676. end;
  677. EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
  678. end;
  679. end;
  680. AVLNode:=Nodes.FindSuccessor(AVLNode);
  681. end;
  682. end;
  683. if (ListOfGraphNodes.Count>=1) then begin
  684. if SortForStartPos or SetTopologicalLvl then begin
  685. // calculate the topological levels
  686. if SortForStartPos then
  687. SortedNodes:=TAVLTree.Create(@CompareGraphNodesForTopoLvlAndStartPos)
  688. else
  689. SortedNodes:=nil;
  690. ClearInternalNodeFlags;
  691. for i:=0 to ListOfGraphNodes.Count-1 do begin
  692. GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
  693. // find the maximum incoming topological level
  694. GraphNode.FInternalFlags:=0;
  695. if InEdgeDirection then
  696. CurTree:=GraphNode.InTree
  697. else
  698. CurTree:=GraphNode.OutTree;
  699. if (CurTree<>nil) then begin
  700. EdgeAVLNode:=CurTree.FindLowest;
  701. while EdgeAVLNode<>nil do begin
  702. GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
  703. if InEdgeDirection then
  704. CurGraphNode:=GraphEdge.FromNode
  705. else
  706. CurGraphNode:=GraphEdge.ToNode;
  707. if GraphNode.FInternalFlags<=CurGraphNode.FInternalFlags then
  708. // set the level to one higher than the maximum
  709. GraphNode.FInternalFlags:=CurGraphNode.FInternalFlags+1;
  710. EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
  711. end;
  712. end;
  713. // now level of this node is complete
  714. if SetTopologicalLvl then
  715. GraphNode.Flags:=GraphNode.FInternalFlags;
  716. if SortForStartPos then
  717. SortedNodes.Add(GraphNode);
  718. end;
  719. if SortForStartPos then begin
  720. // rebuild list with sorted nodes
  721. ListOfGraphNodes.Clear;
  722. AVLNode:=SortedNodes.FindLowest;
  723. while AVLNode<>nil do begin
  724. ListOfGraphNodes.Add(AVLNode.Data);
  725. AVLNode:=SortedNodes.FindSuccessor(AVLNode);
  726. end;
  727. SortedNodes.Free;
  728. end;
  729. end;
  730. end;
  731. finally
  732. SetLength(NodeQueue,0);
  733. end;
  734. //DebugLn(['TCodeGraph.GetTopologicalSortedList END']);
  735. end;
  736. procedure TCodeGraph.GetMaximumCircle(StartNode: TCodeGraphNode; out
  737. ListOfGraphNodes: TFPList);
  738. procedure AddNode(ANode: TCodeGraphNode);
  739. begin
  740. ANode.FInternalFlags:=2;
  741. ListOfGraphNodes.Add(ANode);
  742. end;
  743. procedure MarkReachableNodes(Node: TCodeGraphNode);
  744. var
  745. AVLNode: TAVLTreeNode;
  746. Edge: TCodeGraphEdge;
  747. begin
  748. Node.FInternalFlags:=1;
  749. if Node.OutTree=nil then exit;
  750. AVLNode:=Node.OutTree.FindLowest;
  751. while AVLNode<>nil do begin
  752. Edge:=TCodeGraphEdge(AVLNode.Data);
  753. if Edge.ToNode.FInternalFlags=0 then
  754. MarkReachableNodes(Edge.ToNode);
  755. AVLNode:=Node.OutTree.FindSuccessor(AVLNode);
  756. end;
  757. end;
  758. procedure AddCircleNodes(Node: TCodeGraphNode);
  759. var
  760. AVLNode: TAVLTreeNode;
  761. Edge: TCodeGraphEdge;
  762. begin
  763. AddNode(Node);
  764. if Node.InTree=nil then exit;
  765. AVLNode:=Node.InTree.FindLowest;
  766. while AVLNode<>nil do begin
  767. Edge:=TCodeGraphEdge(AVLNode.Data);
  768. if Edge.FromNode.FInternalFlags=1 then
  769. AddCircleNodes(Edge.FromNode);
  770. AVLNode:=Node.InTree.FindSuccessor(AVLNode);
  771. end;
  772. end;
  773. begin
  774. ListOfGraphNodes:=TFPList.Create;
  775. ClearNodeFlags;
  776. MarkReachableNodes(StartNode);
  777. AddCircleNodes(StartNode);
  778. end;
  779. function TCodeGraph.GetEdge(FromNode, ToNode: TCodeTreeNode;
  780. CreateIfNotExists: boolean): TCodeGraphEdge;
  781. var
  782. ToGraphNode: TCodeGraphNode;
  783. FromGraphNode: TCodeGraphNode;
  784. AVLNode: TAVLTreeNode;
  785. begin
  786. Result:=nil;
  787. AVLNode:=FindAVLNodeOfEdge(FromNode,ToNode);
  788. if AVLNode<>nil then begin
  789. Result:=TCodeGraphEdge(AVLNode.Data);
  790. end else begin
  791. if not CreateIfNotExists then exit;
  792. FromGraphNode:=GetGraphNode(FromNode,true);
  793. ToGraphNode:=GetGraphNode(ToNode,true);
  794. Result:=FEdgeClass.Create;
  795. Result.ToNode:=ToGraphNode;
  796. Result.FromNode:=FromGraphNode;
  797. Edges.Add(Result);
  798. if FromGraphNode.OutTree=nil then
  799. FromGraphNode.OutTree:=TAVLTree.Create(@CompareGraphEdgeByToNode);
  800. FromGraphNode.OutTree.Add(Result);
  801. if ToGraphNode.InTree=nil then
  802. ToGraphNode.InTree:=TAVLTree.Create(@CompareGraphEdgeByFromNode);
  803. ToGraphNode.InTree.Add(Result);
  804. end;
  805. end;
  806. function TCodeGraph.FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
  807. begin
  808. Result:=Nodes.FindKey(Node,@CompareNodeWithGraphNodeNode);
  809. end;
  810. function TCodeGraph.FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
  811. ): TAVLTreeNode;
  812. begin
  813. if InTree<>nil then
  814. Result:=InTree.FindKey(ToNode,@CompareNodeWithGraphEdgeToNode)
  815. else
  816. Result:=nil;
  817. end;
  818. function TCodeGraph.FindAVLNodeOfFromNode(OutTree: TAVLTree;
  819. FromNode: TCodeTreeNode): TAVLTreeNode;
  820. begin
  821. if OutTree<>nil then
  822. Result:=OutTree.FindKey(FromNode,@CompareNodeWithGraphEdgeFromNode)
  823. else
  824. Result:=nil;
  825. end;
  826. function TCodeGraph.FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode
  827. ): TAVLTreeNode;
  828. var
  829. EdgeKey: TCodeGraphEdgeKey;
  830. begin
  831. EdgeKey.FromNode:=FromNode;
  832. EdgeKey.ToNode:=ToNode;
  833. Result:=Edges.FindKey(@EdgeKey,@CompareEdgeKeyWithGraphEdge);
  834. end;
  835. procedure TCodeGraph.ConsistencyCheck;
  836. procedure e(const Msg: string);
  837. begin
  838. raise Exception.Create('TCodeGraph.ConsistencyCheck '+Msg);
  839. end;
  840. var
  841. AVLNode: TAVLTreeNode;
  842. GraphNode: TCodeGraphNode;
  843. EdgeAVLNode: TAVLTreeNode;
  844. Edge: TCodeGraphEdge;
  845. begin
  846. if Nodes=nil then
  847. e('');
  848. if Edges=nil then
  849. e('');
  850. if Nodes.ConsistencyCheck<>0 then
  851. e('');
  852. if Edges.ConsistencyCheck<>0 then
  853. e('');
  854. if AVLTreeHasDoubles(Nodes)<>nil then
  855. e('');
  856. if AVLTreeHasDoubles(Edges)<>nil then
  857. e('');
  858. AVLNode:=Nodes.FindLowest;
  859. while AVLNode<>nil do begin
  860. GraphNode:=TCodeGraphNode(AVLNode.Data);
  861. if GraphNode.InTree<>nil then begin
  862. if GraphNode.InTree.ConsistencyCheck<>0 then
  863. e('');
  864. if AVLTreeHasDoubles(GraphNode.InTree)<>nil then
  865. e('');
  866. EdgeAVLNode:=GraphNode.InTree.FindLowest;
  867. while EdgeAVLNode<>nil do begin
  868. Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
  869. if Edges.Find(Edge)=nil then
  870. e('');
  871. if Edge.ToNode<>GraphNode then
  872. e('');
  873. EdgeAVLNode:=GraphNode.InTree.FindSuccessor(EdgeAVLNode);
  874. end;
  875. end;
  876. if GraphNode.OutTree<>nil then begin
  877. if GraphNode.OutTree.ConsistencyCheck<>0 then
  878. e('');
  879. if AVLTreeHasDoubles(GraphNode.OutTree)<>nil then
  880. e('');
  881. EdgeAVLNode:=GraphNode.OutTree.FindLowest;
  882. while EdgeAVLNode<>nil do begin
  883. Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
  884. if Edges.Find(Edge)=nil then
  885. e('');
  886. if Edge.FromNode<>GraphNode then
  887. e('');
  888. EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
  889. end;
  890. end;
  891. AVLNode:=Nodes.FindSuccessor(AVLNode);
  892. end;
  893. AVLNode:=Edges.FindLowest;
  894. while AVLNode<>nil do begin
  895. Edge:=TCodeGraphEdge(AVLNode.Data);
  896. if Nodes.Find(Edge.FromNode)=nil then
  897. e('');
  898. if Nodes.Find(Edge.ToNode)=nil then
  899. e('');
  900. if Edge.FromNode.OutTree.Find(Edge)=nil then
  901. e('');
  902. if Edge.ToNode.InTree.Find(Edge)=nil then
  903. e('');
  904. AVLNode:=Edges.FindSuccessor(AVLNode);
  905. end;
  906. end;
  907. { TCodeGraphNode }
  908. function TCodeGraphNode.OutTreeCount: integer;
  909. begin
  910. if OutTree<>nil then
  911. Result:=OutTree.Count
  912. else
  913. Result:=0;
  914. end;
  915. function TCodeGraphNode.InTreeCount: integer;
  916. begin
  917. if InTree<>nil then
  918. Result:=InTree.Count
  919. else
  920. Result:=0;
  921. end;
  922. end.