udiagramautolayout.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{Called to sort a list of nodes by their label of a topoligical order. Helper
 for ~[link TSugiyamaLayouter.TopologicalOrder]. Type of the function is
 TListSortCompare.
~param Item1, Item2 the items in the list to be compared
~result relationship of the items to sort the list (</=/> 0) }
function TopoSortProc(Item1, Item2: Pointer): Integer;
begin
 //just return the relationship of the ~[link TSortNode.TopoOrderLabel]-members
 Result := PSortNode(Item1).TopoOrderLabel - PSortNode(Item2).TopoOrderLabel;
end;

{Topologically orders the nodes so that all dependancies point forward in
 the list. Topological order:~[br]
 A numbering of the nodes of a directed acyclic graph such that every edge
 from one node numbered i to another node numbered j satisfies i < j. }
procedure TSugiyamaLayouter.TopologicalOrder;
          //data of the order of the nodes; numbers of edges from not ordered
var       InEdges        :array of Integer; //nodes
          Nodes          :TList;            //list for current nodes
          i              :Integer;          //counter through all nodes
          NextLabel      :Integer;  //indices of the nodes in topological order
          Node           :PSortNode;        //each node
          Edge           :PSortNode;        //each node the node has an edge to
begin
 SetLength(InEdges, FNodes.Count);     //array of scores for each node to order
 //create list for current nodes, starting at the roots of trees
 Nodes := TList.Create;
 try
   //initialize InEdges with the number of incoming edges;
   //push nodes without incoming edges, i.e. roots of trees
   for i := 0 to FNodes.Count - 1 do        //for each node
    begin
     InEdges[i] := PSortNode(FNodes[i]).InEdges.Count; //initialize InEdges
     if InEdges[i] = 0 then                   //is a root of a tree?
      Nodes.Add(FNodes[i]);                     //add it to the list
    end;
   //the graph is acyclic, there has to be at least one root
   assert(Nodes.Count <> 0);

   NextLabel := 0;                          //first node has index 1 in order
   while Nodes.Count > 0 do                 //while not all nodes ordered
    begin
     Node := Nodes.Last;                      //get a node from the list
     Nodes.Delete(Nodes.Count - 1);

     Inc(NextLabel);                          //get next index
     Node.TopoOrderLabel := NextLabel;        //set index in topological order

     for i := 0 to Node.OutEdges.Count - 1 do //for each node it has an edge to
      begin
       Edge := Node.OutEdges[i];                //get it

       assert(InEdges[Edge.Id] > 0);
       //decrement its number of incoming edges, until all nodes it has
       //incoming edges from are already ordered (i.e. InEdges[Edge.Id] = 0)
       Dec(InEdges[Edge.Id]);
       //all nodes it has incoming edges from are already ordered?
       if InEdges[Edge.Id] = 0 then
        begin
         //node must not have been ordered yet nor be in the list to be ordered
         assert(Edge.TopoOrderLabel = 0);
         assert(Nodes.IndexOf(Edge) = -1);
         //add node to list to be ordered
         Nodes.Add(Edge);
        end; //if InEdges[Edge.Id] = 0
      end; //for i := 0 to Node.OutEdges.Count - 1
    end; //while Nodes.Count > 0
 finally
  Nodes.Free;     //free list for current nodes
 end;

{$IFOPT C+}
 //all nodes have to be ordered, so 0 can't be in TopoOrderLabel,
 //i.e. all nodes must have been processed in the previous step
 for i := 0 to FNodes.Count - 1 do
  assert(PSortNode(FNodes[i]).TopoOrderLabel <> 0);
{$ENDIF}


 FNodes.Sort(TopoSortProc);          //sort nodes based on their TopoOrderLabel
 for i := 0 to FNodes.Count - 1 do   //refresh IDs of the nodes after ordering
  PSortNode(FNodes[i]).Id := i;        //set it to their new positon in list
end;



{Orders the nodes with a topological sort algorithm and ranks them (each ranks
 gets its own layer). }
procedure TSugiyamaLayouter.InitialRanking;
var       i              :Integer;         //counter through all nodes
          Node           :PSortNode;       //each node
          j              :Integer;         //for each node an edge comes from
          OtherRank      :Integer;         //ranks of nodes pointing to this
          Rank           :Integer;         //new rank of this node
begin
 TopologicalOrder;                         //orders the nodes topological

 for i := 0 to FNodes.Count - 1 do         //for each node
  begin
   Node := FNodes[i];                        //get the node
   Rank := 0;                                //minimal rank so far
   //for each node that has en edge to this
   for j := 0 to Node.InEdges.Count - 1 do
    begin
     OtherRank := PSortNode(Node.InEdges[j]).Rank; //get its rank
     if OtherRank >= Rank then                     //greater rank than current?
      //move this' rank after that rank
      Rank := OtherRank + 1;
    end;
   Node.Rank := Rank;                        //set new rank of the node
  end;
end;




















{Inserts dummy-nodes so that each edge is of length one. The lengths of the
 edges are calculated as the differences of the ranks of both nodes the edge is
 connecting. }
procedure TSugiyamaLayouter.MakeProper;

 {Creates a new dummy node to insert.
 ~result a new dummy node }
 function CreateDummy: PSortNode;
 begin
  Result := CreateNewNode;      //create the dummy node
  try
    Result.Id := FNodes.Count;    //set its id to its position in the list
    FNodes.Add(Result);           //add it to the list
  except
    Result.FreeNode;            //in case of an error: free the node
    raise;
  end;
 end;


var       Path           :TList;     //all created dummy nodes of an edge
          i              :Integer;   //counter through all nodes
          j              :Integer;   //counter through all nodes it points to
          k              :Integer;  //counter for each dummy node to be created
          //difference in ranks = vertical distance (in layers) =
          Diff           :Integer;   //number of dummy nodes to be created
          Node           :PSortNode; //each node
          Edge           :PSortNode; //each node the nodes has an edge to
begin
 Path := TList.Create;               //create list of dummy nodes
 try
   for i := 0 to FNodes.Count - 1 do //for each node
    begin
     Node := FNodes[i];                //get the node
     for j := 0 to Node.OutEdges.Count - 1 do //for each node is has an edge to
      begin
       Edge := Node.OutEdges[j];         //get the other node
       Diff := Edge.Rank - Node.Rank;    //calculate distance between nodes
                                         //equals layers this edge spans

       assert(Diff > 0);                 //is sorted, has to be positive
       //distance is more than one, edge spans more than two layers?
       if Diff > 1 then
        begin
         dec(Diff, 2);                     //number of dummy nodes to insert
         Path.Clear;                       //clear list of created dummy nodes
         for k := 0 to Diff do             //for each node to be created
          begin
           Path.Add(CreateDummy);            //create it and add it to the list
           PSortNode(Path[k]).Rank := Node.Rank + k + 1; //set its rank (layer)

           if k <> 0 then                    //not first dummy node?
            begin       //add an edge between created nodes as a path to follow
             PSortNode(Path[k - 1]).OutEdges.Add(Path[k]);
             PSortNode(Path[k]).InEdges.Add(Path[k - 1]);
            end;
          end; //for k := 0 to Diff

         k := Edge.InEdges.IndexOf(Node);  //search the edge
         assert(k <> -1);
         Edge.InEdges[k] := Path[Diff];    //bend it to the path of dummy nodes
         PSortNode(Path[Diff]).OutEdges.Add(Edge); //and vice versa
         Node.OutEdges[j] := Path[0];      //bend it to the path of dummy nodes
         PSortNode(Path[0]).InEdges.Add(Node);     //and vice versa
        end; //if Diff > 1
      end; //for j := 0 to Node.OutEdges.Count - 1
    end; //for i := 0 to FNodes.Count - 1
 finally
  Path.Free;                         //free list of dummy nodes
 end;
end;






















































{Creates layers and assign each node to a layer. }
procedure TSugiyamaLayouter.LayeringPhase;
          //maximum number of nodes in a layer,
          //used when distributing 'zeronodes', i.e. nodes without edges.
const     LayerMaxNodes = 16;
var       i              :Integer;      //counter through each node
          Node           :PSortNode;    //each node
          ZeroNodes      :TList;        //list of nodes without edges
          MinCount       :Integer;      //minimum count of ndes in all layers
          MinIndex       :Integer;      //index of layer with minimal nodes
          j              :Integer;      //counter through each layer
begin
 RemoveCycles;       //make acyclic
 InitialRanking;     //sort the nodes with a topological ordering algorithm
 MakeProper;         //insert dummy-nodes so that each edge has length 1,
                      //i.e. is between two directly adjacent layers


 //here the layers are created based on the ranking-values of nodes


 ZeroNodes := TList.Create;             //create list of nodes without edges
 try

   //create layer for each rank of a node
   for i := 0 to FNodes.Count - 1 do    //for each node
    begin
     Node := FNodes[i];                   //get it
     if (Node.InEdges.Count = 0) and (Node.OutEdges.Count = 0) then //no edges?
      begin
       assert(Node.Rank = 0);
       ZeroNodes.Add(Node);                 //add to that list
      end
     else
      begin
       while FLayers.Count <= Node.Rank do  //create all needed layers
        FLayers.Add(TList.Create);
       TList(FLayers[Node.Rank]).Add(Node); //add node to the layer
      end;
    end; //for i := 0 to FNodes.Count - 1



   //distribute nodes without edges onto layers with the least number of nodes

   for i := 0 to ZeroNodes.Count - 1 do //for each node without edges
    begin
     MinCount := High(MinCount);          //assume the first layer is not full
     MinIndex := 0;
     for j := 0 to FLayers.Count - 1 do   //for each layer
      if TList(FLayers[j]).Count < MinCount then //new minimum number of nodes?
       begin
        MinCount := TList(FLayers[j]).Count;       //use this as new minimum
        MinIndex := j;                             //save this layer
       end;

     if MinCount >= LayerMaxNodes then    //all layers are full?
      begin
       MinIndex := FLayers.Count;
       FLayers.Add(TList.Create);           //create a new layer
      end;

     TList(FLayers[MinIndex]).Add(ZeroNodes[i]); //add node to the layer
    end; //for i := 0 to ZeroNodes.Count - 1
 finally
  ZeroNodes.Free;                       //free list of nodes without edges
 end;

 //now all edges should be pointing down onto the layer directly beneath
end;




































{Called to sort a list of nodes by the index to minimize crossings of edges
 between layers. Helper for ~[link TSugiyamaLayouter.CalcCrossingsTwoLayers].
 Type of the function is TListSortCompare.
~param Item1, Item2 the items in the list to be compared
~result relationship of the items to sort the list (</=/> 0) }
function NodeCOrderSortProc(Item1, Item2: Pointer): Integer;
begin
 //just return the relationship of the ~[link TSortNode.COrder]-members
 Result := PSortNode(Item1).COrder - PSortNode(Item2).COrder;
end;

{Calculates the number of crossings of edges between two adjacent layers.
 Warning: Does only really work if all nodes are of the same width (and maybe