# Copyright (c) 1997-2007
# Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
# http://www.math.tu-berlin.de/polymake, mailto:polymake@math.tu-berlin.de
#
# 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, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# 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.
#-----------------------------------------------------------------------------
# $Project: polymake $$Id: VisualGraph.pm 7578 2007-01-21 22:48:26Z gawrilow $
##############################################################################
#
# This is an intermediate layer between the concrete graph representation
# as a polymake property and the graph description in an application-specific
# format (such as GML for graphlet or JVX for javaview)
#
##############################################################################
package Visual::Graph;
use Struct (
[ '@ISA' => 'Visual::Object' ],
# \@list - graph in polymake format, may have node and/or edge attributes
[ '$Graph' => 'unify_graph(#%)', default => 'croak("Graph missing")' ],
# boolean
'$Directed',
# Graph embedding in R^2 or R^3:
# [ "x y [z]", ... ] - coordinates of nodes
# or Visual::Embedding object - if lazy
[ '$Vertices | Coord' => 'check_points(#%)' ],
# see PointLabels in Visual::PointSet
[ '$VertexLabels | NodeLabels' => 'unify_labels(#%)', default => 'undef' ],
# the same formats as for PointColor in Visual::PointSet
# Some viewers (for example, PostScript, Graphlet) can draw node boxes either filled (default)
# or white with colored border. The latter is chosen if the color value starts
# with the keyword "border".
[ '$VertexColor | NodeColor' => 'unify_decor(#%)', merge => '$this->merge_decor(#%)', default => '$Visual::Color::vertices' ],
# the same formats as for PointStyle in Visual::PointSet
# recognized styles are:
# "thickness N" node box border width
# "hidden" draw neither node boxes nor the labels
# other possible style keywords are documented in the viewer packages (for example, Graphlet.pm)
[ '$VertexStyle | NodeStyle' => 'unify_decor(#%)', merge => '$this->merge_decor(#%)' ],
# boolean: when looking for edge color and style, whether to try the reverse edge
# if the straight lookup fails
[ '$EdgeStyleSymmetric' => '!$this->Directed' ],
# "R G B" the same color for all edges
# or [ "R G B", ... ] indexed by source node number
# or { node => "R G B" } keyed by source node number
# or { "node node" => "R G B" } keyed by incident node numbers
# or sub { ... } edge_iterator -> "R G B"
[ '$EdgeColor' => '$this->unify_edge_decor(#%)', merge => '$this->merge_edge_decor(#%)', default => '$Visual::Color::edges' ],
# the same formats as for EdgeColor
# recognized styles are:
# "thickness N" the edge line width
# as well as other viewer-specific keywords
[ '$EdgeStyle' => '$this->unify_edge_decor(#%)', merge => '$this->merge_edge_decor(#%)' ],
# boolean: don't show the object at the session start (for interactive viewers)
'$Hidden',
);
# publicly accessible attributes
declare %decorations=( VertexLabels => enum('hidden'), NodeLabels => enum('hidden') );
@decorations{qw( Name Title NodeColor NodeStyle VertexColor VertexStyle EdgeColor EdgeStyle Hidden )}=();
##############################################################################
my $strip_node_attr=qr{ ^\s* \( .*? (\{.*\}) \s* \) \s*$ }x;
my $adj_nodes_with_attrs=qr{ \( (\d*) }x;
my $adj_nodes_without_attrs=qr{ \d+ }x;
sub unify_graph {
my ($name, $G)=@_;
if (!is_array($G)) {
croak( "$name must be an array" );
}
# get rid of all attributes
if (@$G && !is_array($G->[0]) && !is_object($G->[0])) {
my $adj_nodes;
$G=[ map {
my $inc=$_;
$inc =~ s/$strip_node_attr/$1/;
$adj_nodes ||= $inc =~ /\(/ ? $adj_nodes_with_attrs : $adj_nodes_without_attrs;
[ $inc =~ m{$adj_nodes}g ]
} @$G ];
}
$G;
}
##############################################################################
sub unify_edge_decor : method {
my ($self, $attr, $get_decor)=@_;
if (is_code($get_decor) || !ref($get_decor)) {
$get_decor
} elsif (is_array($get_decor)) {
if ($self->EdgeStyleSymmetric>0) {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->[$s] || $get_decor->[$t]
}
} elsif ($self->EdgeStyleSymmetric<0) {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->[$s] || -$get_decor->[$t]
}
} else {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->[$s]
}
}
} else { # is_hash($get_decor)
if ($self->EdgeStyleSymmetric>0) {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->{"$s $t"} || $get_decor->{"$t $s"} || $get_decor->{$s} || $get_decor->{$t}
}
} elsif ($self->EdgeStyleSymmetric<0) {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->{"$s $t"} || -$get_decor->{"$t $s"} || $get_decor->{$s} || -$get_decor->{$t}
}
} else {
sub {
my ($s,$t)=(shift)->incident_nodes;
$get_decor->{"$s $t"} || $get_decor->{$s}
}
}
}
}
##############################################################################
sub merge_edge_decor : method {
my ($self, $attr, $new_decor)=@_;
my $base_decor=$self->$attr;
$new_decor=unify_edge_decor($self, $attr, $new_decor);
if (ref($new_decor)) {
if (ref($base_decor)) {
$self->$attr = sub { $new_decor->($_[0]) || $base_decor->($_[0]) };
} elsif ($base_decor) {
$self->$attr = sub { $new_decor->($_[0]) || $base_decor };
} else {
$self->$attr = $new_decor;
}
} elsif (ref($base_decor)) {
$self->$attr = sub { $base_decor->($_[0]) || $new_decor };
} else {
$self->$attr = $new_decor;
}
}
############################################################################
#
# The rest of the interface are callback functions for the visualization
# program interface. The most of the methods are self-explanatory.
#
############################################################################
# () -> integer
sub get_number_nodes {
my ($self)=@_;
return scalar(@{$self->Graph});
}
# () -> boolean
sub is_embedded {
my ($self)=@_;
return defined($self->Coord);
}
my @edge_iterator=qw( Visual::Graph::undirected_edge_iterator
Visual::Graph::directed_edge_iterator
Visual::Graph::reverse_edge_iterator );
# (node_index) -> iterator
sub get_incident_edges {
my ($self, $n)=@_;
my $iter=$edge_iterator[$self->Directed]->new($n, $self->Graph->[$n]);
$iter;
}
sub get_edge_label { undef }
sub get_all_edges {
my ($self)=@_;
my @edges;
for (my $edge=$self->edges; $edge; ++$edge) {
my ($s, $t)=$edge->incident_nodes;
push @edges, "$s $t";
}
@edges;
}
#################################################################################
sub has_edge {
my ($self, $s, $t)=@_;
my $g=$self->Graph;
$s<=$#$g && $t<=$#$g && binsearch($g->[$s], $t);
}
#################################################################################
#
# edge iterators visit the edges incident to a given node
#
#################################################################################
package Visual::Graph::directed_edge_iterator;
use Struct (
[ new => '$$' ],
[ '$from_node' => '#1' ],
[ '@adjacent' => '#2' ],
[ '$cur' => '0' ],
);
sub clone { my ($self)=@_; inherit_class([ @$self ], $self); }
use overload (
# move to the next edge
'++' => sub { my ($self)=@_; ++$self->cur; $self },
# still edges to visit?
'bool' => sub { my ($self)=@_; $self->cur <= $#{$self->adjacent} },
# copy constructor
'=' => \&clone,
);
sub incident_nodes { # -> (source_node, target_node)
my ($self)=@_;
($self->from_node, $self->adjacent->[$self->cur])
}
#################################################################################
#
# the same as above, but swaps the source and the target nodes
#
#################################################################################
package Visual::Graph::reverse_edge_iterator;
use Struct [ '@ISA' => 'Visual::Graph::directed_edge_iterator' ];
sub incident_nodes { # -> (target_node, source_node)
my ($self)=@_;
($self->adjacent->[$self->cur], $self->from_node)
}
#################################################################################
#
# special case for the undirected graphs: avoids duplication of edges
#
#################################################################################
package Visual::Graph::undirected_edge_iterator;
use Struct [ '@ISA' => 'Visual::Graph::directed_edge_iterator' ];
use overload (
'bool' => sub {
my ($self)=@_;
$self->cur <= $#{$self->adjacent} &&
$self->adjacent->[$self->cur] <= $self->from_node;
},
);
#################################################################################
#
# visiting all edges in the graph
#
#################################################################################
package Visual::Graph::all_edge_iterator;
use Struct (
[ new => '$' ],
[ '$graph' => '#1' ],
'$it',
);
sub init {
my ($self, $n)=@_;
$self->it=$edge_iterator[$self->graph->Directed]->new($n, $self->graph->Graph->[$n]);
}
sub valid_position {
my ($self)=@_;
my ($n, $last);
while (! $self->it) {
$n ||= $self->it->from_node;
$last ||= $self->graph->get_number_nodes;
last if ++$n>=$last;
init($self,$n);
}
}
sub new {
my $self=&_new;
init($self,0);
valid_position($self);
$self;
}
use overload (
# move to the next edge
'++' => sub { my ($self)=@_; ++$self->it; valid_position($self); $self },
# still edges to visit?
'bool' => sub { $_[0]->it },
# copy constructor
'=' => \&Visual::Graph::directed_edge_iterator::clone,
);
sub incident_nodes { $_[0]->it->incident_nodes }
sub Visual::Graph::edges {
new Visual::Graph::all_edge_iterator($_[0]);
}
1
# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1