#############################################################################
# Layout directed graphs on a flat plane. Part of Graph::Easy.
#
# (c) by Tels 2004-2008.
#############################################################################
package Graph::Easy::Layout;
$VERSION = '0.75';
#############################################################################
#############################################################################
package Graph::Easy;
use strict;
use warnings;
require Graph::Easy::Node::Cell;
use Graph::Easy::Edge::Cell qw/
EDGE_HOR EDGE_VER
EDGE_CROSS
EDGE_TYPE_MASK EDGE_MISC_MASK EDGE_NO_M_MASK
EDGE_SHORT_CELL
/;
use constant {
ACTION_NODE => 0, # place node somewhere
ACTION_TRACE => 1, # trace path from src to dest
ACTION_CHAIN => 2, # place node in chain (with parent)
ACTION_EDGES => 3, # trace all edges (shortes connect. first)
ACTION_SPLICE => 4, # splice in the group fillers
};
require Graph::Easy::Layout::Chain; # chain management
use Graph::Easy::Layout::Scout; # pathfinding
use Graph::Easy::Layout::Repair; # group cells and splicing/repair
use Graph::Easy::Layout::Path; # path management
use Graph::Easy::Util qw(ord_values);
#############################################################################
sub _assign_ranks
{
# Assign a rank to each node/group.
# Afterwards, every node has a rank, these range from 1..infinite for
# user supplied ranks, and -1..-infinite for automatically found ranks.
# This lets us later distinguish between autoranks and userranks, while
# still being able to sort nodes based on their (absolute) rank.
my $self = shift;
# a Heap to keep the todo-nodes (aka rank auto or explicit)
my $todo = Graph::Easy::Heap->new();
# sort entries based on absolute value
$todo->sort_sub( sub ($$) { abs($_[0]) <=> abs($_[1]) } );
# a list of all other nodes
my @also;
# XXX TODO:
# gather elements todo:
# graph: contained groups, plus non-grouped nodes
# groups: contained groups, contained nodes
# sort nodes on their ID to get some basic order
my @N = $self->sorted_nodes('id');
push @N, $self->groups();
my $root = $self->root_node();
$todo->add([$root->{rank} = -1,$root]) if ref $root;
# Gather all nodes that have outgoing connections, but no incoming:
for my $n (@N)
{
# we already handled the root node above
next if $root && $n == $root;
# if no rank set, use 0 as default
my $rank_att = $n->raw_attribute('rank');
$rank_att = undef if defined $rank_att && $rank_att eq 'auto';
# XXX TODO: this should not happen, the parser should assign an
# automatic rank ID
$rank_att = 0 if defined $rank_att && $rank_att eq 'same';
# user defined ranks range from 1..inf
$rank_att++ if defined $rank_att;
# assign undef or 0, 1 etc
$n->{rank} = $rank_att;
# user defined ranks are "1..inf", while auto ranks are -1..-inf
$n->{rank} = -1 if !defined $n->{rank} && $n->predecessors() == 0;
# push "rank: X;" nodes, or nodes without predecessors
$todo->add([$n->{rank},$n]) if defined $n->{rank};
push @also, $n unless defined $n->{rank};
}
# print STDERR "# Ranking:\n";
# for my $n (@{$todo->{_heap}})
# {
# print STDERR "# $n->[1]->{name} $n->[0] $n->[1]->{rank}:\n";
# }
# print STDERR "# Leftovers in \@also:\n";
# for my $n (@also)
# {
# print STDERR "# $n->{name}:\n";
# }
# The above step will create a list of todo nodes that start a chain, but
# it will miss circular chains like CDEC (e.g. only A appears in todo):
# A -> B; C -> D -> E -> C;
# We fix this as last step
while ((@also != 0) || $todo->elements() != 0)
{
# while we still have nodes to follow
while (my $elem = $todo->extract_top())
{
my ($rank,$n) = @$elem;
my $l = $n->{rank};
# If the rank comes from a user-supplied rank, make the next node
# have an automatic rank (e.g. 4 => -4)
$l = -$l if $l > 0;
# -4 > -5
$l--;
for my $o ($n->successors())
{
if (!defined $o->{rank})
{
# print STDERR "# set rank $l for $o->{name}\n";
$o->{rank} = $l;
$todo->add([$l,$o]);
}
}
}
last unless @also;
while (@also)
{
my $n = shift @also;
# already done? so skip it
next if defined $n->{rank};
$n->{rank} = -1;
$todo->add([-1, $n]);
# leave the others for later
last;
}
} # while still something todo
# print STDERR "# Final ranking:\n";
# for my $n (@N)
# {
# print STDERR "# $n->{name} $n->{rank}:\n";
# }
$self;
}
sub _follow_chain
{
# follow the chain from the node
my ($node) = @_;
my $self = $node->{graph};
no warnings 'recursion';
my $indent = ' ' x (($node->{_chain}->{id} || 0) + 1);
print STDERR "#$indent Tracking chain from $node->{name}\n" if $self->{debug};
# create a new chain and point it to the start node
my $chain = Graph::Easy::Layout::Chain->new( start => $node, graph => $self );
$self->{chains}->{ $chain->{id} } = $chain;
my $first_node = $node;
my $done = 1; # how many nodes did we process?
NODE:
while (3 < 5)
{
# Count "unique" successsors, ignoring selfloops, multiedges and nodes
# in the same chain.
my $c = $node->{_chain};
local $node->{_c} = 1; # stop back-ward loops
my %suc;
for my $e (ord_values ( $node->{edges} ))
{
my $to = $e->{to};
# ignore self-loops
next if $e->{from} == $e->{to};
# XXX TODO
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
# print STDERR "# bidi $e->{from}->{name} to $e->{to}->{name}\n" if $e->{bidirectional} && $to == $node;
# if it is bidirectional, and points the "wrong" way, turn it around
$to = $e->{from} if $e->{bidirectional} && $to == $node;
# edge leads to this node instead from it?
next if $to == $node;
# print STDERR "# edge_flow for edge $e", $e->edge_flow() || 'undef' ,"\n";
# print STDERR "# flow for edge $e", $e->flow() ,"\n";
# If any of the leading out edges has a flow, stop the chain here
# This prevents a chain on an edge w/o a flow to be longer and thus
# come first instead of a flow-edge. But don't stop if there is only
# one edge:
if (defined $e->edge_flow())
{
%suc = ( $to->{name} => $to ); # empy any possible chain info
last;
}
next if exists $to->{_c}; # backloop into current branch?
next if defined $to->{_chain} && # ignore if it points to the same
$to->{_chain} == $c; # chain (backloop)
# if the next node's grandparent is the same as ours, it depends on us
next if $to->find_grandparent() == $node->find_grandparent();
# ignore multi-edges by dropping
$suc{$to->{name}} = $to; # duplicates
}
last if keys %suc == 0; # the chain stopped here
if (scalar keys %suc == 1) # have only one unique successor?
{
my ($key) = keys(%suc);
my $s = $suc{ $key };
if (!defined $s->{_chain}) # chain already done?
{
$c->add_node( $s );
$node = $s; # next node
print STDERR "#$indent Skipping ahead to $node->{name}\n" if $self->{debug};
$done++; # one more
next NODE; # skip recursion
}
}
# Select the longest chain from the list of successors
# and join it with the current one:
my $max = -1;
my $next; # successor
my $next_chain = undef;
print STDERR "#$indent $node->{name} successors: \n" if $self->{debug};
my @rc;
# for all successors
#for my $s (sort { $a->{name} cmp $b->{name} || $a->{id} <=> $b->{id} } values %suc)
for my $s (ord_values ( \%suc))
{
print STDERR "# suc $s->{name} chain ", $s->{_chain} || 'undef',"\n" if $self->{debug};
$done += _follow_chain($s) # track chain
if !defined $s->{_chain}; # if not already done
next if $s->{_chain} == $c; # skip backlinks
my $ch = $s->{_chain};
push @rc, [ $ch, $s ];
# point node to new next node
($next_chain, $max, $next) =
($ch, $ch->{len}, $s) if $ch->{len} > $max;
}
if (defined $next_chain && $self->{debug})
{
print STDERR "# results of tracking successors:\n";
for my $ch (@rc)
{
my ($c,$s) = @$ch;
my $len = $c->length($s);
print STDERR "# chain $c->{id} starting at $c->{start}->{name} (len $c->{len}) ".
" pointing to node $s->{name} (len from there: $len)\n";
}
print STDERR "# Max chain length is $max (chain id $next_chain->{id})\n";
}
if (defined $next_chain)
{
print STDERR "#$indent $node->{name} next: " . $next_chain->start()->{name} . "\n" if $self->{debug};
if ($self->{debug})
{
print STDERR "# merging chains\n";
$c->dump(); $next_chain->dump();
}
$c->merge($next_chain, $next) # merge the two chains
unless $next == $self->{_root} # except if the next chain starts with
# the root node (bug until v0.46)
;# || $next_chain->{start} == $self->{_root}; # or the first chain already starts
# with the root node (bug until v0.47)
delete $self->{chains}->{$next_chain->{id}} if $next_chain->{len} == 0;
}
last;
}
print STDERR "#$indent Chain $node->{_chain} ended at $node->{name}\n" if $self->{debug};
$done; # return nr of done nodes
}
sub _find_chains
{
# Track all node chains (A->B->C etc), trying to find the longest possible
# node chain. Returns (one of) the root node(s) of the graph.
my $self = shift;
print STDERR "# Tracking chains\n" if $self->{debug};
# drop all old chain info
$self->{_chains} = { };
$self->{_chain} = 0; # new chain ID
# For all not-done-yet nodes, track the chain starting with that node.
# compute predecessors for all nodes: O(1)
my $p;
my $has_origin = 0;
foreach my $n (ord_values ( $self->{nodes} ), ord_values ( $self->{groups} ))
# for my $n (ord_values ( $self->{nodes} ))
{
$n->{_chain} = undef; # reset chain info
$has_origin = 0;
$has_origin = 1 if defined $n->{origin} && $n->{origin} != $n;
$p->{$n->{name}} = [ $n->has_predecessors(), $has_origin, abs($n->{rank}) ];
}
my $done = 0; my $todo = scalar keys %{$self->{nodes}};
# the node where the layout should start, as name
my $root_name = $self->{attr}->{root};
$self->{_root} = undef; # as ref to a Node object
# Start at nodes with no predecessors (starting points) and then do the rest:
for my $name ($root_name, sort {
my $aa = $p->{$a};
my $bb = $p->{$b};
# sort first on rank
$aa->[2] <=> $bb->[2] ||
# nodes that have an origin come last
$aa->[1] <=> $bb->[1] ||
# nodes with no predecessorts are to be prefered
$aa->[0] <=> $bb->[0] ||
# last resort, alphabetically sorted
$a cmp $b
} keys %$p)
{
next unless defined $name; # in case no root was set, first entry
# will be undef and must be skipped
my $n = $self->{nodes}->{$name};
# print STDERR "# tracing chain from $name (", join(", ", @{$p->{$name}}),")\n";
# store root node unless already found, is accessed in _follow_chain()
$self->{_root} = $n unless defined $self->{_root};
last if $done == $todo; # already processed all nodes?
# track the chain unless already done and count number of nodes done
$done += _follow_chain($n) unless defined $n->{_chain};
}
print STDERR "# Oops - done only $done nodes, but should have done $todo.\n" if $done != $todo && $self->{debug};
print STDERR "# Done all $todo nodes.\n" if $done == $todo && $self->{debug};
$self->{_root};
}
#############################################################################
# debug
sub _dump_stack
{
my ($self, @todo) = @_;
print STDERR "# Action stack contains ", scalar @todo, " steps:\n";
for my $action (@todo)
{
my $action_type = $action->[0];
if ($action_type == ACTION_NODE)
{
my ($at,$node,$try,$edge) = @$action;
my $e = ''; $e = " on edge $edge->{id}" if defined $edge;
print STDERR "# place '$node->{name}' with try $try$e\n";
}
elsif ($action_type == ACTION_CHAIN)
{
my ($at, $node, $try, $parent, $edge) = @$action;
my $id = 'unknown'; $id = $edge->{id} if ref($edge);
print STDERR
"# chain '$node->{name}' from parent '$parent->{name}' with try $try (for edge id $id)'\n";
}
elsif ($action_type == ACTION_TRACE)
{
my ($at,$edge) = @$action;
my ($src,$dst) = ($edge->{from}, $edge->{to});
print STDERR
"# trace '$src->{name}' to '$dst->{name}' via edge $edge->{id}\n";
}
elsif ($action_type == ACTION_EDGES)
{
my $at = shift @$action;
print STDERR
"# tracing the following edges, shortest and with flow first:\n";
}
elsif ($action_type == ACTION_SPLICE)
{
my ($at) = @$action;
print STDERR
"# splicing in group filler cells\n";
}
}
}
sub _action
{
# generate an action for the action stack toplace a node
my ($self, $action, $node, @params) = @_;
# mark the node as already done
delete $node->{_todo};
# mark all children of $node as processed, too, because they will be
# placed at the same time:
$node->_mark_as_placed() if keys %{$node->{children}} > 0;
[ $action, $node, @params ];
}
#############################################################################
# layout the graph
# The general layout routine for the entire graph:
sub layout
{
my $self = shift;
# ( { type => 'force' } )
my $args = $_[0];
# ( type => 'force' )
$args = { @_ } if @_ > 1;
my $type = 'adhoc';
$type = 'force' if $args->{type} && $args->{type} eq 'force';
# protect the layout with a timeout, unless run under the debugger:
eval {
local $SIG{ALRM} = sub { die "layout did not finish in time\n" };
alarm(abs( $args->{timeout} || $self->{timeout} || 5))
unless defined $DB::single; # no timeout under the debugger
print STDERR "#\n# Starting $type-based layout.\n" if $self->{debug};
# Reset the sequence of the random generator, so that for the same
# seed, the same layout will occur. Both for testing and repeatable
# layouts based on max score.
srand($self->{seed});
if ($type eq 'force')
{
require Graph::Easy::Layout::Force;
$self->error("Force-directed layouts are not yet implemented.");
$self->_layout_force();
}
else
{
$self->_edges_into_groups();
$self->_layout();
}
}; # eval {}; -- end of timeout protected code
alarm(0); # disable alarm
# cleanup
$self->{chains} = undef; # drop chain info
foreach my $n (ord_values ( $self->{nodes} ), ord_values ( $self->{groups} ))
{
# drop old chain info
$n->{_next} = undef;
delete $n->{_chain};
delete $n->{_c};
}
delete $self->{_root};
die $@ if $@; # propagate errors
}
sub _drop_caches
{
# before the layout phase, we drop cached information from the last run
my $self = shift;
for my $n (ord_values ( $self->{nodes} ))
{
# XXX after we laid out the individual groups:
# skip nodes that are not part of the current group
#next if $n->{group} && !$self->{graph};
# empty the cache of computed values (flow, label, border etc)
$n->{cache} = {};
$n->{x} = undef; $n->{y} = undef; # mark every node as not placed yet
$n->{w} = undef; # force size recalculation
$n->{_todo} = undef; # mark as todo
}
for my $g (ord_values ( $self->{groups} ))
{
$g->{x} = undef; $g->{y} = undef; # mark every group as not placed yet
$g->{_todo} = undef; # mark as todo
}
}
sub _layout
{
my $self = shift;
###########################################################################
# do some assorted stuff beforehand
print STDERR "# Doing layout for ",
(defined $self->{name} ? 'group ' . $self->{name} : 'main graph'),
"\n" if $self->{debug};
# XXX TODO:
# for each primary group
# my @groups = $self->groups_within(0);
#
# if (@groups > 0 && $self->{debug})
# {
# print STDERR "# Found the following top-level groups:\n";
# for my $g (@groups)
# {
# print STDERR "# $g $g->{name}\n";
# }
# }
#
# # layout each group on its own, recursively:
# foreach my $g (@groups)
# {
# $g->_layout();
# }
# finally assembly everything together
$self->_drop_caches();
local $_; $_->_grow() for ord_values ( $self->{nodes} );
$self->_assign_ranks();
# find (longest possible) chains of nodes to "straighten" graph
my $root = $self->_find_chains();
###########################################################################
# prepare our stack of things we need to do before we are finished
# action stack, place root 1st if it is known
my @todo = $self->_action( ACTION_NODE, $root, 0 ) if ref $root;
if ($self->{debug})
{
print STDERR "# Generated the following chains:\n";
for my $chain (
sort { $a->{len} <=> $b->{len} || $a->{start}->{name} cmp $b->{start}->{name} }
values %{$self->{chains}})
{
$chain->dump(' ');
}
}
# mark all edges as unprocessed, so that we do not process them twice
for my $edge (ord_values ( $self->{edges} ))
{
$edge->_clear_cells();
$edge->{_todo} = undef; # mark as todo
}
# XXX TODO:
# put all chains on heap (based on their len)
# take longest chain, resolve it and all "connected" chains, repeat until
# heap is empty
for my $chain (sort {
# chain starting at root first
(($b->{start} == $root) <=> ($a->{start} == $root)) ||
# longest chains first
($b->{len} <=> $a->{len}) ||
# chains on nodes that do have an origin come later
(defined($a->{start}->{origin}) <=> defined ($b->{start}->{origin})) ||
# last resort, sort on name of the first node in chain
($a->{start}->{name} cmp $b->{start}->{name})
} values %{$self->{chains}})
{
print STDERR "# laying out chain $chain->{id} (len $chain->{len})\n" if $self->{debug};
# layout the chain nodes, then resolve inter-chain links, then traverse
# chains recursively
push @todo, @{ $chain->layout() } unless $chain->{_done};
}
print STDERR "# Done laying out all chains, doing left-overs:\n" if $self->{debug};
$self->_dump_stack(@todo) if $self->{debug};
# After laying out all chained nodes and their links, we need to resolve
# left-over edges and links. We do this for each node, and then for each of
# its edges, but do the edges shortest-first.
for my $n (ord_values ( $self->{nodes} ))
{
push @todo, $self->_action( ACTION_NODE, $n, 0 ); # if exists $n->{_todo};
# gather to-do edges
my @edges = ();
for my $e (sort { $a->{to}->{name} cmp $b->{to}->{name} } values %{$n->{edges}})
# for my $e (ord_values ( $n->{edges} ))
{
# edge already done?
next unless exists $e->{_todo};
# skip links from/to groups
next if $e->{to}->isa('Graph::Easy::Group') ||
$e->{from}->isa('Graph::Easy::Group');
push @edges, $e;
delete $e->{_todo};
}
# XXX TODO: This does not work, since the nodes are not yet laid out
# sort them on their shortest distances
# @edges = sort { $b->_distance() <=> $a->_distance() } @edges;
# put them on the action stack in that order
for my $e (@edges)
{
push @todo, [ ACTION_TRACE, $e ];
# print STDERR "do $e->{from}->{name} to $e->{to}->{name} ($e->{id} " . $e->_distance().")\n";
# push @todo, [ ACTION_CHAIN, $e->{to}, 0, $n, $e ];
}
}
print STDERR "# Done laying out left-overs.\n" if $self->{debug};
# after laying out all inter-group nodes and their edges, we need to splice in the
# group cells
if (scalar $self->groups() > 0)
{
push @todo, [ ACTION_SPLICE ] if scalar $self->groups();
# now do all group-to-group and node-to-group and group-to-node links:
for my $n (ord_values ( $self->{groups} ))
{
}
}
$self->_dump_stack(@todo) if $self->{debug};
###########################################################################
# prepare main backtracking-loop
my $score = 0; # overall score
$self->{cells} = { }; # cell array (0..x,0..y)
my $cells = $self->{cells};
print STDERR "# Start\n" if $self->{debug};
$self->{padding_cells} = 0; # set to false (no filler cells yet)
my @done = (); # stack with already done actions
my $step = 0;
my $tries = 16;
# store for each rank the initial row/coluumn
$self->{_rank_pos} = {};
# does rank_pos store rows or columns?
$self->{_rank_coord} = 'y';
my $flow = $self->flow();
$self->{_rank_coord} = 'x' if $flow == 0 || $flow == 180;
TRY:
while (@todo > 0) # all actions on stack done?
{
$step ++;
if ($self->{debug} && ($step % 1)==0)
{
my ($nodes,$e_nodes,$edges,$e_edges) = $self->_count_done_things();
print STDERR "# Done $nodes nodes and $edges edges.\n";
#$self->{debug} = 2 if $nodes > 243;
return if ($nodes > 230);
}
# pop one action and mark it as done
my $action = shift @todo; push @done, $action;
# get the action type (ACTION_NODE etc)
my $action_type = $action->[0];
my ($src, $dst, $mod, $edge);
if ($action_type == ACTION_NODE)
{
my (undef, $node,$try,$edge) = @$action;
print STDERR "# step $step: action place '$node->{name}' (try $try)\n" if $self->{debug};
$mod = 0 if defined $node->{x};
# $action is node to be placed, generic placement at "random" location
$mod = $self->_find_node_place( $node, $try, undef, $edge) unless defined $node->{x};
}
elsif ($action_type == ACTION_CHAIN)
{
my (undef, $node,$try,$parent, $edge) = @$action;
print STDERR "# step $step: action chain '$node->{name}' from parent '$parent->{name}'\n" if $self->{debug};
$mod = 0 if defined $node->{x};
$mod = $self->_find_node_place( $node, $try, $parent, $edge ) unless defined $node->{x};
}
elsif ($action_type == ACTION_TRACE)
{
# find a path to the target node
($action_type,$edge) = @$action;
$src = $edge->{from}; $dst = $edge->{to};
print STDERR "# step $step: action trace '$src->{name}' => '$dst->{name}'\n" if $self->{debug};
if (!defined $dst->{x})
{
# warn ("Target node $dst->{name} not yet placed");
$mod = $self->_find_node_place( $dst, 0, undef, $edge );
}
if (!defined $src->{x})
{
# warn ("Source node $src->{name} not yet placed");
$mod = $self->_find_node_place( $src, 0, undef, $edge );
}
# find path (mod is score modifier, or undef if no path exists)
$mod = $self->_trace_path( $src, $dst, $edge );
}
elsif ($action_type == ACTION_SPLICE)
{
# fill in group info and return
$self->_fill_group_cells($cells) unless $self->{error};
$mod = 0;
}
else
{
require Carp;
Carp::confess ("Illegal action $action->[0] on TODO stack");
}
if (!defined $mod)
{
# rewind stack
if (($action_type == ACTION_NODE || $action_type == ACTION_CHAIN))
{
print STDERR "# Step $step: Rewind stack for $action->[1]->{name}\n" if $self->{debug};
# undo node placement and free all cells
$action->[1]->_unplace() if defined $action->[1]->{x};
$action->[2]++; # increment try for placing
$tries--;
last TRY if $tries == 0;
}
else
{
print STDERR "# Step $step: Rewind stack for path from $src->{name} to $dst->{name}\n" if $self->{debug};
# if we couldn't find a path, we need to rewind one more action (just
# redoing the path would would fail again!)
# unshift @todo, pop @done;
# unshift @todo, pop @done;
# $action = $todo[0];
# $action_type = $action->[0];
# $self->_dump_stack(@todo);
#
# if (($action_type == ACTION_NODE || $action_type == ACTION_CHAIN))
# {
# # undo node placement
# $action->[1]->_unplace();
# $action->[2]++; # increment try for placing
# }
$tries--;
last TRY if $tries == 0;
next TRY;
}
unshift @todo, $action;
next TRY;
}
$score += $mod;
print STDERR "# Step $step: Score is $score\n\n" if $self->{debug};
}
$self->{score} = $score; # overall score
# if ($tries == 0)
{
my ($nodes,$e_nodes,$edges,$e_edges) = $self->_count_done_things();
if ( ($nodes != $e_nodes) ||
($edges != $e_edges) )
{
$self->warn( "Layouter could only place $nodes nodes/$edges edges out of $e_nodes/$e_edges - giving up");
}
else
{
$self->_optimize_layout();
}
}
# all things on the stack were done, or we encountered an error
}
sub _count_done_things
{
my $self = shift;
# count placed nodes
my $nodes = 0;
my $i = 1;
for my $n (ord_values ( $self->{nodes} ))
{
$nodes++ if defined $n->{x};
}
my $edges = 0;
$i = 1;
# count fully routed edges
for my $e (ord_values ( $self->{edges} ))
{
$edges++ if scalar @{$e->{cells}} > 0 && !exists $e->{_todo};
}
my $e_nodes = scalar keys %{$self->{nodes}};
my $e_edges = scalar keys %{$self->{edges}};
return ($nodes,$e_nodes,$edges,$e_edges);
}
my $size_name = {
EDGE_HOR() => [ 'cx', 'x' ],
EDGE_VER() => [ 'cy', 'y' ]
};
sub _optimize_layout
{
my $self = shift;
# optimize the finished layout
my $all_cells = $self->{cells};
###########################################################################
# for each edge, compact HOR and VER stretches of cells
for my $e (ord_values ( $self->{edges} ))
{
my $cells = $e->{cells};
# there need to be at least two cells for us to be able to combine them
next if @$cells < 2;
print STDERR "# Compacting edge $e->{from}->{name} to $e->{to}->{name}\n"
if $self->{debug};
my $f = $cells->[0]; my $i = 1;
my ($px, $py); # coordinates of the placeholder cell
while ($i < @$cells)
{
my $c = $cells->[$i++];
# print STDERR "# at $f->{type} $f->{x},$f->{y} (next: $c->{type} $c->{x},$c->{y})\n";
my $t1 = $f->{type} & EDGE_NO_M_MASK;
my $t2 = $c->{type} & EDGE_NO_M_MASK;
# > 0: delete that cell: 1 => reverse order, 2 => with hole
my $delete = 0;
# compare $first to $c
if ($t1 == $t2 && ($t1 == EDGE_HOR || $t1 == EDGE_VER))
{
# print STDERR "# $i: Combining them.\n";
# check that both pieces are continues (e.g. with a cross section,
# the other edge has a hole in the cell array)
# if the second cell has a misc (label, short) flag, carry it over
$f->{type} += $c->{type} & EDGE_MISC_MASK;
# which size/coordinate to modify
my ($m,$co) = @{ $size_name->{$t1} };
# print STDERR "# Combining edge cells $f->{x},$f->{y} and $c->{x},$c->{y}\n";
# new width/height is the combined size
$f->{$m} = ($f->{$m} || 1) + ($c->{$m} || 1);
# print STDERR "# Result $f->{x},$f->{y} ",$f->{cx}||1," ", $f->{cy}||1,"\n";
# drop the reference from the $cells array for $c
delete $all_cells->{ "$c->{x},$c->{y}" };
($px, $py) = ($c->{x}, $c->{y});
if ($f->{$co} > $c->{$co})
{
# remember coordinate of the moved cell for the placeholder
($px, $py) = ($f->{x}, $f->{y});
# move $f to the new place if it was modified
delete $all_cells->{ "$f->{x},$f->{y}" };
# correct start coordinate for reversed order
$f->{$co} -= ($c->{$m} || 1);
$all_cells->{ "$f->{x},$f->{y}" } = $f;
}
$delete = 1; # delete $c
}
# remove that cell, but start combining at next
# print STDERR "# found hole at $i\n" if $c->{type} == EDGE_HOLE;
$delete = 2 if $c->{type} == EDGE_HOLE;
if ($delete)
{
splice (@{$e->{cells}}, $i-1, 1); # remove from the edge
if ($delete == 1)
{
my $xy = "$px,$py";
# replace with placeholder (important for HTML output)
$all_cells->{$xy} = Graph::Easy::Edge::Cell::Empty->new (
x => $px, y => $py,
) unless $all_cells->{$xy};
$i--; $c = $f; # for the next statement
}
else { $c = $cells->[$i-1]; }
}
$f = $c;
}
# $i = 0;
# while ($i < @$cells)
# {
# my $c = $cells->[$i];
# print STDERR "# $i: At $c->{type} $c->{x},$c->{y} ", $c->{cx}||1, " ", $c->{cy} || 1,"\n";
# $i++;
# }
}
print STDERR "# Done compacting edges.\n" if $self->{debug};
}
1;
__END__
=head1 NAME
Graph::Easy::Layout - Layout the graph from Graph::Easy
=head1 SYNOPSIS
use Graph::Easy;
my $graph = Graph::Easy->new();
my $bonn = Graph::Easy::Node->new(
name => 'Bonn',
);
my $berlin = Graph::Easy::Node->new(
name => 'Berlin',
);
$graph->add_edge ($bonn, $berlin);
$graph->layout();
print $graph->as_ascii( );
# prints:
# +------+ +--------+
# | Bonn | --> | Berlin |
# +------+ +--------+
=head1 DESCRIPTION
C<Graph::Easy::Layout> contains just the actual layout code for
L<Graph::Easy|Graph::Easy>.
=head1 METHODS
C<Graph::Easy::Layout> injects the following methods into the C<Graph::Easy>
namespace:
=head2 layout()
$graph->layout();
Layout the actual graph.
=head2 _assign_ranks()
$graph->_assign_ranks();
Used by C<layout()> to assign each node a rank, so they can be sorted
and grouped on these.
=head2 _optimize_layout
Used by C<layout()> to optimize the layout as a last step.
=head1 EXPORT
Exports nothing.
=head1 SEE ALSO
L<Graph::Easy>.
=head1 AUTHOR
Copyright (C) 2004 - 2008 by Tels L<http://bloodgate.com>
See the LICENSE file for information.
=cut