#  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: tight_span.rules,v 1.14 2004/11/12 13:38:35 gawrilow Exp $

# 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.
#
property TAXA
$type="array<label>";


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


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

VERTEX_LABELS : METRIC, VERTICES, TAXA
  my @taxa= split /\s+/, $this->TAXA;
  my $i=0;
  my %metric= map { chomp; s/\s+/ /g; $_ => $i++ } convert_to_rational($this->METRIC);
  my @labels;
  map {
    /1\s+(.*)/;
    push @labels, exists $metric{$1} ? $taxa[$metric{$1}] : "_";
  } @{$this->VERTICES};
  $this->VERTEX_LABELS="@labels";


NODE_COLORS : METRIC, VERTICES, BOUNDED_GRAPH
   my @indices=map { /\((\d+)/ } @{$this->BOUNDED_GRAPH};
   my %metric=map { chomp; s/\s+/ /g; $_ => 1 } convert_to_rational($this->METRIC);
   $this->NODE_COLORS=[ map {
      /1\s+(.*)/;
      exists $metric{$1} ? $Visual::Color::vertices : $Visual::Color::non_tax_vertices;
   } @{$this->VERTICES}[@indices] ];


# category: Visualization
# This is a variation of @see VISUAL_BOUNDED_GRAPH for the special case of a tight span
# return: Visual::Graph

user_method VISUAL_TIGHT_SPAN() {
   my ($this)=@_;

   my $labels=$this->lookup("VERTEX_LABELS");
   my $BG=$this->BOUNDED_GRAPH;
   my @indices=map { /\((\d+)/ } @{$BG};
   my @BGE;
   client("edge_lengths", $this, "VERTICES", "BOUNDED_GRAPH", \@BGE, "-redirect");

   my $Graph=new Visual::Graph( Name => "Tight Span - " . $this->name,
				Graph => $BG,
				Coord => spring_embedding_3d($this, \@BGE, "skip-node-attr", undef, "read-edge-weights", undef, "balance", 1000),
				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::Color;

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


###########################################################################################
#
#  Object type to visualize with SplitsTree
#

package Visual::FiniteMetricSpace;

use Struct (
   [ new => '%' ],
   [ '@ISA' => 'Visual::Object' ],
   '$metric',
   [ '$taxa' => 'unify_labels( #% )', 'undef' ],
);

object TightSpan;

# category: Visualization
# Visualize ... don't know what
# return: Visual::FiniteMetricSpace

user_method VISUAL_SPLITS () {
   my $this=shift;
   my $M= new Visual::FiniteMetricSpace(metric => $this->METRIC,
					taxa => $this->TAXA);
   visualize($M);
}


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