sugiyamalayout.pas

ESS-Model is a powerful, reverse engine, UML-tool for Delphi/Kylix and Java-files.

{
  ESS-Model
  Copyright (C) 2002  Eldean AB, Peter S鰀erman, Ville Krumlinde

  This program 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 program 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.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

unit SugiyamaLayout;

{
  Layout according to the 'Sugiyama'-algoritm.


  Here is a good description of how it works:

    http://www.csi.uottawa.ca/ordal/papers/sander/main.html
}

interface

{$ifdef WIN32}
uses essLayout, contnrs, Controls;
{$endif}
{$ifdef LINUX}
uses essLayout, contnrs, QControls;
{$endif}


type
  TEdgeList = class;

  TNode = class
  private
    Id : integer;     //Index in nodes-list, must be updated when node changes position (after re-sort)
    InEdges,OutEdges : TEdgeList;
    Rank : integer;
    Order : integer;
    COrder : integer;
    Weight : single;
    IsDummy : boolean;
    X,Y,H,W : integer;
    Control : TControl;
    constructor Create;
  public
    destructor Destroy; override;
  end;

  TEdge = class
  private
    FromNode,ToNode : TNode;
    constructor Create(const FromNode,ToNode : TNode);
  end;

  {$HINTS OFF}
  TEdgeList = class(TObjectList)
  private
    function GetEdge(Index: Integer): TEdge;
    property Edges[Index: Integer]: TEdge read GetEdge; default;
  end;
  TNodeList = class(TObjectList)
  private
    function GetNode(Index: Integer): TNode;
    function LastIndexOf(const P : pointer) : integer;
    property Nodes[Index: Integer]: TNode read GetNode; default;
  end;
  TLayerList = class(TObjectList)
  private
    function GetLayer(Index: Integer): TNodeList;
    property Layers[Index: Integer]: TNodeList read GetLayer; default;
  end;
  {$HINTS ON}

  TSugiyamaLayout = class(TEssLayout)
  private
    Nodes : TNodeList;
    Layers : TLayerList;
    procedure ExtractNodes;
    procedure ApplyNodes;
    procedure DoPhases;
    procedure AddEdge(const FromNode,ToNode : TNode);

    //First phase
    procedure LayeringPhase;
    procedure MakeAcyclic;
    procedure InitialRanking;
    procedure MakeProper;
    procedure TopoSort;

    //Second phase
    procedure OrderingPhase;
    function CalcCrossings : integer;
    function CalcCrossingsTwoLayers(const Layer1,Layer2 : TNodeList) : integer;

    //Third phase
    procedure PositioningPhase;
    procedure SetXPositions;
    procedure SetYPositions;
  public
    procedure Execute; override;
    destructor Destroy; override;
  end;


implementation

uses Classes,
     essConnectPanel,
     Math,
     SysUtils;



{ TSugiyamaLayout }

procedure TSugiyamaLayout.Execute;
begin
  ExtractNodes;
  DoPhases;
  ApplyNodes;
end;


//Extract nodes from essconnectpanel
procedure TSugiyamaLayout.ExtractNodes;
var
  L : TList;
  I : integer;
  C : TControl;
  Con : essConnectPanel.TConnection;
  Node,FromNode,ToNode : TNode;
begin
  Nodes := TNodeList.Create(True);

  L := Panel.GetManagedObjects;
  try
    for I := 0 to L.Count-1 do
    begin
      C := TControl(L[I]);
      if not C.Visible then
        Continue;
      Node := TNode.Create;
      Node.H := C.Height;
      Node.W := C.Width;
      Node.Control := C;
      Node.Id := Nodes.Count;
      C.Tag := Node.Id;
      Nodes.Add(Node);
    end;
  finally
    L.Free;
  end;

  L := Panel.GetConnections;
  try
    for I := 0 to L.Count-1 do
    begin
      Con := TConnection(L[I]);
      if (not Con.FFrom.Visible) or (not Con.FTo.Visible) then
        Continue;

      //Here the connection is reversed: from=to, to=from
      //This is because the algorithm assumes that everything points downwards, while
      //we want all arrows to point upwards (descendants pointing up to their baseclass).
      if Con.FConnectStyle=csNormal then
      begin  //Reverse Inheritance-connections
        FromNode := Nodes[ Con.FTo.Tag ];
        ToNode := Nodes[ Con.FFrom.Tag ];
      end
      else
      begin  //Do not reverse Unit-Associations and Implements-interface
        FromNode := Nodes[ Con.FFrom.Tag ];
        ToNode := Nodes[ Con.FTo.Tag ];
      end;
      AddEdge(FromNode,ToNode);
    end;
  finally
    L.Free;
  end;
end;



//Writes back layout to essconnectpanel
procedure TSugiyamaLayout.ApplyNodes;
var
  I : integer;
  Node : TNode;
begin
  for I := 0 to Nodes.Count-1 do
  begin
    Node := Nodes[I];
    if Node.IsDummy then
      Continue;
    Node.Control.Left := Node.X;
    Node.Control.Top := Node.Y;
  end;
end;


//Executes the different phases of the layout-algorithm
procedure TSugiyamaLayout.DoPhases;
begin
  //Place nodes in layers
  LayeringPhase;
  //Sort nodes within each layer
  OrderingPhase;
  //Decide final X and Y position for nodes
  PositioningPhase;
end;



//Make layers, and assign each node to a layer
procedure TSugiyamaLayout.LayeringPhase;
const
  //Max nr of nodes in a layer, used when distributing 'zeronodes'.
  LayerMaxNodes = 16;
var
  I,J,MinC,MinI : integer;
  Node : TNode;
  ZeroNodes : TNodeList;
begin
  MakeAcyclic;
  InitialRanking;
  MakeProper;
  //Here the layers are created based on the ranking-value of nodes.
  Layers := TLayerList.Create;
  ZeroNodes := TNodeList.Create(False);
  try
    for I := 0 to Nodes.Count-1 do
    begin
      Node := Nodes[I];
      if Node.InEdges.Count + Node.OutEdges.Count=0 then
        ZeroNodes.Add(Node)
      else
      begin
        while Layers.Count<Nodes[I].Rank + 1 do
          Layers.Add( TNodeList.Create(False) );
        Layers[ Nodes[I].Rank ].Add( Nodes[I] );
      end;
    end;
    //Distribute nodes without edges onto layers with the least nr of nodes
    for I:=0 to ZeroNodes.Count-1 do
    begin
      MinC := LayerMaxNodes;
      MinI := 0;
      for J := 0 to Layers.Count-1 do
        if Layers[J].Count<MinC then
        begin
          MinC := Layers[J].Count;
          MinI := J;
        end;
      if MinC>=LayerMaxNodes then
      begin
        //If all layers has LayerMaxNodes nr of nodes, then create a new layer
        Layers.Add( TNodeList.Create(False) );
        MinI := Layers.Count-1;
      end;
      Layers[MinI].Add(ZeroNodes[I]);
    end;
  finally
    ZeroNodes.Free;
  end;
  //Now all edges should be pointing down onto the layer directly beneath it.
end;


destructor TSugiyamaLayout.Destroy;
begin
  if Assigned(Nodes) then Nodes.Free;
  if Assigned(Layers) then Layers.Free;
  inherited;
end;


procedure TSugiyamaLayout.AddEdge(const FromNode, ToNode: TNode);
begin
  FromNode.OutEdges.Add( TEdge.Create(FromNode,ToNode) );
  ToNode.InEdges.Add( TEdge.Create(FromNode,ToNode) );
end;




procedure TSugiyamaLayout.MakeAcyclic;
{
  The graph cannot include cycles, so these must be removed.

  A cycle is removed by reversing an edge in the cycle.

  DFS = Depth First Search.

  "strongly connected components"
    This means nodes where there is a path a->b and b<-a (cycles)

  Calc set of strongly connected components
    for each component
      if there are more than one node in component, reverse an edge
        reverse the edge with min( outdeg(v) ) max( indeg(v) + indeg(w) )
  loop until each component includes only one node

  More info:
    http://www.ics.uci.edu/~eppstein/161/960215.html
    http://www.ics.uci.edu/~eppstein/161/960220.html
}
type
  TDfsStruct =
    record
      Visited,Removed : boolean;
      DfsNum,DfsLow : integer;
    end;
var
  DfsList : array of TDfsStruct;
  CurDfs,CycCount : integer;
  Path : TObjectList;
  I,Safety : integer;
  SuperNode : TNode;

  procedure InReverse(N : TNode; E : integer);
  var
    I : integer;
    ToNode : TNode;
  begin
    ToNode := N.OutEdges[E].ToNode;
    for I := 0 to ToNode.InEdges.Count-1 do
      if ToNode.InEdges[I].FromNode = N then
      begin
        ToNode.InEdges.Delete(I);
        N.OutEdges.Delete(E);
        AddEdge( ToNode, N );
        Break;
      end;
  end;

  procedure InVisit(N : TNode);
  var
    I,J,Score,BestScore,RevEdge : integer;
    W,V,RevNode : TNode;
    Cyc : TObjectList;
  begin
    Path.Add( N );
    with DfsList[ N.Id ] do
    begin
      DfsNum := CurDfs;
      DfsLow := CurDfs;
      Visited := True;
    end;
    Inc(CurDfs);
    //Walk out-edges recursive
    for I := 0 to N.OutEdges.Count-1 do
    begin
      W := N.OutEdges[I].ToNode;
      if not DfsList[ W.Id ].Removed then
      begin
        if not DfsList[ W.Id ].Visited then
        begin
          InVisit(W);
          DfsList[ N.Id ].DfsLow := Min( DfsList[ N.Id ].DfsLow , DfsList[ W.Id ].DfsLow );
        end
        else
          DfsList[ N.Id ].DfsLow := Min( DfsList[ N.Id ].DfsLow , DfsList[ W.Id ].DfsNum );
      end;
    end;
    //Check if there was a cycle
    if DfsList[ N.Id ].DfsLow = DfsList[ N.Id ].DfsNum then
    begin
      Cyc := TObjectList.Create(False);
      repeat
        V := TNode(Path.Last);
        Path.Delete( Path.Count-1 );
        Cyc.Add( V );
        DfsList[ V.Id ].Removed := True;
      until V = N;
      if Cyc.Count>1 then
      begin //Real cycle found
        Inc(CycCount);
        BestScore := -1;
        RevEdge := 0;
        RevNode := TNode(Cyc[0]);
        for I :=0 to Cyc.Count-1 do
        begin //Find edge with min( outdeg(v) ) max( indeg(v) + indeg(w) )
          V := TNode(Cyc[I]);
          for J := 0 to V.OutEdges.Count-1 do
            if Cyc.IndexOf( V.OutEdges[J].ToNode )>-1 then
            begin
              Score := V.InEdges.Count + V.OutEdges[J].ToNode.InEdges.Count - V.OutEdges.Count;
              if V.OutEdges.Count=1 then
                Inc(Score,50);
              if Score>BestScore then
              begin
                BestScore := Score;
                RevNode := V;
                RevEdge := J;
              end;
            end;
        end;
        InReverse(RevNode,RevEdge);
      end;
      Cyc.Free;
    end;
  end;

begin
  Path := TObjectList.Create(False);

  SuperNode := TNode.Create;
  for I := 0 to Nodes.Count-1 do
    SuperNode.OutEdges.Add( TEdge.Create(SuperNode,Nodes[I]) );
  SuperNode.Id := Nodes.Count;

  Safety := 0;
  repeat
    Path.Clear;
    DfsList := nil;
    SetLength(DfsList,Nodes.Count + 1);
    CurDfs := 0;
    CycCount := 0;
    InVisit(SuperNode);
    Inc(Safety);
    if Safety > 30 then
      raise Exception.Create('Layout failed.');
  until CycCount=0;

  SuperNode.Free;

  Path.Free;
end;




var
  //Global temparray used by sortfunc
  _Labels : array of integer;

function TopoSortProc(Item1, Item2: Pointer): Integer;
begin
  if _Labels[ TNode(Item1).Id ] < _Labels[ TNode(Item2).Id ] then
    Result := -1
  else if _Labels[ TNode(Item1).Id ] = _Labels[ TNode(Item2).Id ] then
    Result:=0  //equal
  else
    Result := 1;
end;


{
  Topological sort.

  Sort so that all dependancies points forward in the list.

  Topological order:
    A numbering of the nodes of a directed acyclic graph such that every edge from a node
    numbered i to a node numbered j satisfies i<j.
}
procedure TSugiyamaLayout.TopoSort;
var
  Indeg : array of integer;
  S : TStack;
  I,NextLabel : integer;
  Node : TNode;
  Edge : TEdge;
begin
  SetLength(Indeg,Nodes.Count);
  _Labels := nil;
  SetLength(_Labels,Nodes.Count);

  S:=TStack.Create;
  try
    //init indeg with n.indeg
    //push nodes without incoming edges
    for I:=0 to Nodes.Count-1 do
    begin
      Indeg[I] := Nodes[I].InEdges.Count;
      if Indeg[I]=0 then
        S.Push(Nodes[I]);
    end;

    if S.Count=0 then
      raise Exception.Create('empty layout or connection-cycles');

    NextLabel := 0;
    while S.Count>0 do
    begin
      Node := TNode(S.Pop);
      Inc(NextLabel);
      _Labels[Node.Id]:=NextLabel;
      for I:=0 to Node.OutEdges.Count-1 do
      begin
        Edge := Node.OutEdges[I];
        Dec(Indeg[ Edge.ToNode.Id ]);
        if (Indeg[ Edge.ToNode.Id ]=0) and (_Labels[Edge.ToNode.Id]=0) then
          S.Push( Edge.ToNode );
      end;
    end;

    //0 cannot be in _labels, i.e. all nodes must have been processed in the previous step
    for I := 0 to High(_Labels) do
      if _Labels[I]=0 then
        raise Exception.Create('connection-cycles');

    //sort nodes based on their _label
    Nodes.Sort(TopoSortProc);
    _Labels := nil;
    //refresh node id's after sort
    for I:=0 to Nodes.Count-1 do
      Nodes[I].Id:=I;
  finally
    S.Free;
  end;
end;


procedure TSugiyamaLayout.InitialRanking;
{
    sortera nodes med topological sort

    nodes[0] har minst antal indeg, nodes[count] har flest
      setlength(rank,nodes.count)
      foreach nodes, n
        r = 0
        foreach nodes i n.inEdges, innode
          if rank[ innode ]>r then r= rank[ innode ] + 1
        rank[index]=r
}
var
  I,J,R,Temp : integer;
begin
  TopoSort;
  for I := 0 to Nodes.Count-1 do
  begin
    R := 0;
    for J := 0 to Nodes[I].InEdges.Count-1 do
    begin
      Temp := Nodes[I].InEdges[J].FromNode.Rank;
      if Temp>=R then
        R := Temp + 1;
    end;
    Nodes[I].Rank := R;
  end;
end;


procedure TSugiyamaLayout.SetYPositions;
const
  VSpacing = 40;