#  Copyright (c) 1997-2006
#  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: tight_span.rules 7533 2006-12-20 23:55:58Z gawrilow $

# Bounded subcomplex of an unbounded polyhedron, which is associated with a finite metric space.
# The tight span is 1-dimensional if and only if the metric is tree-like.  In this sense, the tight
# span captures the deviation of the metric from a tree-like one.

object TightSpan : RationalPolytope


# category: Phylogenetic Analysis
# Finite metric space encoded as a (symmetric) distance matrix.
#
property METRIC
$type="matrix";


# category: Phylogenetic Analysis
# Labels for the rows and columns of the @see METRIC space.
# Default TAXA are just consecutive numbers.
#
property TAXA
$type="array<label>";


# category: Phylogenetic Analysis
# Row indices in the METRIC matrix or -1
property VERTICES_IN_METRIC
$type="array<integer>";
$apply_diff{VERTICES}=\&permute_elements;


# category: Phylogenetic Analysis
# Colors to distinguish the taxa in the bounded graph from the non-taxum-vertices.
#
property NODE_COLORS
$type="array<RGB>";
$temporary=1;

INEQUALITIES : METRIC
   client("metric2poly", $this);

TAXA : METRIC
   my $n=$#{$this->METRIC};
   my @taxa=0..$n;
   $this->TAXA="@taxa\n";

VERTICES_IN_METRIC : METRIC, VERTICES, N_VERTICES
   my $i=0;
   my %metric= map { chomp; s/\s{2,}/ /g; $_ => $i++ } convert_to_rational($this->METRIC);
   my @metric_indices=(-1) x $this->N_VERTICES;
   $i=0;
   foreach (@{$this->VERTICES}) {
      if (/^\s*1\s+(.*)/  and  defined (my $index=$metric{$1})) {
         $metric_indices[$i]=$index;
      }
      ++$i;
   }
   $this->VERTICES_IN_METRIC="@metric_indices\n";

VERTEX_LABELS : TAXA, VERTICES_IN_METRIC
   my @taxa= split /\s+/, $this->TAXA;
   my @labels=map { $_>=0 ? $taxa[$_] : "_" } $this->VERTICES_IN_METRIC =~ /\S+/g;
   $this->VERTEX_LABELS="@labels\n";


NODE_COLORS : BOUNDED_GRAPH, VERTICES_IN_METRIC
   my @metric_indices=$this->VERTICES_IN_METRIC =~ /\S+/g;
   my @indices=map { /\((\d+)/ } @{$this->BOUNDED_GRAPH};
   $this->NODE_COLORS=[ map { $metric_indices[$_]>=0 ? $Visual::Color::vertices : $Visual::Color::non_tax_vertices }
			@indices ];


EDGE_COLORED_BOUNDED_GRAPH : HASSE_DIAGRAM, FAR_FACE, DIM
WEIGHT 4.10
  client("edge_colored_bounded_graph", $this, "EDGE_COLORED_BOUNDED_GRAPH", "HASSE_DIAGRAM", "FAR_FACE", $this->DIM/2)


# category: Visualization
# This is a variation of @see VISUAL_BOUNDED_GRAPH for the special case of a tight span.
# The tropical vertices are embedded according to the @see METRIC, the others are hanged in between.
# option: seed => random seed value for the string embedder
# option: norm => which norm to use when calculating the distances between metric vectors (max | square)
# return: Visual::Graph

user_method VISUAL_TIGHT_SPAN({ norm => enum("max=default", "square"), seed => undef }) {
   my ($this, $options)=@_;
   my $BG=$this->BOUNDED_GRAPH;
   my @indices=map { /\((\d+)/ } @$BG;
   my @metric=map { [ /\S+/g ] } @{$this->METRIC};
   my @metric_indices=$this->VERTICES_IN_METRIC =~ /\S+/g;
   my (@tentacles, @tentacle_graph);
   for (my $i=0; $i<=$#$BG; ++$i) {
      if ((my $t=$metric_indices[$indices[$i]])>=0  and  $BG->[$i] =~ /\{\s*\d+\s*\}/) {
	 push @tentacles, $indices[$i];
	 push @tentacle_graph, [ ];
	 my $m=$metric[$t];
	 for (my $j=0; $j<$#tentacle_graph; ++$j) {
	    my $edge=$m->[$metric_indices[$tentacles[$j]]];
	    push @{$tentacle_graph[$j]}, "($#tentacles $edge)";
	    push @{$tentacle_graph[-1]}, "($j $edge)";
	 }
      }
   }
   $_="{@$_}\n" for @tentacle_graph;
   my @coord;
   my @seed= defined $options->{seed} ? ("seed", $options->{seed}) : ();
   my @norm= $options->{norm} eq "max" ? ("-max") : ();
   client("bounded_embedder", $this, "BOUNDED_GRAPH", "VERTICES", [ "{@tentacles}\n" ],
 	  spring_embedding_3d($this, \@tentacle_graph, "read-edge-weights", undef, @seed), \@coord, @norm);

   my $labels=$this->VERTEX_LABELS;
   my $Graph=new Visual::Graph( Name => "Tight Span - " . $this->name,
				Graph => $this->BOUNDED_GRAPH,
				Coord => \@coord,
				NodeLabels => $labels ? subset(split_labels($labels), @indices) : \@indices,
				NodeColor => $this->NODE_COLORS,
			      );
   visualize($Graph);
}

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

user_method VISUAL_BOUNDED_GRAPH(%Visual::Graph::decorations) {
   my ($this, $decor)=@_;
   $this->SUPER::VISUAL_BOUNDED_GRAPH(NodeColor => $this->NODE_COLORS, $decor);
}

package Visual::PolytopeGraph;

# produce an edge coloring of a bounded graph from local data in the Hasse diagram

user_method EDGE_COLORS {
   my ($self)=@_;
   die "method EDGE_COLORS is only applicable to BOUNDED_GRAPH, not to the whole graph!\n" unless $self->VertexSubset;
   my $G=$self->basis_graph;
   my $ts=$self->Polytope;
   my @colored_graph = @{$ts->EDGE_COLORED_BOUNDED_GRAPH};
   my $dim = $ts->DIM/2;
   my @dim_colors = (1..$dim);
   map { 
        my $red = int (($dim-$_)*255/($dim-1));
	$_ = "$red 0 ".(255 - $red);
   } @dim_colors;
   my %edge_colors;
   my $i = 0;
   foreach my $line (@colored_graph) {
      my @neighbors = ($line =~ m/\((\d+\s+\d+)\)/g);
      foreach(@neighbors) {
         my ($to_node, $color) = m/(\d+)\s+(\d+)/;
         $edge_colors{"$i $to_node"} = $dim_colors[$color-1];
         $edge_colors{"$to_node $i"} = $dim_colors[$color-1];
      }
      ++$i;
   }
   $G->merge( EdgeColor => \%edge_colors );
   visualize($self);
}

package Visual::Color;

# Color for the vertices of a tight span not corresponding to taxa
custom $non_tax_vertices="255 255 0";



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