#  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: formatting_filters,v 1.11 2006/01/16 12:17:24 gawrilow Exp $


# topic: functions/Filters
# Functions converting the printable representation of the properties.
# The input arguments are either scalars or array references, the same applies
# to the return value.
#
# Filter functions are primarily used in @c print commands and in conversion utilities preparing
# the input data for external software packages.


# category: Filters
# Obtain a printable representation of the arguments.
# For visual objects, nothing is returned; the corresponding visualization back-end
# routines are called instead.

user_function printable($) {
   my $thing=shift;
   if (is_object($thing)) {
      if (my $ov_array=overload::Method($thing, '@{}')) {
	 # it pretends to be an array
	 @$thing;

      } elsif (my $ov_string=overload::Method($thing, '""') ||
	                     overload::Method($thing, '0+') ||
	                     overload::Method($thing, 'bool')) {
	 # it pretends to be a scalar
	 $ov_string->($thing);

      } elsif (my $name=UNIVERSAL::can($thing,'name')) {
	 # at least it has a printable name
	 (defined($thing->name) ? $thing->name.": " : "(anonymous) ").ref($thing);

      } else {
	 # we give up here
	 ref($thing)
      }
   } elsif (is_ARRAY($thing)) {
      # it is a plain array
      @$thing;

   } elsif (defined($thing)) {
      # it is a plain scalar
      $thing;

   } else {
      # undefined value
      $Poly::PropertyValue::UNDEF;
   }
}

# for any case...
function printable() { }

# for many arguments
function printable($$@) {
   map { printable($_) } @_;
}


# category: Filters
# args: property, labels
# @a property is expected to be of type @see type.set or @see type.incidence_matrix.
# @a labels should be an array or a string with whitespace separated words.
#
# In the result, each cardinal number will be substituted by the label with corresponding index;
# the indices start, as usual, with 0.

user_function labeled {
   my ($data, $labels)=@_;
   $labels=[ split /\s+/, $labels ] unless is_array($labels);
   if (is_array($data)) {
      return [
	 map {
	    my $out=$_;
	    $out =~ s/(\d+)/$labels->[$1]/g;
	    $out;
	 } @$data
      ];
   } else {
      $data =~ s/(\d+)/$labels->[$1]/g;
      return $data;
   }
}


# category: Filters
# args: property [, labels ]
# @a labels should be an array or a string with whitespace separated words.
# Each item in the @a property will be prepended with corresponding label and a colon.
# If @a property is a string, the labeled items are whitespace-separated words.
# If @a property is an array, the labeled items are array elements (=lines).
#
# If @a labels are omitted, takes the ordinal numbers starting with 0.

user_function row_labeled {
   my ($data, $labels)=@_;
   if (defined $labels) {
      $labels=[ split /\s+/, $labels ] unless is_array($labels);
   }
   my $i=-1;
   my @result=map {
      ++$i;
      (defined($labels) ? $labels->[$i] : $i).":$_"
   } (my $multiline=is_array($data)) ? @$data : split /\s+/, $data;
   return $multiline ? \@result : join(" ", @result);
}


# category: Filters
# args: property
# Equivalent to @see row_labeled with omitted @a labels argument.
# Preserved for backwards compatibility.

user_function numbered {
   &row_labeled;
}

##################################################################################
sub pack_line {
   my %counter;
   map { $counter{$_}++ } split;
   "{" . join(" ", map { "($_ $counter{$_})" } sort {$a<=>$b} keys %counter) . "}";
}

my $recognize_packed=qr{ ^ \{ (?:\(\d+ \s+ \d+\) \s*)* \} $ }x;

# category: Filters
# args: property
# @a property may be an array or a single line.
# For each input line, this filter sorts the elements numerically, counts the number of their occurence, 
# and produces an output line in the @see type.map format:
#
# <code>{(@i Element @i Count) ... }</code>
#
# When applied to already packed representation, returns the input without changes.

user_function packed {
   my ($data)=@_;
   if (is_array($data)) {
      if ($data->[0] =~ $recognize_packed) {
	 $data;
      } else {
	 [ map { pack_line . "\n" } @$data ];
      }
   } elsif ($data =~ $recognize_packed) {
      $data;
   } else {
      local $_=$data;
      pack_line;
   }
}

##################################################################################
sub average_line {
   my ($sum, $n)=(0, 0);
   if ($_ =~ $recognize_packed) { # row information in packed form
      while (/\( (\d+) \s+ (\d+) \)/xg) {
	 $sum += $1*$2;
	 $n += $2;
      }
   } else { # row information written element by element
      my @vector=split;
      $n=@vector;
      $sum+=$_ for @vector;
   }
   return $sum/$n;
}

# category: Filters
# args: property
# @a property may be an array or a single line.
# For each input line, this filter computes the average of the elements in it.
#
# Can be also applied to the @see packed representation.

user_function average {
   no integer;
   my ($data)=@_;
   if (is_array($data)) {
      [ map { average_line . "\n" } @$data ];
   } else {
      local $_=$data;
      average_line;
   }
}

##################################################################################

# category: Filters
# args: property
# @a property is expected to be of type @see type.set or @see type.incidence_matrix.
# Each input line is interpreted as a sparse vector with (implicit) 0/1 entries
# and extended to a dense vector.

user_function dense {
   my ($data)=@_;
   my $multiline=is_array($data)
      or $data=[ $data ];
   my $columns=0;
   foreach (@$data) {
      assign_max($columns, /(\d+)[^\d]*$/);
   }
   ++$columns;
   my @result=map {
      my @row = (0) x $columns;
      $row[$_]=1 for /\d+/g;
      "[ " . join(' ', @row) . ($multiline ? " ]\n" : " ]");
   } @$data;
   return $multiline ? \@result : @result;
}


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