udiagramautolayout.pas

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

 height), what is not the case in this diagrams, but nevertheless it should
 still be a good approximation.
~param Layer1, Layer2 the two adjacent layers to sum up all crossings of edges
                      between them
~result number of crossings of edges between both layers }
function TSugiyamaLayouter.CalcCrossingsTwoLayers(Layer1,
                                                  Layer2: TList): Integer;

 {Sums up the number of crossings of the edges of this node.
 ~param Node the node to check the edges is they cross other edges
 ~param This list that may contain this node
 ~param That list that contains active number of edges to the other layer }
 procedure SumCrossings(Node: PSortNode; This, That: TList);
 var       i           :Integer;    //counter through all nodes
           //algorithm dependic value:
           K1          :Integer;    //number of times this node is in this list
           //algorithm dependic value: number of nodes it crossed
           K2          :Integer;
           //algorithm dependic value: number of nodes it crossed multiplied
           K3          :Integer;    //with number of edges of this node
 begin
  if This.IndexOf(Node) <> -1 then    //is this node in the list?
   begin
    K1 := 0;                            //no nodes found so far
    K2 := 0;                            //no potential crossings so far
    K3 := 0;                            //no crossings so far
    for i := This.Count - 1 downto 0 do //for each node in this list
     //loop through all active endpoints in upperlayer
     if This[i] = Node then               //is this node?
      begin
       inc(K1);                   //increment counter of this node in the list
       inc(K3, K2);               //increment crossings
       This.Delete(i);            //delete this node from the list
      end
     else
      inc(K2);                    //increment potential number of crossed edges

    //increase number of crossings
    inc(Result, K1 * That.Count + K3);
   end;
 end;

 {Adds all edges pointing to nodes "more right" than this node to the list.
  They are new active end-points in other layer.
 ~param Edges   list of edges of the current node
 ~param AddList list to add the "more right" nodes to
 ~param COrder  position of the current node, to distinguish "more right"
                nodes }
 procedure AddEdges(Edges: TList; AddList: TList; COrder: Integer);
 var       i       :Integer;        //counter through all edges
           Edge    :PSortNode;      //node the edge associates with
 begin
  for i := 0 to Edges.Count - 1 do  //for each edge
   begin
    Edge := Edges[i];                 //get the other node

    //only add edges that points "to the right" (higher (c-)order),
    //the other edges are handled from the other side of the edge
    if COrder < Edge.COrder then
     AddList.Add(Edge);
   end;
 end;

var      COrder         :Integer;       //counter for positions of the nodes
         //list of all nodes (of both layers, added alternatedly)
         CNodes         :TList;

 {Adds the node with the index of the layer to the list of all nodes.
 ~param Index the index of the node in the layer
 ~param Layer the layer the node is in }
 procedure AddCO(Index: Integer; Layer: TList);
 var       Node :PSortNode;    //the node to add
 begin
  if Index < Layer.Count then  //is a valid index?
   begin
    Node := Layer[Index];        //get the node
    Node.COrder := COrder;       //set its position in the list
    CNodes.Add(Node);            //add it to the list
   end;
  inc(COrder);                 //increment position in the list
 end;

var      i              :Integer;   //counter through all nodes
         UL             :TList;     //active end-points of edges in upper layer
         LL             :TList;     //active end-points of edges in lower layer
         Node           :PSortNode; //each node
begin
 Result := 0;                       //no crossings so far

 CNodes := TList.Create;            //create list of all nodes
 try

   //initialize CNodes and Node.COrder
   COrder := 0;                     //first node is the first in the list
   //for all nodes in both layers
   for i := 0 to Max(Layer1.Count, Layer2.Count) - 1 do
    begin
     AddCO(i, Layer2);                //add node in lower layer (even COrder!)
     AddCO(i, Layer1);                //add node in upper layer (odd COrder!)
    end;


   for i := 0 to CNodes.Count - 1 do //for each node in both layers
    begin
     Node := CNodes[i];                //get it
     if Odd(i) then                    //node is in the upper layer?
      //sort edges pointing towards lower layer
      Node.OutEdges.Sort(NodeCOrderSortProc)
     else
      //sort edges coming from upper layer
      Node.InEdges.Sort(NodeCOrderSortProc);
    end;


   UL := TList.Create;    //create list of active end-points in the upper layer
   try
     LL := TList.Create;  //create list of active end-points in the lower layer
     try

       for i := 0 to CNodes.Count - 1 do //for each node in both layers
        begin
         Node := CNodes[i];                 //get the node
         if Odd(Node.COrder) then           //node is in the upper layer?
          begin
           //weight and remove all associated nodes
           SumCrossings(Node, UL, LL);
           //add new active endpoints in lower layer
           AddEdges(Node.OutEdges, LL, Node.COrder);
          end
         else
          begin
           //weight and remove all associated nodes
           SumCrossings(Node, LL, UL);
           //add new active endpoints in upper layer
           AddEdges(Node.InEdges, UL, Node.COrder);
          end;
       end;

     finally
      LL.Free;            //free list of active end-points in the lower layer
     end;
   finally
    UL.Free;              //free list of active end-points in the upper layer
   end;

 finally
  CNodes.Free;                      //free list of all nodes
 end;
end;




{Calculates the number of crossings of edges between all layers.
~result the number of crossings of edges between all layers }
function TSugiyamaLayouter.CalcCrossings: Integer;
var      i              :Integer;     //counter through all layers
begin
 Result := 0;                         //no crossings so far
 if FLayers.Count > 1 then            //more than one layer?
  for i := 0 to FLayers.Count - 2 do    //for each adjacent layers
   //add number of crossings between the two layers to sum 
   Inc(Result, CalcCrossingsTwoLayers(FLayers[i], FLayers[i + 1]));
end;
















{Called to sort a list of nodes by the weight to minimize crossings of edges
 between layers. Helper for ~[link TSugiyamaLayouter.OrderingPhase].
 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 WeightSortProc(Item1, Item2: Pointer): Integer;
var      Diff          :Double;
begin
 Diff := PSortNode(Item1).Weight - PSortNode(Item2).Weight;
 Result := Ord(Diff > 0) - Ord(Diff < 0);
end;

{Called to sort a list of nodes by the order to minimize crossings of edges
 between layers. Helper for ~[link TSugiyamaLayouter.OrderingPhase].
 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 OrderSortProc(Item1, Item2: Pointer): Integer;
begin
 Result := PSortNode(Item1).Order - PSortNode(Item2).Order;
end;


{Sorts the nodes within each layer to generate minimal crossings of edges. }
procedure TSugiyamaLayouter.OrderingPhase;

 {Weights a node by a list of edges.
 ~param List the list of edges to weight the node by
 ~result the weight of the node }
 function Weight(List: TList): Double;
          //the sum of the positions of the node the edges associate with
 var      Sum   :Integer;
          i     :Integer;              //counter through all edges
 begin
  if List.Count <> 0 then              //some edges?
   begin
    Sum := 0;                          //empty sum so far
    for i := 0 to List.Count - 1 do    //for each edge
     inc(Sum, PSortNode(List[i]).Order); //add order of the other node

    Result := Sum / List.Count;        //return average of their positions
   end
  else
   Result := 0;                        //no edges, weight is 0
 end;

 {Goes downwards and sorts each layer based on the order of nodes in the layer
  above it. }
 procedure WeightDownward;
 var       i             :Integer;   //counter through all layers
           Layer         :TList;     //each layer
           j             :Integer;   //counter through all nodes in the layers
           Node          :PSortNode; //each node
 begin
  for i := 1 to FLayers.Count - 1 do //for each (pair of adjacent) layer
   begin
    Layer := FLayers[i];               //get it
    for j := 0 to Layer.Count - 1 do   //for each node in the layer
     begin
      Node := Layer[j];                      //get it
      Node.Weight := Weight(Node.InEdges);   //weight it
     end;
    Layer.Sort(WeightSortProc);       //sort nodes in the layer by their weight

    //update order because nodes have switched positions
    for j := 0 to Layer.Count - 1 do
     PSortNode(Layer[j]).Order := j;
   end;
 end;

 {Goes upwards and sorts each layer based on the order of nodes in the layer
  below it }
 procedure WeightUpward;
 var       i           :Integer;      //counter through all layers
           Layer       :TList;        //each layer
           j           :Integer;      //counter through all nodes in the layers
           Node        :PSortNode;    //each node
 begin
  for i := FLayers.Count - 2 downto 0 do //for each (pair of adjacent) layer
   begin
    Layer := FLayers[i];                   //get it
    for j := 0 to Layer.Count - 1 do       //for each node in the layer
     begin
      Node := Layer[j];                      //get it
      Node.Weight := Weight(Node.OutEdges);  //weight it
     end;
    Layer.Sort(WeightSortProc);       //sort nodes in the layer by their weight

    //update order because nodes have switched positions
    for j := 0 to Layer.Count - 1 do
     PSortNode(Layer[j]).Order := j;
   end;
 end;

          //list/variable array of the best found order of the nodes;
          //length equals number of nodes
type      TIntegerArray = array[0..High(Integer) div SizeOf(Integer) - 1] of
                          Integer;
          //best (lowest) found number of crossings of an order
var       BestCrossCount :Integer;
          BestOrder      :^TIntegerArray;  //the best found order

 {Checks the current order if it is the best found one so far. If that is the
  case it is saved. }
 procedure InCheckCrossings;
 var       Crossings       :Integer; //number of crossings in the current order
           i               :Integer; //counter through each node
 begin
  Crossings := CalcCrossings;        //calculate number of crossings
  if (Crossings < BestCrossCount) or //new lowest value?
     (BestCrossCount = High(BestCrossCount)) then
   begin
    BestCrossCount := Crossings;       //save the value
    for i := 0 to FNodes.Count - 1 do  //and the positions of each node
     BestOrder[i] := PSortNode(FNodes[i]).Order;
   end;
 end;



const     MaxIterations = 35;        //maximum tries to find the best order
var       BailOut        :Integer;   //current number of tries
          i, j           :Integer;   //general counters
begin
 //create initial (current) order
 for i := 0 to FLayers.Count - 1 do  //for each layer
  with TList(FLayers[i]) do
   for j := 0 to Count - 1 do          //for each node in the layer
    PSortNode(Items[j]).Order := j;      //save current position

 //get array for the best found order
 GetMem(BestOrder, FNodes.Count * SizeOf(BestOrder[0]));
 try
   BestCrossCount := High(BestCrossCount); //no (only the worst) order found

   BailOut := 0;                     //not tried yet
   repeat                            //until no crossings or all tries used

     //sort each layer based on the order of nodes in the layer above it
     WeightDownward;
     InCheckCrossings;                 //check if new best order

     if BestCrossCount <> 0 then       //still some crossings of edges left?
      begin
       //sort each layer based on the order of nodes in the layer below it
       WeightUpward;
       InCheckCrossings;                 //check if new best order
      end;

     inc(BailOut);                     //that was another try
   //until no crossings of edges or all tries used
   until (BailOut > MaxIterations) or (BestCrossCount = 0);


   //apply the best found order
   for i := 0 to FNodes.Count - 1 do          //for each node
    PSortNode(FNodes[i]).Order := BestOrder[i]; //set its new order
   for i := 0 to FLayers.Count - 1 do         //for each layer
    TList(FLayers[i]).Sort(OrderSortProc);      //sort its nodes by their order

 finally
  FreeMem(BestOrder);                //free array for the best found order
 end;
end;






























{Calculates the vertical positions of all layers. }
procedure TSugiyamaLayouter.SetYPositions;
var       Y              :Integer;   //current vertical position
          i              :Integer;   //counter through all layers
          Highest        :Integer;   //maximum height of a box in current layer
          Layer          :TList;     //each layer
          j              :Integer;   //counter through all nodes in each layers
          Node           :PSortNode; //each node
begin
 Y := 0;                             //start at the top
 for i := 0 to FLayers.Count - 1 do  //for each layer
  begin
   Layer := FLayers[i];                //get it
   //put all nodes in a layer with the same vertical position
   Highest := 0;                       //no node so far, so no height
   for j := 0 to Layer.Count - 1 do    //for each node
    begin
     Node := Layer[j];                   //get it
     if assigned(Node.Box) then          //not a dummy node?