mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-31 22:10:55 +01:00
1002 lines
29 KiB
ObjectPascal
1002 lines
29 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
An arbitrary graph for TCodeTreeNode.
|
|
}
|
|
unit CodeGraph;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Laz_AVL_Tree,
|
|
// Codetools
|
|
CodeTree, FileProcs;
|
|
|
|
type
|
|
|
|
{ TCodeGraphNode }
|
|
|
|
TCodeGraphNode = class
|
|
private
|
|
FInternalFlags: integer;
|
|
public
|
|
Node: TCodeTreeNode;
|
|
InTree: TAVLTree;// tree of TCodeGraphEdge sorted for FromNode (ToNode = Self)
|
|
OutTree: TAVLTree;// tree of TCodeGraphEdge sorted for ToNode (FromNode = Self)
|
|
Data: Pointer; // custom data
|
|
Flags: cardinal;// custom flags
|
|
function OutTreeCount: integer;
|
|
function InTreeCount: integer;
|
|
end;
|
|
TCodeGraphNodeClass = class of TCodeGraphNode;
|
|
|
|
PCodeGraphEdgeKey = ^TCodeGraphEdgeKey;
|
|
TCodeGraphEdgeKey = record
|
|
FromNode: TCodeTreeNode;
|
|
ToNode: TCodeTreeNode;
|
|
end;
|
|
|
|
{ TCodeGraphEdge }
|
|
|
|
TCodeGraphEdge = class
|
|
private
|
|
FInternalFlags: integer;
|
|
public
|
|
FromNode: TCodeGraphNode;
|
|
ToNode: TCodeGraphNode;
|
|
Data: Pointer; // custom data
|
|
Flags: cardinal;// custom flags
|
|
end;
|
|
TCodeGraphEdgeClass = class of TCodeGraphEdge;
|
|
|
|
{ TCodeGraph }
|
|
|
|
TCodeGraph = class
|
|
private
|
|
FEdgeClass: TCodeGraphEdgeClass;
|
|
FNodeClass: TCodeGraphNodeClass;
|
|
procedure ClearInternalNodeFlags;
|
|
public
|
|
Nodes: TAVLTree; // tree of TCodeGraphNode sorted for Node
|
|
Edges: TAVLTree; // tree of TCodeGraphEdge sorted for FromNode,ToNode
|
|
constructor Create(ANodeClass: TCodeGraphNodeClass = nil;
|
|
AnEdgeClass: TCodeGraphEdgeClass = nil);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure ClearNodeFlags;
|
|
procedure ClearEdgeFlags;
|
|
procedure Assign(Source: TCodeGraph);
|
|
function CreateCopy: TCodeGraph;
|
|
function AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
|
|
function GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
|
|
): TCodeGraphNode;
|
|
procedure DeleteGraphNode(Node: TCodeTreeNode);
|
|
function FindGraphNodeWithNumberOfOutEdges(MinNumber, MaxNumber: integer
|
|
): TCodeGraphNode;
|
|
function FindGraphNodeWithNumberOfInEdges(MinNumber, MaxNumber: integer
|
|
): TCodeGraphNode;
|
|
|
|
function PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
|
|
function AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
|
|
function GetEdge(FromNode, ToNode: TCodeTreeNode;
|
|
CreateIfNotExists: boolean): TCodeGraphEdge;
|
|
procedure DeleteEdge(FromNode, ToNode: TCodeTreeNode);
|
|
procedure DeleteEdge(Edge: TCodeGraphEdge);
|
|
procedure DeleteSelfCircles;
|
|
procedure CombineNodes(ListOfGraphNodes: TFPList; GraphNode: TCodeGraphNode);
|
|
function GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
|
|
InEdgeDirection, // true=start with source nodes (no InEdges)
|
|
SetTopologicalLvl,// true=set Node.Flags to level
|
|
SortForStartPos: boolean// true=secondary sort order is Node.StartPos
|
|
): TCodeGraphEdge;// is a circle edge (if found, else nil)
|
|
procedure GetMaximumCircle(StartNode: TCodeGraphNode;
|
|
out ListOfGraphNodes: TFPList);
|
|
|
|
function FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
|
|
function FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
|
|
): TAVLTreeNode;
|
|
function FindAVLNodeOfFromNode(OutTree: TAVLTree; FromNode: TCodeTreeNode
|
|
): TAVLTreeNode;
|
|
function FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode): TAVLTreeNode;
|
|
|
|
property NodeClass: TCodeGraphNodeClass read FNodeClass;
|
|
property EdgeClass: TCodeGraphEdgeClass read FEdgeClass;
|
|
|
|
procedure ConsistencyCheck;
|
|
end;
|
|
|
|
function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
|
|
function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
|
|
|
|
function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
|
|
function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
|
|
|
|
function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
|
|
|
|
implementation
|
|
|
|
function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
|
|
var
|
|
Node1: TCodeTreeNode;
|
|
Node2: TCodeTreeNode;
|
|
begin
|
|
Node1:=TCodeGraphNode(GraphNode1).Node;
|
|
Node2:=TCodeGraphNode(GraphNode2).Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
Result:=1
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
//DebugLn(['CompareGraphNodeByNode ',Node1.DescAsString,' ',Node2.DescAsString,' ',Result]);
|
|
end;
|
|
|
|
function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Node:=TCodeGraphNode(GraphNode).Node;
|
|
if p>Pointer(Node) then
|
|
Result:=1
|
|
else if p<Pointer(Node) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
//DebugLn(['ComparePointerWithGraphNodeNode ',TCodeTreeNode(p).DescAsString,' ',Node.DescAsString,' ',Result]);
|
|
end;
|
|
|
|
function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
var
|
|
Node1: TCodeTreeNode;
|
|
Node2: TCodeTreeNode;
|
|
begin
|
|
Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
|
|
Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
Result:=1
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Node:=TCodeGraphEdge(GraphEdge).FromNode.Node;
|
|
if p>Pointer(Node) then
|
|
Result:=1
|
|
else if p<Pointer(Node) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
var
|
|
Node1: TCodeTreeNode;
|
|
Node2: TCodeTreeNode;
|
|
begin
|
|
Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
|
|
Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
Result:=1
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
begin
|
|
Node:=TCodeGraphEdge(GraphEdge).ToNode.Node;
|
|
if p>Pointer(Node) then
|
|
Result:=1
|
|
else if p<Pointer(Node) then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer;
|
|
var
|
|
Node1: TCodeTreeNode;
|
|
Node2: TCodeTreeNode;
|
|
begin
|
|
Node1:=TCodeGraphEdge(GraphEdge1).FromNode.Node;
|
|
Node2:=TCodeGraphEdge(GraphEdge2).FromNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
exit(1)
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
exit(-1);
|
|
Node1:=TCodeGraphEdge(GraphEdge1).ToNode.Node;
|
|
Node2:=TCodeGraphEdge(GraphEdge2).ToNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
exit(1)
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
exit(-1);
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer;
|
|
var
|
|
Key: PCodeGraphEdgeKey;
|
|
Edge: TCodeGraphEdge;
|
|
Node1: TCodeTreeNode;
|
|
Node2: TCodeTreeNode;
|
|
begin
|
|
Key:=PCodeGraphEdgeKey(EdgeKey);
|
|
Edge:=TCodeGraphEdge(GraphEdge);
|
|
Node1:=Key^.FromNode;
|
|
Node2:=Edge.FromNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
exit(1)
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
exit(-1);
|
|
Node1:=Key^.ToNode;
|
|
Node2:=Edge.ToNode.Node;
|
|
if Pointer(Node1)>Pointer(Node2) then
|
|
exit(1)
|
|
else if Pointer(Node1)<Pointer(Node2) then
|
|
exit(-1);
|
|
Result:=0;
|
|
end;
|
|
|
|
function CompareGraphNodesForTopoLvlAndStartPos(
|
|
GraphNode1, GraphNode2: Pointer): integer;
|
|
// 1 if lower Level (FInternalFlags) or if lvl is the same and lower Node.StartPos
|
|
var
|
|
Level1: LongInt;
|
|
Level2: LongInt;
|
|
StartPos1: LongInt;
|
|
StartPos2: LongInt;
|
|
begin
|
|
Level1:=TCodeGraphNode(GraphNode1).FInternalFlags;
|
|
Level2:=TCodeGraphNode(GraphNode2).FInternalFlags;
|
|
if Level1<Level2 then
|
|
Result:=1
|
|
else if Level1>Level2 then
|
|
Result:=-1
|
|
else begin
|
|
StartPos1:=TCodeGraphNode(GraphNode1).Node.StartPos;
|
|
StartPos2:=TCodeGraphNode(GraphNode2).Node.StartPos;
|
|
if StartPos1<StartPos2 then
|
|
Result:=1
|
|
else if StartPos1>StartPos2 then
|
|
Result:=-1
|
|
else
|
|
Result:=0;
|
|
end;
|
|
end;
|
|
|
|
{ TCodeGraph }
|
|
|
|
procedure TCodeGraph.ClearInternalNodeFlags;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
constructor TCodeGraph.Create(ANodeClass: TCodeGraphNodeClass;
|
|
AnEdgeClass: TCodeGraphEdgeClass);
|
|
begin
|
|
if ANodeClass<>nil then
|
|
FNodeClass:=ANodeClass
|
|
else
|
|
FNodeClass:=TCodeGraphNode;
|
|
if AnEdgeClass<>nil then
|
|
FEdgeClass:=AnEdgeClass
|
|
else
|
|
FEdgeClass:=TCodeGraphEdge;
|
|
Nodes:=TAVLTree.Create(@CompareGraphNodeByNode);
|
|
Edges:=TAVLTree.Create(@CompareGraphEdgeByNodes);
|
|
end;
|
|
|
|
destructor TCodeGraph.Destroy;
|
|
begin
|
|
Clear;
|
|
FreeAndNil(Nodes);
|
|
FreeAndNil(Edges);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCodeGraph.Clear;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphNode: TCodeGraphNode;
|
|
begin
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
GraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
if GraphNode.InTree<>nil then begin
|
|
GraphNode.InTree.FreeAndClear;// free the TCodeGraphEdge objects
|
|
FreeAndNil(GraphNode.InTree);// free the InTree
|
|
end;
|
|
if GraphNode.OutTree<>nil then
|
|
FreeAndNil(GraphNode.OutTree);// free the OutTree
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
Nodes.FreeAndClear;// free the TCodeGraphNode objects
|
|
Edges.Clear;
|
|
end;
|
|
|
|
procedure TCodeGraph.ClearNodeFlags;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
TCodeGraphNode(AVLNode.Data).Flags:=0;
|
|
TCodeGraphNode(AVLNode.Data).FInternalFlags:=0;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeGraph.ClearEdgeFlags;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
AVLNode:=Edges.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
TCodeGraphEdge(AVLNode.Data).Flags:=0;
|
|
TCodeGraphEdge(AVLNode.Data).FInternalFlags:=0;
|
|
AVLNode:=Edges.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeGraph.Assign(Source: TCodeGraph);
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphNode: TCodeGraphNode;
|
|
SrcGraphNode: TCodeGraphNode;
|
|
SrcGraphEdge: TCodeGraphEdge;
|
|
GraphEdge: TCodeGraphEdge;
|
|
begin
|
|
if Source=Self then exit;
|
|
Clear;
|
|
FNodeClass:=Source.FNodeClass;
|
|
FEdgeClass:=Source.FEdgeClass;
|
|
// copy nodes
|
|
AVLNode:=Source.Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
SrcGraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
GraphNode:=AddGraphNode(SrcGraphNode.Node);
|
|
GraphNode.Data:=SrcGraphNode.Data;
|
|
AVLNode:=Source.Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
// copy edges
|
|
AVLNode:=Source.Edges.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
SrcGraphEdge:=TCodeGraphEdge(AVLNode.Data);
|
|
GraphEdge:=AddEdge(SrcGraphEdge.FromNode.Node,SrcGraphEdge.ToNode.Node);
|
|
GraphEdge.Data:=SrcGraphEdge.Data;
|
|
AVLNode:=Source.Edges.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
function TCodeGraph.CreateCopy: TCodeGraph;
|
|
begin
|
|
Result:=TCodeGraph.Create;
|
|
Result.Assign(Self);
|
|
end;
|
|
|
|
function TCodeGraph.AddGraphNode(Node: TCodeTreeNode): TCodeGraphNode;
|
|
begin
|
|
Result:=GetGraphNode(Node,true);
|
|
end;
|
|
|
|
function TCodeGraph.GetGraphNode(Node: TCodeTreeNode; CreateIfNotExists: boolean
|
|
): TCodeGraphNode;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
if Node=nil then exit(nil);
|
|
AVLNode:=FindAVLNodeOfNode(Node);
|
|
if AVLNode<>nil then
|
|
Result:=TCodeGraphNode(AVLNode.Data)
|
|
else if CreateIfNotExists then begin
|
|
Result:=FNodeClass.Create;
|
|
Result.Node:=Node;
|
|
Nodes.Add(Result);
|
|
end else
|
|
Result:=nil;
|
|
end;
|
|
|
|
procedure TCodeGraph.DeleteGraphNode(Node: TCodeTreeNode);
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphNode: TCodeGraphNode;
|
|
OutAVLNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
InTree: TAVLTree;
|
|
OutTree: TAVLTree;
|
|
InAVLNode: TAVLTreeNode;
|
|
begin
|
|
AVLNode:=FindAVLNodeOfNode(Node);
|
|
if AVLNode=nil then exit;
|
|
GraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
OutTree:=GraphNode.OutTree;
|
|
if OutTree<>nil then begin
|
|
// remove all edges coming from this Node
|
|
OutAVLNode:=OutTree.FindLowest;
|
|
while OutAVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(OutAVLNode.Data);
|
|
InTree:=Edge.ToNode.InTree;
|
|
InTree.Remove(Edge);
|
|
Edges.Remove(Edge);
|
|
Edge.Free;
|
|
OutAVLNode:=OutTree.FindSuccessor(OutAVLNode);
|
|
end;
|
|
OutTree.Free;
|
|
end;
|
|
InTree:=GraphNode.InTree;
|
|
if InTree<>nil then begin
|
|
// remove all edges going to this Node
|
|
InAVLNode:=InTree.FindLowest;
|
|
while InAVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(InAVLNode.Data);
|
|
OutTree:=Edge.FromNode.OutTree;
|
|
OutTree.Remove(Edge);
|
|
Edges.Remove(Edge);
|
|
Edge.Free;
|
|
InAVLNode:=InTree.FindSuccessor(InAVLNode);
|
|
end;
|
|
InTree.Free;
|
|
end;
|
|
Nodes.Delete(AVLNode);
|
|
GraphNode.Free;
|
|
end;
|
|
|
|
function TCodeGraph.FindGraphNodeWithNumberOfOutEdges(MinNumber,
|
|
MaxNumber: integer): TCodeGraphNode;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
Cnt: LongInt;
|
|
begin
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Result:=TCodeGraphNode(AVLNode.Data);
|
|
Cnt:=Result.OutTreeCount;
|
|
if ((MinNumber<0) or (MinNumber<=Cnt))
|
|
and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
|
|
exit;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeGraph.FindGraphNodeWithNumberOfInEdges(MinNumber,
|
|
MaxNumber: integer): TCodeGraphNode;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
Cnt: LongInt;
|
|
begin
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Result:=TCodeGraphNode(AVLNode.Data);
|
|
Cnt:=Result.InTreeCount;
|
|
if ((MinNumber<0) or (MinNumber<=Cnt))
|
|
and ((MaxNumber<0) or (MaxNumber>=Cnt)) then
|
|
exit;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeGraph.PathExists(FromNode, ToNode: TCodeTreeNode): boolean;
|
|
|
|
function Search(GraphNode: TCodeGraphNode): boolean;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphEdge: TCodeGraphEdge;
|
|
begin
|
|
Result:=false;
|
|
if GraphNode=nil then exit;
|
|
if GraphNode.Node=ToNode then exit(true);
|
|
if GraphNode.FInternalFlags>0 then exit;
|
|
GraphNode.FInternalFlags:=1;
|
|
if GraphNode.OutTree=nil then exit;
|
|
AVLNode:=GraphNode.OutTree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
GraphEdge:=TCodeGraphEdge(AVLNode.Data);
|
|
if Search(GraphEdge.ToNode) then exit(true);
|
|
AVLNode:=GraphNode.OutTree.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result:=false;
|
|
ClearInternalNodeFlags;
|
|
Result:=Search(GetGraphNode(FromNode,false));
|
|
end;
|
|
|
|
function TCodeGraph.AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
|
|
begin
|
|
Result:=GetEdge(FromNode,ToNode,true);
|
|
end;
|
|
|
|
procedure TCodeGraph.DeleteEdge(FromNode, ToNode: TCodeTreeNode);
|
|
begin
|
|
DeleteEdge(GetEdge(FromNode,ToNode,false));
|
|
end;
|
|
|
|
procedure TCodeGraph.DeleteEdge(Edge: TCodeGraphEdge);
|
|
begin
|
|
if Edge=nil then exit;
|
|
Edge.FromNode.OutTree.Remove(Edge);
|
|
Edge.ToNode.InTree.Remove(Edge);
|
|
Edges.Remove(Edge);
|
|
Edge.Free;
|
|
end;
|
|
|
|
procedure TCodeGraph.DeleteSelfCircles;
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
NextNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
begin
|
|
AVLNode:=Edges.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
NextNode:=Edges.FindSuccessor(AVLNode);
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
if Edge.FromNode=Edge.ToNode then
|
|
DeleteEdge(Edge);
|
|
AVLNode:=NextNode;
|
|
end;
|
|
end;
|
|
|
|
procedure TCodeGraph.CombineNodes(ListOfGraphNodes: TFPList;
|
|
GraphNode: TCodeGraphNode);
|
|
// combines all nodes in ListOfGraphNodes into the super node Node
|
|
var
|
|
i: Integer;
|
|
CurGraphNode: TCodeGraphNode;
|
|
AVLNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
begin
|
|
if ListOfGraphNodes=nil then exit;
|
|
// create for each edge to/from the List an edge to the super node
|
|
for i:=0 to ListOfGraphNodes.Count-1 do begin
|
|
CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
|
|
if CurGraphNode=GraphNode then continue;
|
|
if CurGraphNode.InTree<>nil then begin
|
|
AVLNode:=CurGraphNode.InTree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
// add an edge to super node
|
|
if Edge.FromNode<>GraphNode then
|
|
AddEdge(Edge.FromNode.Node,GraphNode.Node);
|
|
AVLNode:=CurGraphNode.InTree.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
if CurGraphNode.OutTree<>nil then begin
|
|
AVLNode:=CurGraphNode.OutTree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
// add an edge from super node
|
|
if Edge.ToNode<>GraphNode then
|
|
AddEdge(GraphNode.Node,Edge.ToNode.Node);
|
|
AVLNode:=CurGraphNode.OutTree.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
end;
|
|
// delete list nodes
|
|
for i:=0 to ListOfGraphNodes.Count-1 do begin
|
|
CurGraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
|
|
if CurGraphNode=GraphNode then continue;
|
|
// remove list node
|
|
DeleteGraphNode(CurGraphNode.Node);
|
|
end;
|
|
end;
|
|
|
|
function TCodeGraph.GetTopologicalSortedList(out ListOfGraphNodes: TFPList;
|
|
InEdgeDirection, SetTopologicalLvl, SortForStartPos: boolean): TCodeGraphEdge;
|
|
{ returns nil if there is no circle
|
|
else: returns a circle edge
|
|
ListOfTGraphNodes are all those GraphNodes, that could be sorted topologically
|
|
if InEdgeDirection=true then the list starts with the nodes without in-edges
|
|
else the list start with the nodes without out-edges
|
|
|
|
if SetTopologicalLvl=true then the GraphNode.Flags will be set to the
|
|
topological level, starting at 0 for nodes with no in edges.
|
|
|
|
if SortForStartPos=true the nodes will be sorted for Node.StartPos
|
|
as secondary order, keeping the topologically order
|
|
}
|
|
var
|
|
NodeQueue: array of TCodeGraphNode;
|
|
QueueStart: Integer;
|
|
QueueEnd: Integer;
|
|
|
|
procedure AddNode(GraphNode: TCodeGraphNode);
|
|
begin
|
|
//DebugLn(['AddNode ',GraphNode.Node.DescAsString]);
|
|
NodeQueue[QueueEnd]:=GraphNode;
|
|
inc(QueueEnd);
|
|
end;
|
|
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphNode: TCodeGraphNode;
|
|
GraphEdge: TCodeGraphEdge;
|
|
CurGraphNode: TCodeGraphNode;
|
|
EdgeAVLNode: TAVLTreeNode;
|
|
i: Integer;
|
|
CurTree: TAVLTree;
|
|
SortedNodes: TAVLTree;
|
|
begin
|
|
//DebugLn(['TCodeGraph.GetTopologicalSortedList START']);
|
|
Result:=nil;
|
|
ListOfGraphNodes:=TFPList.Create;
|
|
if (Nodes=nil) or (Nodes.Count=0) then exit;
|
|
ListOfGraphNodes.Capacity:=Nodes.Count;
|
|
|
|
try
|
|
// init queue
|
|
SetLength(NodeQueue,Nodes.Count);
|
|
QueueStart:=0;
|
|
QueueEnd:=0;
|
|
// add all nodes without incoming edges and set all FInternalFlags to
|
|
// the number of incoming nodes
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
GraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
if InEdgeDirection then
|
|
CurTree:=GraphNode.InTree
|
|
else
|
|
CurTree:=GraphNode.OutTree;
|
|
if (CurTree=nil) or (CurTree.Count=0) then begin
|
|
GraphNode.FInternalFlags:=0;
|
|
AddNode(GraphNode);
|
|
end else begin
|
|
GraphNode.FInternalFlags:=CurTree.Count;
|
|
end;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
|
|
// add all nodes without incoming edges from the queue into the list
|
|
while QueueStart<>QueueEnd do begin
|
|
GraphNode:=NodeQueue[QueueStart];
|
|
inc(QueueStart);
|
|
ListOfGraphNodes.Add(GraphNode);
|
|
// update the FInternalFlags counter
|
|
if InEdgeDirection then
|
|
CurTree:=GraphNode.OutTree
|
|
else
|
|
CurTree:=GraphNode.InTree;
|
|
if (CurTree<>nil) then begin
|
|
EdgeAVLNode:=CurTree.FindLowest;
|
|
while EdgeAVLNode<>nil do begin
|
|
GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
|
|
if InEdgeDirection then
|
|
CurGraphNode:=GraphEdge.ToNode
|
|
else
|
|
CurGraphNode:=GraphEdge.FromNode;
|
|
dec(CurGraphNode.FInternalFlags);
|
|
if CurGraphNode.FInternalFlags=0 then
|
|
// a new node has no incoming edges => add to the queue
|
|
AddNode(CurGraphNode);
|
|
EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ListOfGraphNodes.Count<Nodes.Count then begin
|
|
// there is a circle
|
|
// find a node of a circle
|
|
AVLNode:=Nodes.FindLowest;
|
|
while (AVLNode<>nil) and (Result=nil) do begin
|
|
GraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
if InEdgeDirection then
|
|
CurTree:=GraphNode.OutTree
|
|
else
|
|
CurTree:=GraphNode.InTree;
|
|
if (GraphNode.FInternalFlags>0) and (CurTree<>nil) and (CurTree.Count>0)
|
|
then begin
|
|
// find an edge of a circle
|
|
EdgeAVLNode:=CurTree.FindLowest;
|
|
while EdgeAVLNode<>nil do begin
|
|
GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
|
|
if (InEdgeDirection and (GraphEdge.ToNode.OutTreeCount>0))
|
|
or ((not InEdgeDirection) and (GraphEdge.FromNode.InTreeCount>0))
|
|
then begin
|
|
Result:=GraphEdge;
|
|
break;
|
|
end;
|
|
EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
|
|
end;
|
|
end;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
if (ListOfGraphNodes.Count>=1) then begin
|
|
if SortForStartPos or SetTopologicalLvl then begin
|
|
// calculate the topological levels
|
|
if SortForStartPos then
|
|
SortedNodes:=TAVLTree.Create(@CompareGraphNodesForTopoLvlAndStartPos)
|
|
else
|
|
SortedNodes:=nil;
|
|
ClearInternalNodeFlags;
|
|
for i:=0 to ListOfGraphNodes.Count-1 do begin
|
|
GraphNode:=TCodeGraphNode(ListOfGraphNodes[i]);
|
|
// find the maximum incoming topological level
|
|
GraphNode.FInternalFlags:=0;
|
|
if InEdgeDirection then
|
|
CurTree:=GraphNode.InTree
|
|
else
|
|
CurTree:=GraphNode.OutTree;
|
|
if (CurTree<>nil) then begin
|
|
EdgeAVLNode:=CurTree.FindLowest;
|
|
while EdgeAVLNode<>nil do begin
|
|
GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
|
|
if InEdgeDirection then
|
|
CurGraphNode:=GraphEdge.FromNode
|
|
else
|
|
CurGraphNode:=GraphEdge.ToNode;
|
|
if GraphNode.FInternalFlags<=CurGraphNode.FInternalFlags then
|
|
// set the level to one higher than the maximum
|
|
GraphNode.FInternalFlags:=CurGraphNode.FInternalFlags+1;
|
|
EdgeAVLNode:=CurTree.FindSuccessor(EdgeAVLNode);
|
|
end;
|
|
end;
|
|
// now level of this node is complete
|
|
if SetTopologicalLvl then
|
|
GraphNode.Flags:=GraphNode.FInternalFlags;
|
|
if SortForStartPos then
|
|
SortedNodes.Add(GraphNode);
|
|
end;
|
|
if SortForStartPos then begin
|
|
// rebuild list with sorted nodes
|
|
ListOfGraphNodes.Clear;
|
|
AVLNode:=SortedNodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
ListOfGraphNodes.Add(AVLNode.Data);
|
|
AVLNode:=SortedNodes.FindSuccessor(AVLNode);
|
|
end;
|
|
SortedNodes.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
SetLength(NodeQueue,0);
|
|
end;
|
|
//DebugLn(['TCodeGraph.GetTopologicalSortedList END']);
|
|
end;
|
|
|
|
procedure TCodeGraph.GetMaximumCircle(StartNode: TCodeGraphNode; out
|
|
ListOfGraphNodes: TFPList);
|
|
|
|
procedure AddNode(ANode: TCodeGraphNode);
|
|
begin
|
|
ANode.FInternalFlags:=2;
|
|
ListOfGraphNodes.Add(ANode);
|
|
end;
|
|
|
|
procedure MarkReachableNodes(Node: TCodeGraphNode);
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
begin
|
|
Node.FInternalFlags:=1;
|
|
if Node.OutTree=nil then exit;
|
|
AVLNode:=Node.OutTree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
if Edge.ToNode.FInternalFlags=0 then
|
|
MarkReachableNodes(Edge.ToNode);
|
|
AVLNode:=Node.OutTree.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
procedure AddCircleNodes(Node: TCodeGraphNode);
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
begin
|
|
AddNode(Node);
|
|
if Node.InTree=nil then exit;
|
|
AVLNode:=Node.InTree.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
if Edge.FromNode.FInternalFlags=1 then
|
|
AddCircleNodes(Edge.FromNode);
|
|
AVLNode:=Node.InTree.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ListOfGraphNodes:=TFPList.Create;
|
|
ClearNodeFlags;
|
|
MarkReachableNodes(StartNode);
|
|
AddCircleNodes(StartNode);
|
|
end;
|
|
|
|
function TCodeGraph.GetEdge(FromNode, ToNode: TCodeTreeNode;
|
|
CreateIfNotExists: boolean): TCodeGraphEdge;
|
|
var
|
|
ToGraphNode: TCodeGraphNode;
|
|
FromGraphNode: TCodeGraphNode;
|
|
AVLNode: TAVLTreeNode;
|
|
begin
|
|
Result:=nil;
|
|
AVLNode:=FindAVLNodeOfEdge(FromNode,ToNode);
|
|
if AVLNode<>nil then begin
|
|
Result:=TCodeGraphEdge(AVLNode.Data);
|
|
end else begin
|
|
if not CreateIfNotExists then exit;
|
|
FromGraphNode:=GetGraphNode(FromNode,true);
|
|
ToGraphNode:=GetGraphNode(ToNode,true);
|
|
Result:=FEdgeClass.Create;
|
|
Result.ToNode:=ToGraphNode;
|
|
Result.FromNode:=FromGraphNode;
|
|
Edges.Add(Result);
|
|
if FromGraphNode.OutTree=nil then
|
|
FromGraphNode.OutTree:=TAVLTree.Create(@CompareGraphEdgeByToNode);
|
|
FromGraphNode.OutTree.Add(Result);
|
|
if ToGraphNode.InTree=nil then
|
|
ToGraphNode.InTree:=TAVLTree.Create(@CompareGraphEdgeByFromNode);
|
|
ToGraphNode.InTree.Add(Result);
|
|
end;
|
|
end;
|
|
|
|
function TCodeGraph.FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode;
|
|
begin
|
|
Result:=Nodes.FindKey(Node,@CompareNodeWithGraphNodeNode);
|
|
end;
|
|
|
|
function TCodeGraph.FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
|
|
): TAVLTreeNode;
|
|
begin
|
|
if InTree<>nil then
|
|
Result:=InTree.FindKey(ToNode,@CompareNodeWithGraphEdgeToNode)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeGraph.FindAVLNodeOfFromNode(OutTree: TAVLTree;
|
|
FromNode: TCodeTreeNode): TAVLTreeNode;
|
|
begin
|
|
if OutTree<>nil then
|
|
Result:=OutTree.FindKey(FromNode,@CompareNodeWithGraphEdgeFromNode)
|
|
else
|
|
Result:=nil;
|
|
end;
|
|
|
|
function TCodeGraph.FindAVLNodeOfEdge(FromNode, ToNode: TCodeTreeNode
|
|
): TAVLTreeNode;
|
|
var
|
|
EdgeKey: TCodeGraphEdgeKey;
|
|
begin
|
|
EdgeKey.FromNode:=FromNode;
|
|
EdgeKey.ToNode:=ToNode;
|
|
Result:=Edges.FindKey(@EdgeKey,@CompareEdgeKeyWithGraphEdge);
|
|
end;
|
|
|
|
procedure TCodeGraph.ConsistencyCheck;
|
|
|
|
procedure e(const Msg: string);
|
|
begin
|
|
raise Exception.Create('TCodeGraph.ConsistencyCheck '+Msg);
|
|
end;
|
|
|
|
var
|
|
AVLNode: TAVLTreeNode;
|
|
GraphNode: TCodeGraphNode;
|
|
EdgeAVLNode: TAVLTreeNode;
|
|
Edge: TCodeGraphEdge;
|
|
begin
|
|
if Nodes=nil then
|
|
e('');
|
|
if Edges=nil then
|
|
e('');
|
|
Nodes.ConsistencyCheck;
|
|
Edges.ConsistencyCheck;
|
|
if AVLTreeHasDoubles(Nodes)<>nil then
|
|
e('');
|
|
if AVLTreeHasDoubles(Edges)<>nil then
|
|
e('');
|
|
|
|
AVLNode:=Nodes.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
GraphNode:=TCodeGraphNode(AVLNode.Data);
|
|
if GraphNode.InTree<>nil then begin
|
|
GraphNode.InTree.ConsistencyCheck;
|
|
if AVLTreeHasDoubles(GraphNode.InTree)<>nil then
|
|
e('');
|
|
EdgeAVLNode:=GraphNode.InTree.FindLowest;
|
|
while EdgeAVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
|
|
if Edges.Find(Edge)=nil then
|
|
e('');
|
|
if Edge.ToNode<>GraphNode then
|
|
e('');
|
|
EdgeAVLNode:=GraphNode.InTree.FindSuccessor(EdgeAVLNode);
|
|
end;
|
|
end;
|
|
if GraphNode.OutTree<>nil then begin
|
|
GraphNode.InTree.ConsistencyCheck;
|
|
if AVLTreeHasDoubles(GraphNode.OutTree)<>nil then
|
|
e('');
|
|
EdgeAVLNode:=GraphNode.OutTree.FindLowest;
|
|
while EdgeAVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(EdgeAVLNode.Data);
|
|
if Edges.Find(Edge)=nil then
|
|
e('');
|
|
if Edge.FromNode<>GraphNode then
|
|
e('');
|
|
EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
|
|
end;
|
|
end;
|
|
AVLNode:=Nodes.FindSuccessor(AVLNode);
|
|
end;
|
|
|
|
AVLNode:=Edges.FindLowest;
|
|
while AVLNode<>nil do begin
|
|
Edge:=TCodeGraphEdge(AVLNode.Data);
|
|
if Nodes.Find(Edge.FromNode)=nil then
|
|
e('');
|
|
if Nodes.Find(Edge.ToNode)=nil then
|
|
e('');
|
|
if Edge.FromNode.OutTree.Find(Edge)=nil then
|
|
e('');
|
|
if Edge.ToNode.InTree.Find(Edge)=nil then
|
|
e('');
|
|
AVLNode:=Edges.FindSuccessor(AVLNode);
|
|
end;
|
|
end;
|
|
|
|
{ TCodeGraphNode }
|
|
|
|
function TCodeGraphNode.OutTreeCount: integer;
|
|
begin
|
|
if OutTree<>nil then
|
|
Result:=OutTree.Count
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
function TCodeGraphNode.InTreeCount: integer;
|
|
begin
|
|
if InTree<>nil then
|
|
Result:=InTree.Count
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
end.
|
|
|