#  Copyright (c) 1997-2004
#  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: visual_graph.rules,v 1.55 2004/11/23 20:58:05 gawrilow Exp $


package Visual::PolytopeGraph;

use Struct(
   [ '@ISA' => 'Visual::Graph' ],
   '$Polytope',
);

# In the spring embedding of the graph with a superposed linear objective function,
# controls the relative force magnitude along the z-axis
custom $embedding_objective_factor=2.5;


# args: [ LPobject ]
# Illustrate the behavior of a linear objective function on the polytope.
# Color the nodes according to the value the objective function takes
# on the vertices (@see Polytope.VERTEX_COLORS)
# 
# The spring embedder applies an additional force, which tries to arrange the nodes in the z-axis direction
# corresponding to the objective function values.
#
# The optional parameter @a LPobject is introduced for the future use, when
# it will be possible to store several objective function in a @c Polytope object.

user_method VERTEX_COLORS {
   my ($this, $lp)=@_;
   $lp ||= $this->Polytope;
   $this->NodeColor=$lp->VERTEX_COLORS;
   if (UNIVERSAL::isa(my $coord=$this->Coord, "Visual::LazyEmbedding")) {
      $coord->push(objective => "LINEAR_OBJECTIVE", "objective-factor" => $embedding_objective_factor);
   }
   visualize($this);
}


# args: [ LPobject ]
# Illustrate the behavior of a linear objective function on the polytope.
# The vertices belonging to @see MINIMAL_FACE and @see MAXIMAL_FACE are drawn in distinct colors
# (by default red and yellow).
# 
# The spring embedder applies an additional force, which tries to arrange the nodes in the z-axis direction
# corresponding to the objective function values.
#
# The optional parameter @a LPobject is introduced for the future use, when
# it will be possible to store several objective function in a @c Polytope object.

user_method MIN_MAX_FACE {
   my ($this, $lp)=@_;
   $lp ||= $this->Polytope;
   my ($maximal_face, $minimal_face)=($lp->MAXIMAL_FACE, $lp->MINIMAL_FACE);
   my %colors;
   $colors{$_}=$Visual::Color::max for $maximal_face =~ /\d+/g;
   $colors{$_}=$Visual::Color::min for $minimal_face =~ /\d+/g;
   $this->NodeColor=\%colors;
   if (UNIVERSAL::isa(my $coord=$this->Coord, "Visual::LazyEmbedding")) {
      $coord->push(objective => "LINEAR_OBJECTIVE", "objective-factor" => $embedding_objective_factor);
   }
   visualize($this);
}

# args: [ LPobject ]
# Show the growth direction of a linear objective function via arrowed edges.
#
# The optional parameter @a LPobject is introduced for the future use, when
# it will be possible to store several objective function in a @c Polytope object.

user_method DIRECTED_GRAPH {
   my ($this, $lp)=@_;
   $lp ||= $this->Polytope;
   $this->Graph=$lp->DIRECTED_GRAPH;
   $this->Directed=1;
   visualize($this);
}


###########################################################################################
object Polytope;

# category: Visualization
# Visualize the @see GRAPH of a polyhedron.
# return: Visual::PolytopeGraph

user_method VISUAL_GRAPH(%Visual::Graph::decorations) {
   my ($this, $decor)=@_;
   visualize( new Visual::PolytopeGraph(
      Polytope => $this,
      Name => "GRAPH of " . $this->name,
      Graph => $this->GRAPH,
      NodeLabels => $this->lookup("VERTEX_LABELS"),
      Coord => spring_embedding_3d($this, "GRAPH"),
      $decor,
   ));
}


# category: Visualization
# Visualize the @see DUAL_GRAPH of a polyhedron.
# return: Visual::Graph

user_method VISUAL_DUAL_GRAPH(%Visual::Graph::decorations) {
   my ($this, $decor)=@_;
   visualize( new Visual::Graph(
      Name => "DUAL_GRAPH of " . $this->name,
      Graph => $this->DUAL_GRAPH,
      NodeLabels => $this->lookup("FACET_LABELS"),
      Coord => spring_embedding_3d($this, "DUAL_GRAPH"),
      $decor,
   ));
}


# category: Visualization
# Visualize the @see BOUNDED_GRAPH of a polyhedron.
# return: Visual::PolytopeGraph

user_method VISUAL_BOUNDED_GRAPH(%Visual::Graph::decorations) {
   my ($this, $decor)=@_;
   my $labels=$this->lookup("VERTEX_LABELS");
   my @indices=map { /\((\d+)/ } @{$this->BOUNDED_GRAPH};

   visualize( new Visual::PolytopeGraph(
      Name => "BOUNDED_GRAPH of " . $this->name,
      Graph => $this->BOUNDED_GRAPH,
      Coord => spring_embedding_3d($this, "BOUNDED_GRAPH", "skip-node-attr", undef),
      NodeLabels => $labels ? subset(split_labels($labels), @indices) : \@indices,
      $decor,
   ));
}


#########################################################################################
#
#  Face lattice visualization
#
package Visual::Lattice;

use Struct(
   [ '@ISA' => 'Visual::Graph' ],
   '$Polytope',
   '$top_node',
);

sub prepare_vertex_labels {
   my ($P, $label_prop_name)=@_;
   my $vertex_labels=$P->lookup($label_prop_name);
   my @vertex_labels= defined($vertex_labels) ? split /\s+/, $vertex_labels : ();
   my $n=0;  foreach (@vertex_labels) { s/^_.*/\#$n/; ++$n; }
   return @vertex_labels;
}

# args: [ LPobject ]
# Illustrate the behavior of a linear objective function on the polytope.
# Draw the filters of the @see MAXIMAL_FACE and @see MINIMAL_FACE in distinguished colors
# (by default, red and yellow).
#
# The optional parameter @a LPobject is introduced for the future use, when
# it will be possible to store several objective function in a @c Polytope object.

user_method MIN_MAX_FACE {
   my ($this, $lp)=@_;
   $lp ||= $this->Polytope;

   my $labels=$this->NodeLabels;
   my $top_node=$this->top_node;
   my @vertex_labels=prepare_vertex_labels($this->Polytope, "VERTEX_LABELS");

   my ($max_filter, $min_filter)=map {
      if (defined($_)) {
	 s/\{([^{}]*).*/$1/g;
	 s/(\d+)\s+/(?:$1(?:\\s+|\$))?/g;
	 s/(\d+)$/(?:$1)?/;
	 if (@vertex_labels) {
	    s/(\d+)/\Q$vertex_labels[$1]\E/g;
	 }
	 qr/^$_$/;
      } else {
	 qr/^-$/;
      }
   } $lp->MAXIMAL_FACE, $lp->MINIMAL_FACE;
   $this->NodeColor=sub {
      $_[0] == $top_node
      ? "0 0 0"
      : do {
	 my $label=$labels->[$_[0]];
	 $label =~ $max_filter
	 ?  "border $Visual::Color::max" :
	 $label =~ $min_filter
	 ?  "border $Visual::Color::min"
	 :  "border 0 0 0"
      }
   };
   $this->EdgeColor=sub {
      my ($t)=$_[0]->incident_nodes;
      my $label=$labels->[$t];
      $label =~ $max_filter
      ?  $Visual::Color::max :
      $label =~ $min_filter
      ?  $Visual::Color::min
      :  $Visual::Color::graph;
   };
   visualize($this);
}

#########################################################################################

object Polytope;

# category: Visualization
# Visualize the @see HASSE_DIAGRAM of a polyhedron as a multi-layer graph.
# return: Visual::Lattice

user_method VISUAL_FACE_LATTICE() {
   my ($this)=@_;
   my ($dims, @graph)=@{$this->HASSE_DIAGRAM};
   $graph[0] =~ s/^\s*<//;  pop @graph;
   my ($bottom_node, $top_node)= $graph[0] =~ /\Q({}\E/ ? (0, $#graph) : ($#graph, 0);

   my @vertex_labels=Visual::Lattice::prepare_vertex_labels($this, "VERTEX_LABELS");
   my @labels=("")x@graph;

   my $n=1;
   foreach (@graph[1..$#graph-1]) {	# unless top/bottom node
      s/\{(.*?)\}\s+//;  my $label=$1;
      if (@vertex_labels) {
	 $label =~ s/(\d+)/$vertex_labels[$1]/g;
      }
      $labels[$n]=$label;
      ++$n;
   }

   $labels[$top_node]=$labels[$bottom_node]=" ";
   $graph[$top_node]="";

   visualize( new Visual::Lattice(
      Name => "Face lattice of ".$this->name,
      Polytope => $this,
      Graph => \@graph,
      top_node => $top_node,
      Directed => -1,
      NodeLabels => \@labels,
      NodeColor => { $top_node => "0 0 0" },
      NodeStyle => "face",
      Coord => hd_embedding($this, "HASSE_DIAGRAM"),
   ));
}


# category: Visualization
# Visualize the @see DUAL_FACE_LATTICE of a polyhedron as a multi-layer graph.
# return: Visual::Lattice

user_method VISUAL_DUAL_FACE_LATTICE() {
   my ($this)=@_;
   my ($dims, @graph)=@{$this->HASSE_DIAGRAM};
   $graph[0] =~ s/^\s*<//;  pop @graph;
   my @dims=split /\s+/, $dims;

   my @facet_labels=Visual::Lattice::prepare_vertex_labels($this, "FACET_LABELS");
   my @dual_labels=(undef)x@graph;
   my @labels=("")x@graph;

   my ($d_first, $d_last, $d_step, $bottom_node, $top_node)= $graph[0] =~ /\Q({}\E/
    ? (  -2,    -$#dims-2,  -1,        0,         $#graph)
    : (   0,     $#dims,     1,     $#graph,         0);

   for (my $d=$d_first; $d != $d_last;  $d+=$d_step) {
      foreach my $n ($dims[$d] .. $dims[$d+1]-1) {
	 $graph[$n] =~ s/\{.*?\}\s+//;
	 foreach my $to ($graph[$n] =~ /\d+/g) {
	    @{$dual_labels[$n]}{keys %{$dual_labels[$to]}}=();
	 }
         if (! keys %{$dual_labels[$n]}) {
	    $dual_labels[$n]->{$n-$dims[$d_first]}=1;
	 }
	 my $label=join(" ", sort { $a <=> $b } keys %{$dual_labels[$n]});
	 if (@facet_labels) {
	    $label =~ s/(\d+)/$facet_labels[$1]/g;
	 }
	 $labels[$n]=$label;
      }
   }

   $labels[$top_node]=$labels[$bottom_node]=" ";
   $graph[$top_node]="";
   visualize( new Visual::Lattice(
      Name => "Dual face lattice of ".$this->name,
      Polytope => $this,
      Graph => \@graph,
      top_node => $top_node,
      Directed => 1,
      NodeLabels => \@labels,
      NodeColor => { $top_node => "0 0 0" },
      NodeStyle => "face",
      Coord => hd_embedding($this, "HASSE_DIAGRAM"),
   ));
}


# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
