#  Copyright (c) 2018
#  Charles Jordan (Hokkaido University, Sapporo, Japan),
#  Michael Joswig, Lars Kastner (Technische Universitaet Berlin, Germany)
# 
#  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 3, 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.
#-------------------------------------------------------------------------------

use strict;
use warnings;
use application 'polytope';

# With this script one can batch upgrade the tests for canonicalRepresentative.
# It comes with built-in tests that one still gets the same result.
#
# polymake --script support/update_canonicalRepresentative_tests.pl
#

my $canonicalRepresentativeBin = "./build/Opt/bin/canonicalRepresentative";
if(!-e $canonicalRepresentativeBin){
   die("canonicalRepresentative executable not found.");
}

my @files = split("\n", `find testfiles/canonicalRepresentatives`);
@files = grep($_ =~ m/IN/, @files);

foreach my $file (@files){
   update_file($file);
}

sub update_file {
   my($file) = @_;
   print "Updating $file ... ";
   my($triang, $gkz) = get_input($file);
   my @old = get_old_output($file);
   my @new = get_new_output($file);
   my $perm = $new[2];
   my $check = $old[0] == $new[0];
   if(!$check){
      print "\n";
      print "$old[0]\n";
      print "$new[0]\n";
      print "rep fail\n";
      exit(1);
   }
   $check &= $old[1] == $new[1];
   if(!$check){
      print "\n";
      print "$old[1]\n";
      print "$new[1]\n";
      print "gkz fail\n";
      exit(1);
   }
   $check &= $old[1] == group::action_inv($perm,$gkz);
   if(!$check){
      print "\n";
      print "Perm: $perm\n";
      print "$gkz\n";
      my $permuted = group::action_inv($perm,$gkz);
      print $permuted,"\n";
      print "perm gkz fail\n";
      exit(1);
   }
   $check &= $new[0] == group::action<group::on_elements>($perm, $triang);
   if(!$check){
      print "rep fail\n";
      exit(1);
   }
   if($check){
      write_output($new[0], $new[1], $file);
      print "OK\n";
   } else {
      print "fail\n";
      exit(1);
   }
}

sub write_output{
   my($triang, $gkz, $file) = @_;
   $file =~ s/\.IN/\.OUT/;
   my $outstring = "[".join(",", @$gkz)."]\n";
   $outstring .= "{{".join("},{",map(join(",",@$_), @$triang))."}}\n";
   `rm $file`;
   open(my $output, ">$file");
   print $output $outstring;
   close($output);
}

sub get_new_output {
   my($file) = @_;
   my $output = `$canonicalRepresentativeBin --small-group < $file 2>/dev/null`;
   my($triang, $gkz, $perm) = $output =~ m/.*(\{\{.*\}\}).*gkz: (\[.*\]).* perm: (\[.*\])/;
   $gkz = new Vector<Rational>(eval $gkz);
   $perm = new Array<Int>(eval $perm);
   $triang = triang_from_string($triang);
   return ($triang, $gkz, $perm);
}

sub get_input {
   my($file) = @_;
   my $entire = `cat $file`;
   my($points,$triang) = $entire =~ m/(\[\D*\[.*\]\D*\]).*\[\D*\[.*\]\D*\].*(\{\{.*\}\})/s;
   $points = new Matrix(eval $points);
   my $gkz = new Vector<Rational>($points->rows());
   $triang = triang_from_string($triang);
   foreach my $set (@$triang){
      my $det = det($points->minor($set, All));
      if($det < 0) { $det *= -1; }
      foreach my $e (@$set){
         $gkz->[$e] += $det;
      }
   }
   return ($triang, $gkz);
}

sub triang_from_string {
   my($triang) = @_;
   $triang =~ s/\{/\[/g;
   $triang =~ s/\}/\]/g;
   return new Set<Set<Int>>(eval $triang);
}


sub get_old_output {
   my($file) = @_;
   $file =~ s/\.IN/\.OUT/;
   my @entire = split("\n", `cat $file`);
   my $gkz = $entire[0];
   my $triang = $entire[1];
   $triang = triang_from_string($triang);
   $gkz = new Vector<Rational>(eval $gkz);
   return ($triang, $gkz);
}

