#  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: utilities 7540 2006-12-21 21:04:18Z gawrilow $

require Poly::ProgramPipe;

# all functions here are automatically exported in other modules and applications,
# as soon as they USE this module

####
#### following functions become superfluous when data sharing between C++ and perl is implemented
####

function product {
   my ($m,$n) = @_;
   my $p=1;
   my $k;
   foreach $k ($m..$n) {
      $p = $p * $k;
   }
   $p
}

function binomial {
   my ($n,$k) = @_;
   if ($k>$n/2) {
      product($k+1,$n) / product(2,$n-$k);
   } else {
      product($n-$k+1,$n) / product(2,$k);
   }
}

function fibonacci {
   my ($m) = @_;
   my @numbers;
   if ($m>=1) {
      push @numbers, 1;
      if ($m>=2) {
	 push @numbers, 1;
	 for (my $i=2; $i<$m; ++$i) {
	    push @numbers, $numbers[$i-1]+$numbers[$i-2];
	 }
      }
   }
   return @numbers;
}

function alternating_sum_and_sign {
   my $alternating_sum=0;
   my $sign=1;
   foreach my $n (is_array($_[0]) ? @{$_[0]} : @_) {
      $alternating_sum += $sign*$n;
      $sign=-$sign;
   }
   return ($alternating_sum,$sign);
}

function transpose {
   my $n=0;			# line counter
   my @t=();			# transposed incidence matrix
   foreach (@{$_[0]}) {
      foreach my $x (/\d+/g) {
	 $t[$x].="$n "
      }
      $n++;
   }
   foreach (@t) { s/^(.*) $/{$1}\n/ }
   \@t
}

function max_elem {	# property => max cardinal over all lines
   my $answer=-1;
   foreach (@{$_[0]}) {
      /(\d+)(?:\s*\}\s*)?$/;
      if ($answer<$1) { $answer=$1; }
   }
   return $answer;
}

function row_sizes {	# property => ( cardinal list )
   map { my $cnt=0; while (/\d+/g) { ++$cnt } $cnt } @{$_[0]};
}

function col_sizes {	# "property" => ( cardinal list )
   my @answer;
   foreach (@{$_[0]}) {
      foreach my $elem (/\d+/g) {
	 ++$answer[$elem];
      }
   }
   return @answer;
}

function permute_rows {
   my ($old, $indices)=@_;
   my @new=@$old[@$indices];
   \@new;
}

function permute_cols {
   my ($old, $indices, $already_inversed)=@_;
   if (!$already_inversed) {
      my @inverse_indices; $#inverse_indices=$#$indices;
      for (my $i=0; $i<@inverse_indices; ++$i) { $inverse_indices[$indices->[$i]]=$i }
      $indices=\@inverse_indices;
   }
   my @new=map {
      my ($head, $tail)=/^(\D*) (?: .*\d (\D*))? $/x;
      defined($tail)
      ? do { my @row=sort { $a <=> $b } @$indices[ /\d+/g ];
             "$head@row$tail" }
      : $head
   } @$old;
   \@new;
}

function permute_rows_cols {
   permute_cols(&permute_rows, $_[1]);
}

function permute_elements {
   my ($old, $indices)=@_;
   if (is_array($old)) {
      my @new=map {
         my @row=split;
         "@row[@$indices]\n";
      } @$old;
      \@new;
   } else {
      my @row=split /\s+/, $old;
      "@row[@$indices]";
   }
}

function permute_sets {
   my ($old, $indices)=@_;
   my @inverse_indices; $#inverse_indices=$#$indices;
   for (my $i=0; $i<@inverse_indices; ++$i) { $inverse_indices[$indices->[$i]]=$i }
   my @new=map {
      my @sets=sort { compare_sets($a,$b); } @{permute_cols([ /\{[^{}]*\}/g ], \@inverse_indices, 1)};
      "{@sets}\n";
   } @$old;
   \@new;
}

function compare_sets {
   my ($a, $b)=@_;
   my @a= $a =~ /\d+/g;
   my @b= $b =~ /\d+/g;
   my $result;
   for (my $i=0; $i<=main::min($#a,$#b); ++$i) {
      $result=$a[$i]<=>$b[$i] and last;
   }
   $result ||= $#a <=> $#b;
};

function diff_list_of_sets {
   my ($from,$to)=@_;
   my $cnt=0;
   my %bag=map { my @set=/\d+/g; "@set" => $cnt++ } @$from;
   my @result=map { my @set=/\d+/g; my $key="@set";
		    exists $bag{$key} ? $bag{$key} : die "lists of sets are different\n"
		  } @$to;
   \@result;
}

# k, item, item, ... => list of k_subsets: [ item, ... ], ...
function all_subsets_of_k {
   my $k=shift;
   my $n=@_;
   croak( "parameter k=$k out of range" ) if $k<0 || $k>$n;
   return [] if !$k;
   my @result;
   my @index=0..$k-1;
   my $ptr=$k-1;

   while (1) {
      push @result, [ @_[@index] ];
      next if ++$index[$ptr] < $n;
      do {
	 return @result if --$ptr<0;
      } while ((++$index[$ptr])+$k-$ptr > $n);
      while ($ptr<$k-1) {
	 ++$ptr;
	 $index[$ptr]=$index[$ptr-1]+1;
      }
   }
}

# "LABEL ..." => [ "LABEL" ];  labels starting with _ are replaced by white spaces.
function split_labels {
   [ map { s/^_.*/ /; $_ } split /\s+/, shift ]
}

# takes (vertex) labels and incidence information to produce new (facet) labels
function induced_labels {
   my ($v_labels, $incidences) = @_;
   my @v_label = $v_labels =~ /\S+/g;
   join(" ", map { join(",", @v_label[/\d+/g]) } @$incidences);
}

# find a permutation between two label sets; be prepared for non-unique labels
function diff_labels {
   my ($from, $to)=map { is_array($_) ? $_ : [ split ] } @_;
   die "lists of labels are different\n" if $#$from != $#$to;
   my %map;
   my $pos=0;
   push @{$map{$_}}, $pos++ for @$from;
   my $bag;
   my @perm=map {
      if (defined ($bag=$map{$_})) {
         $pos=shift @$bag;
         delete $map{$_} unless @$bag;
         $pos;
      } else {
         die "lists of labels are different\n";
      }
   } @$to;
   die "lists of labels are different\n" if keys %map;	# just to calm the paranoia
   \@perm;
}

##############################################################################
#
# ('program_name', ...) => 'full path to the first one found in PATH'
#
function find_via_path {
   foreach my $dir (split /:/, $ENV{PATH}) {
      foreach my $progname (@_) {
	 if (-x "$dir/$progname") {
	    return $dir eq "." ? `pwd`."/$progname" : "$dir/$progname";
	 }
      }
   }
   undef;
}

# java interpreter suitable for JavaView and jReality
custom $java = "java";


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