#  Copyright (c) 1997-2024
#  Ewgenij Gawrilow, Michael Joswig, and the polymake team
#  Technische Universität Berlin, Germany
#  https://polymake.org
#
#  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.
#-------------------------------------------------------------------------------


# @category Data Conversion
# Change the type of the polymake object to one of its base types
# (aka ancestor in the inheritance hierarchy).
# The object loses all properties that are unknown in the target type.
# @tparam Target  the desired new type
# @param Core::BigObject object to be modified
# @return Core::BigObject  the same //object//, but with modified type

user_function cast<Target>(Core::BigObject) { $_[0]->cast_me(typeof Target); }


# @category Utilities
# Returns the maximal element of an array.
# @param ARRAY array
# @example
# > print maximum([1,2,3,4,5,6,7,23]);
# | 23

user_function maximum($) {
   my ($data)=@_;
   my $max;
   assign_max($max, $_) for @$data;
   return $max;
}


# @category Utilities
# Returns the minimal element of an array.
# @param ARRAY array
# @example
# > print minimum([23,42,666]);
# | 23

user_function minimum($) {
   my ($data)=@_;
   my $min;
   assign_min($min, $_) for @$data;
   return $min;
}


# @category Utilities
# Returns the average value of the array elements.
# @param ARRAY array
# @example
# > print average([1,2,3]);
# | 2

user_function average($) {
   my ($data)=@_;
   my $n=@$data or return;
   my $s=0;
   $s+= $_ for @$data;
   return $s/$n;
}

# @category Utilities
# Returns the sum of the array elements.
# @param ARRAY array
# @example
# > print sum([1,2,3]);
# | 6

user_function sum($) {
   my ($data)=@_;
   my $s=0;
   $s+= $_ for @$data;
   return $s;
}

# @category Utilities
# Returns the median value of the array elements.
# Running time O(n log(n)) if n is the length of the input.                      
# @param ARRAY array
# @example
# > print median([1,2,3,9]);
# | 2.5

user_function median($) {
   my ($data)=@_;
   my $n=@$data or return;
   my @sorted = sort { $a <=> $b } @$data;
   if ($n % 2 == 1) {
      return $sorted[($n-1)/2];
   } else {
      return ($sorted[$n/2-1] + $sorted[$n/2])/2;
   }
}

# @category Utilities
# Produce a histogram of an array: each different element value is mapped on the number of its occurences.
# @param ARRAY data
# @return Map<Any, Int>
# @example
# > $H = histogram([1,1,2,2,2,3,3,2,3,3,1,1,1,3,2,3]);
# > print $H;
# | {(1 5) (2 5) (3 6)}

user_function histogram {
   my ($data)=@_;
   return unless @$data;
   my $element_type=Core::PropertyType::guess_array_element_type($data);
   my $map=new Map<$element_type, Int>();
   ++$map->{$_} for @$data;
   $map
}


# @category Utilities
# Checks if a given sequence is unimodal
# @param ARRAY data
# @return Bool
# @example 
# > print is_unimodal([1,1,2,3,3,2,2,1]);
# | 1                     
# > print is_unimodal([3,3,2,-1]);
# | 1
# > print is_unimodal([1,3,2,3]);
# | 0
user_function is_unimodal {
    my ($seq) = @_;
    return unless @$seq;
    my $seen_decreasing = 0;
    my $prev=$seq->[0];
    for (@$seq) {
        if ($prev < $_) {
            if ($seen_decreasing) {
                return 0;
            }
        } elsif ($prev > $_) {
            $seen_decreasing = 1;
        }
        $prev = $_;
    }
    return 1;
}
                     
# @category Utilities
# Checks if a given sequence is nonnegative
# @param ARRAY data
# @return Bool
# @example 
# > print is_nonnegative([1,0,3]);
# | 1
user_function is_nonnegative {
    my ($seq) = @_;
    return unless @$seq;
    for (@$seq) {
        if ($_ < 0) {
            return 0;
        }
    }
    return 1;
}
                     
# @category Utilities
# Returns the first //m// Fibonacci numbers.
# @param Int m
# @return ARRAY
user_function fibonacci_numbers {
   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;
}

# Takes (vertex) labels and incidence information to produce new (facet) labels.
function induced_labels(Array, IncidenceMatrix) {
   my ($v_labels, $incidence)=@_;
   new Array<String>( map { join(",", @$v_labels[ @$_ ]) } @$incidence);
}

# @category Utilities
# Find the given labels in an array and return their indices.
# @param Array<String> array
# @param String label label ...
# @return Int Int ...
function labeled_output(Array<String>, $, $) {
    my ($labels, $facets, $size) = @_;
    my $max_label_length=0;
    foreach my $l(@{$labels}) {
	assign_max($max_label_length, length($l));
    }
    my @labeled_facets;
    foreach my $i (0..$size-1) {
	my $lf = "[";
	my $first = 1;
	foreach my $v (@{$facets->[$i]}) {
	    if ($first == 1) {
		$first = 0;
	    } else {
		$lf .= " " unless $max_label_length == 1;
	    }
	    $lf .= $labels->[$v];
	}
	$lf .= "]";
	push @labeled_facets, $lf;
    }
    return \@labeled_facets;
}
                     
# @category Utilities
# Find the given labels in an array and return their indices.
# @param Array<String> array
# @param String label label ...
# @return Int Int ...

function find_labels {
   my $array=shift;
   my %asked;
   my $notfound=@_;
   foreach (@_) {
      $asked{$_}++ and croak( "label $_ occurs twice" );
   }
   my @ret;
   my $i=0;
   foreach (@$array) {
      if (delete $asked{$_}) {
         push @ret, $i;
         --$notfound or last;
      }
      ++$i;
   }
   if ($notfound) {
      if ($notfound>1) {
         croak( "Labels ", join(", ", keys %asked), " do not exist" );
      } else {
         croak( "Label ", keys(%asked), " does not exist" );
      }
   }
   @ret;
}

# @category Utilities
# Return a map indexing an array of sets
# @param Array<Set<Int>> array
# @return HashMap<Array<Set<Int>>, Int>
# @example [nocompare]
# > $s1 = new Set(1,2,3);
# > $s2 = $s1 - 1;
# > $a = new Array<Set>($s1,$s2,$s1);
# > print index_of($a);
# | {({1 2 3} 2) ({2 3} 1)}

user_function index_of(Array<Set<Int>>) {
    my $array = shift;
    my $index_of = new HashMap<Set<Int>, Int>;
    my $i=0;
    foreach (@{$array}) {
        $index_of->{$_} = $i++;
    }
    $index_of;
}


# @category Utilities
# Given a metric, return a triangle matrix whose (i,j)-entry contains the distance between point i and j of the point set //S// for i<j. All entrys below the diagonal are zero. The metric is passed as a perl subroutine mapping two input vectors to a real value.
# @param Matrix S
# @param CODE d
# @return Matrix
# @example
# The following defines the perl subroutine dist as the euclidean metric and then saves the distance matrix of the 3-cubes vertices in the variable $M:
# > sub dist($$) {
# >    my $v = $_[0] - $_[1];
# >    return sqrt(new Float($v*$v)); }
# > $M = distance_matrix(polytope::cube(3)->VERTICES, \&dist);
user_function distance_matrix($$){
	my ($S, $d) = @_;
	my $n = $S->rows;
	my $M = new Matrix($n,$n);
	for (my $i = 0; $i<$n; $i++){
		for (my $j = $i+1; $j<$n; $j++){
			$M->elem($i,$j) = &$d( $S->row($i) , $S->row($j));
		}
	}
	return $M;
                     }

# @category Linear Algebra
# Compute the Hadamard product of two matrices with same dimensions.
# @param Matrix M1
# @param Matrix M2
# @return Matrix"

user_function hadamard_product<Scalar>(Matrix<type_upgrade<Scalar>,_>, Matrix<type_upgrade<Scalar>,_>): c++ (include => "polymake/common/hadamard_product.h");

                     
# Local Variables:
# mode: perl
# cperl-indent-level:3
# indent-tabs-mode:nil
# End: