#  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: coord_functions 6862 2006-01-25 15:51:07Z gawrilow $

###############################################################################
#
# Functions converting coordinate vectors or matrices between various representations
#

function negative {
   my ($vec)=@_;
   $vec =~ s/(^|\s) (-)? (?=[\d.])/$1.($2 ? "" : "-")/egx;
   $vec;
}

# don't negate the first coordinate
function negative_homogeneous {
   my ($vec)=@_;
   $vec=~/\S+/;
   substr($vec, 0, $+[0]) . negative(substr($vec, $+[0]));
}

sub convert_to {		# [ data ], { "Rational" | "float" } => ( data )
   my ($data, $wanted_type)=@_;
   my ($convert, @result);
   my $wrong_re= $wanted_type eq "float" ? qr'\d/\d' : qr'[.eE]';
   if (ref($data)) {
     foreach (@$data) {
       $convert=1, last if $_ =~ $wrong_re;
     }
   } else {
     $convert=1 if $data =~ $wrong_re;
     $data=["$data\n"];
   }
   return @$data if !$convert;
   client("rational_float", undef, $data, \@result, $wanted_type);
   @result;
}

# the following functions are useful for the user as well

# category: Filters
# Converts a property of type @see type.matrix or @see type.vector to the rational representation.
user_function convert_to_rational {
   push @_, "Rational"; &convert_to;
}

# category: Filters
# Converts a property of type @see type.matrix or @see type.vector to the floating-point representation.
user_function convert_to_float {
   push @_, "float"; &convert_to;
}

function convert_to_integer {
   my $data=$_[0];
   my @result;
   client("rational_integer", undef, ref($data) ? $data : [ $data ], \@result);
   return @result;
}

function compare_via_client {
   my ($client_name, $obj, $old_data, $new_data)=@_;
   if (@$old_data == @$new_data) {
      if (@$old_data) {
	 my @answer;
	 client($client_name, $obj, \@answer, $old_data, $new_data);
	 if ($answer[0]+0) {
	    undef
	 } else {
	    die $client_name, ": difference found\n";
	 }
      }
   } else {
      die $client_name, ": different size\n";
   }
}

########################################################
#
#  Analogons to the PTL classes
#

package Slice;
use Struct (
   [ new => '$$$' ],
   [ '@master' => '#1' ],
   [ '$start' => '#2' ],
   [ '$size' => '#3 - #2 +1' ],
);

*TIEARRAY=\&new;

sub DESTROY { }

sub FETCH {
   my ($self, $index)=@_;
   $index+=$self->size if $index<0;
   $index>=0 && $index<$self->size ? $self->master->[$index+$self->start] : undef;
}

sub STORE {
   my ($self, $index)=@_;
   $index+=$self->size if $index<0;
   $index>=0 && $index<$self->size ? ($self->master->[$index+$self->start]=$_[2])
				   : croak( "index $index out of range" );
}

*FETCHSIZE=\&size;

sub EXISTS {
   my ($self, $index)=@_;
   $index+=$self->size if $index<0;
   $index>=0 && $index<$self->size && exists($self->master->[$index+$self->start]);
}

sub DELETE {
   my ($self, $index)=@_;
   $index+=$self->size if $index<0;
   $index>=0 && $index<$self->size && delete($self->master->[$index+$self->start]);
}

sub indices {
   my $self=$_[0];
   if (my @indices=flatten_indices($self->master)) {
      @indices[$self->start .. $self->start+$self->size-1];
   } else {
      $self->start .. $self->start+$self->size-1;
   }
}

sub AUTOLOAD {
   $AUTOLOAD =~ s/.*::([^:]+)$/$1/;
   croak( "operation $AUTOLOAD on a Slice is not allowed" );
}

package Subset;

# Constructor: master array, index, ...
sub new {
   my $class=shift;
   bless [ @_ ], $class;
}

*TIEARRAY=\&new;

*DESTROY=\&Slice::DESTROY;

sub FETCHSIZE {
   $#{$_[0]};	# the first element is the array ref
}

sub FETCH {
   my ($self, $index)=@_;
   my $size=&FETCHSIZE;
   $index+=$size if $index<0;
   $index>=0 && $index<$size ? $self->[0]->[$self->[$index+1]] : undef;
}

sub STORE {
   my ($self, $index)=@_;
   my $size=&FETCHSIZE;
   $index+=$size if $index<0;
   $index>=0 && $index<$size ? ($self->[0]->[$self->[$index+1]]=$_[2])
			     : croak( "index $index out of range" );
}

sub EXISTS {
   my ($self, $index)=@_;
   my $size=&FETCHSIZE;
   $index+=$size if $index<0;
   $index>=0 && $index<$size && exists($self->[0]->[$self->[$index+1]]);
}

sub DELETE {
   my ($self, $index)=@_;
   my $size=&FETCHSIZE;
   $index+=$size if $index<0;
   $index>=0 && $index<$size && delete($self->[0]->[$self->[$index+1]]);
}

sub indices {
   my $self=$_[0];
   if (my @indices=flatten_indices($self->[0])) {
      @indices[@$self[1..$#$self]];
   } else {
      @$self[1..$#$self];
   }
}

sub AUTOLOAD {
   $AUTOLOAD =~ s/.*::([^:]+)$/$1/;
   croak( "operation $AUTOLOAD on a Subset is not allowed" );
}

package default;

# Array, first index, last index => Slice
function slice {
   croak( ref($_[0]) || $_[0], " is not an array" ) unless is_array($_[0]);
   my @x;
   tie @x, "Slice", @_;
   \@x;
}

# Array, index, ... => Subset
function subset {
   croak( ref($_[0]) || $_[0], " is not an array" ) unless is_array($_[0]);
   my @x;
   tie @x, "Subset", @_;
   \@x;
}

function detect_dynamic($) {
   my $obj;
   is_ARRAY($_[0]) && ($obj=tied @{$_[0]}) && detect_dynamic($obj);
}

function detect_dynamic(Slice) {
   detect_dynamic($_[0]->master);
}

function detect_dynamic(Subset) {
   detect_dynamic($_[0]->[0]);
}

function dim($) {
   my $vector;
   if (is_array($_[0])) {
      if (my $obj=tied(@{$_[0]})) {
	 return dim($obj);
      }
      $vector=shift->[0];
   } else {
      $vector=shift;
   }
   my $c=0;
   ++$c while $vector =~ /(?:^|\s)\S/g;
   return $c;
}

function dim(Slice) {
   dim($_[0]->master);
}

function dim(Subset) {
   my ($subset)=@_;
   dim($_[0]->[0]);
}

function flatten_indices($) {
   if (my $obj=tied(@{$_[0]})) {
      $obj->indices;
   } else {
      0..$#{$_[0]}
   }
}


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