lazarus/components/codetools/codegraph.pas
2007-08-21 17:34:44 +00:00

635 lines
18 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
An arbitrary graph for TCodeTreeNode.
}
unit CodeGraph;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeTree, FileProcs, AVL_Tree;
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;
PCodeGraphEdgeKey = ^TCodeGraphEdgeKey;
TCodeGraphEdgeKey = record
FromNode: TCodeTreeNode;
ToNode: TCodeTreeNode;
end;
{ TCodeGraphEdge }
TCodeGraphEdge = class
FromNode: TCodeGraphNode;
ToNode: TCodeGraphNode;
Data: Pointer; // custom data
Flags: cardinal;// custom flags
end;
{ TCodeGraph }
TCodeGraph = class
public
Nodes: TAVLTree; // tree of TCodeGraphNode sorted for Node
Edges: TAVLTree; // tree of TCodeGraphEdge sorted for FromNode,ToNode
constructor Create;
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 AddEdge(FromNode, ToNode: TCodeTreeNode): TCodeGraphEdge;
function GetEdge(FromNode, ToNode: TCodeTreeNode;
CreateIfNotExists: boolean): TCodeGraphEdge;
procedure DeleteEdge(FromNode, ToNode: TCodeTreeNode);
procedure DeleteEdge(Edge: TCodeGraphEdge);
function GetTopologicalSortedList(out ListOfGraphNodes: TFPList
): TCodeGraphEdge;
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;
end;
function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer;
function ComparePointerWithGraphNodeNode(p, GraphNode: Pointer): integer;
function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer;
function ComparePointerWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer;
function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer;
function ComparePointerWithGraphEdgeToNode(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;
end;
function ComparePointerWithGraphNodeNode(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;
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 ComparePointerWithGraphEdgeFromNode(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 ComparePointerWithGraphEdgeToNode(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;
{ TCodeGraph }
constructor TCodeGraph.Create;
begin
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;
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;
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;
// 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
AVLNode:=FindAVLNodeOfNode(Node);
if AVLNode<>nil then
Result:=TCodeGraphNode(AVLNode.Data)
else if CreateIfNotExists then begin
Result:=TCodeGraphNode.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);
if GraphNode.OutTree<>nil then begin
// remove all edges coming from this Node
OutTree:=GraphNode.OutTree;
OutAVLNode:=OutTree.FindLowest;
while OutAVLNode<>nil do begin
Edge:=TCodeGraphEdge(OutAVLNode.Data);
InTree:=Edge.ToNode.InTree;
InTree.Remove(Edge);
Edge.Free;
OutAVLNode:=OutTree.FindSuccessor(OutAVLNode);
end;
OutTree.Clear;
end;
if GraphNode.InTree<>nil then begin
// remove all edges goind to this Node
InTree:=GraphNode.InTree;
InAVLNode:=InTree.FindLowest;
while InAVLNode<>nil do begin
Edge:=TCodeGraphEdge(InAVLNode.Data);
OutTree:=Edge.ToNode.OutTree;
OutTree.Remove(Edge);
Edge.Free;
InAVLNode:=InTree.FindSuccessor(InAVLNode);
end;
InTree.Clear;
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.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;
function TCodeGraph.GetTopologicalSortedList(out ListOfGraphNodes: TFPList
): TCodeGraphEdge;
// returns nil if there is no circle
// else: returns a circle edge
// ListOfTGraphNodes are the GraphNodes, that could be sorted topologically
var
NodeQueue: array of TCodeGraphNode;
QueueStart: Integer;
QueueEnd: Integer;
procedure AddNode(GraphNode: TCodeGraphNode);
begin
NodeQueue[QueueEnd]:=GraphNode;
inc(QueueEnd);
end;
var
AVLNode: TAVLTreeNode;
GraphNode: TCodeGraphNode;
i: Integer;
WorkGraph: TCodeGraph;
GraphEdge: TCodeGraphEdge;
ToGraphNode: TCodeGraphNode;
EdgeAVLNode: TAVLTreeNode;
begin
Result:=nil;
ListOfGraphNodes:=TFPList.Create;
if (Nodes=nil) or (Nodes.Count=0) then exit(nil);
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 (GraphNode.InTree=nil) or (GraphNode.InTree.Count=0) then begin
GraphNode.FInternalFlags:=0;
AddNode(GraphNode);
end else begin
GraphNode.FInternalFlags:=GraphNode.InTree.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 (GraphNode.OutTree<>nil) then begin
EdgeAVLNode:=GraphNode.OutTree.FindLowest;
while EdgeAVLNode<>nil do begin
GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
ToGraphNode:=GraphEdge.ToNode;
dec(ToGraphNode.FInternalFlags);
if ToGraphNode.FInternalFlags=0 then
// a new node has no incoming edges => add to the queue
AddNode(ToGraphNode);
EdgeAVLNode:=GraphNode.OutTree.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 GraphNode.FInternalFlags>0 then begin
// find an edge of a circle
EdgeAVLNode:=GraphNode.OutTree.FindLowest;
while EdgeAVLNode<>nil do begin
GraphEdge:=TCodeGraphEdge(EdgeAVLNode.Data);
ToGraphNode:=GraphEdge.ToNode;
if ToGraphNode.FInternalFlags>0 then begin
Result:=GraphEdge;
break;
end;
EdgeAVLNode:=GraphNode.OutTree.FindSuccessor(EdgeAVLNode);
end;
end;
AVLNode:=Nodes.FindSuccessor(AVLNode);
end;
end;
finally
SetLength(NodeQueue,0);
end;
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:=TCodeGraphEdge.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,@ComparePointerWithGraphNodeNode);
end;
function TCodeGraph.FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode
): TAVLTreeNode;
begin
if InTree<>nil then
Result:=InTree.FindKey(ToNode,@ComparePointerWithGraphEdgeToNode)
else
Result:=nil;
end;
function TCodeGraph.FindAVLNodeOfFromNode(OutTree: TAVLTree;
FromNode: TCodeTreeNode): TAVLTreeNode;
begin
if OutTree<>nil then
Result:=OutTree.FindKey(FromNode,@ComparePointerWithGraphEdgeFromNode)
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;
{ 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.