#  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: