#  Copyright (c) 1997-2018
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.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.
#-------------------------------------------------------------------------------

CREDIT topcom
  TOPCOM is a package for computing Triangulations Of Point Configurations and Oriented Matroids.
  Copyright by Jörg Rambau.
  http://www.rambau.wm.uni-bayreuth.de/TOPCOM/

# path to the programs from the TOPCOM package
custom $topcom;

CONFIGURE {
   $topcom =~ s{(?<=\S)$}{/points2chiro};
   my $path=find_program($topcom, "points2chiro", { prompt => "the `points2chiro' program from the TOPCOM package" }) or return;
   ($topcom) = $path =~ $directory_re;
}

require Polymake::ProgramPipe;

# @category Triangulation and volume
# Use the [[wiki:external_software#TOPCOM]] package for computing polytope triangulations.

label topcom

#Converts an Array<Array<Int>> of symmetries into a text that TOPCOM understands
sub symmetry_to_text {
   return "[[".join("],[", map { join(",", @{$_}) } @{ $_[0]})."]]";
}

# @category Triangulations, subdivisions and volume
# This computes the chirotope of a point or vector configuration.
# @param Matrix V The points or vectors, given as rows.
# @option Array<Array<Int>> symmetry A list of generators of a symmetry group of the points, given as permutations on the indices. If specified, the chirotope is only computed up to symmetry.
# @return String
user_function chirotope(Matrix; {symmetry=>undef}) {
   my ($matrix, $symmetry_options)=@_;
   my $P=new ProgramPipe("$topcom/points2chiro", defined($symmetry_options->{symmetry}) ? () : ("--nosymmetries"), $DebugLevel ? () : ("2>/dev/null"));
   print $P "[", join(",", map { "[".join(",", @{$_})."]" } @{$matrix}), "]";
   if (!defined $symmetry_options->{symmetry}) {
      print $P "[]\n";
   } else {
      print $P "\n".symmetry_to_text($symmetry_options->{symmetry})."\n";
   }
   local $/;
   local $_=<$P>;
   my @result = split("\n",$_);
   return join("\n",@result[0..(scalar(@result)-2)])."\n";#TOPCOM appends the symmetry generators as text, which we forget here.
   #Note: While TOPCOM returns the chirotope with line breaks (I guess for readability), it does not actually need them as input. One could, theoretically, do the join above with ""..
}

sub call_topcom_co_or_circuits {
   my $P=new ProgramPipe($_[1], $DebugLevel ? () : ("2>/dev/null"));
   print $P "$_[0]\n";
   local $_;
   <$P>; # dimensions
   <$P>; # opening bracket
   my @circuits=();
   while (<$P>) {
     if ( $_ =~ /\{/ ) {  # not the closing bracket
       chomp;
       my $pair=new Pair<Set<Int>,Set<Int>>;
       my @e =( split /\},\{/, $_ );
       $_=$e[0];
       s/\{//g; s/\[//g; s/\]//g; s/\}//g;
       my @x=( split /,/, $_ );
       $pair->first=\@x;

       $_=$e[1];
       s/\{//g; s/\[//g; s/\]//g; s/\}//g;
       @x=( split /,/, $_ );                 #/
       $pair->second=\@x;

       push @circuits, $pair;
     }
   }
   new Set<Pair<Set,Set>>(\@circuits);
}

sub call_topcom_circuits($)
{
   call_topcom_co_or_circuits($_[0], "$topcom/chiro2circuits");
}

sub call_topcom_cocircuits($)
{
   call_topcom_co_or_circuits($_[0], "$topcom/chiro2cocircuits");
}

sub call_topcom_chiro2placingtriang($) {
   my $P=new ProgramPipe("$topcom/chiro2placingtriang", $DebugLevel ? () : ("2>/dev/null"));
   print $P $_[0], "\n";
   local $/;
   local $_=<$P>;
   chomp;
   s/^\{//; s/\}$//; s/\},\{/}\n{/g; tr/,/ /;
   [ split /\n/, $_ ];
}

sub call_topcom_chiro2triangs {
   my $P=new ProgramPipe("$topcom/chiro2triangs", $DebugLevel ? () : ("2>/dev/null"));
   print $P $_[0],"\n";
   local $_;
   my @triangs=();
   while (<$P>) {
     s/T.*://; s/\];//; s/^\{//; s/\}$//; s/\},\{/}\n{/g; tr/,/ /;
     my @e = split /\n/, $_;
     push @triangs, \@e;
   }
   \@triangs;
}


sub call_topcom_chiro2finetriangs($) {
   my $P=new ProgramPipe("$topcom/chiro2finetriangs", $DebugLevel ? () : ("2>/dev/null"));
   print $P $_[0], "\n";
   local $_;
   my @triangs=();
   while (<$P>) {
     s/T.*://; s/\];//; s/^\{//; s/\}$//; s/\},\{/}\n{/g; tr/,/ /;
     my @e = split /\n/, $_;
     push @triangs, \@e;
   }
   \@triangs;
}

sub call_topcom_chiro2alltriangs($) {
   my $P=new ProgramPipe("$topcom/chiro2alltriangs", $DebugLevel ? () : ("2>/dev/null"));
   print $P $_[0], "\n";
   local $_;
   my @triangs=();
   while (<$P>) {
     s/T.*://; s/\];//; s/^\{//; s/\}$//; s/\},\{/}\n{/g; tr/,/ /;
     my @e = split /\n/, $_;
     push @triangs, \@e;
   }
   \@triangs;
}

# @category Triangulations, subdivisions and volume
# Computes all triangulations of a point configuration that are connected by bistellar
# flips to the regular triangulations. The triangulations are computed via the chirotope.
# @param PointConfiguration pc input point configuration
# @option Array<Array<int>> symmetry A list of generators of a symmetry group of the points. If specified, only triangulations up to symmetry will be computed.
# @return Array<Array<Set<Int>>>
user_function topcom_regular_and_connected_triangulations(PointConfiguration; {symmetry=>undef} ) {
    my ($self, $symmetry_options)=@_;
    if (!defined $symmetry_options->{symmetry}) {
       return new Array<Array<Set<Int>>>(call_topcom_chiro2triangs($self->CHIROTOPE));
    }
    else {
       my $chiro = chirotope($self->POINTS, $symmetry_options);
       return new Array<Array<Set<Int>>>(call_topcom_chiro2triangs($chiro."\n".symmetry_to_text($symmetry_options->{symmetry})."\n"));
    }
}

# @category Triangulations, subdivisions and volume
# Computes all fine triangulations of a point configuration that are connected by bistellar flips
# to a fine seed triangulation. The triangulations are computed via the chirotope.
# @option Array<Array<int>> symmetry A list of generators of a symmetry group of the points. If specified, only triangulations up to symmetry will be computed.
# @param PointConfiguration pc input point configuration
# @return Array<Array<Set<Int>>>
user_function topcom_fine_and_connected_triangulations(PointConfiguration; {symmetry=>undef} ){
    my ($self, $symmetry_options)=@_;
    if (!defined $symmetry_options->{symmetry}) {
      return new Array<Array<Set<Int>>>(call_topcom_chiro2finetriangs($self->CHIROTOPE));
    }
    else {
       my $chiro = chirotope($self->POINTS, $symmetry_options);
      return new Array<Array<Set<Int>>>(call_topcom_chiro2finetriangs($chiro."\n".symmetry_to_text($symmetry_options->{symmetry})."\n"));
    }
}

# @category Triangulations, subdivisions and volume
# Computes all triangulations of a point configuration via its chirotope.
# @param PointConfiguration pc input point configuration
# @return Array<Array<Set<Int>>>
user_function topcom_all_triangulations {
   my $self=shift;
   return new Array<Array<Set<Int>>>(call_topcom_chiro2alltriangs($self->CHIROTOPE));
}

# @category Triangulations, subdivisions and volume
# Computes the GKZ secondary configuration of a point configuration via its chirotope.
# @param PointConfiguration pc input point configuration
# @return PointConfiguration
user_function topcom_gkz_secondary<Scalar>(PointConfiguration<Scalar>) {
    my $self=shift;
    my $v = new Matrix( map { gkz_vector<Scalar>($self->POINTS, $_) } @{topcom_all_triangulations($self)} );
    my $vh = ones_vector<Scalar>() | $v;
    return new PointConfiguration<Scalar>(POINTS=>$vh);
}

# @category Triangulations, subdivisions and volume
# Computes the GKZ secondary configuration of a point configuration via its chirotope.
# @param PointConfiguration pc input point configuration
# @return PointConfiguration
user_function topcom_gkz_secondary<Scalar>(Polytope<Scalar>) {
    my $self=shift;
    my $v = new Matrix<Scalar>( map { gkz_vector<Scalar>($self->VERTICES, $_) } @{topcom_all_triangulations($self)} );
    my $vh = ones_vector<Scalar>() | $v;
    return new PointConfiguration<Scalar>(POINTS=>$vh);
}

# @category Triangulations, subdivisions and volume
# returns all sets of points that form a
# circuit with the given list of points
# @param Polytope or PointConfiguration P
# @param Set<Int> S subset of point indices
# @return Set<Set<Int>> A list of point sets that intersect positively the set S
user_function positive_circuits {
   my $self=shift;
   my $set=new Set<Int>(num_sorted_uniq(sort {$b <=> $a} @_));
   my $pos_circuits = new Set<Set<Int>>;
   foreach (@{$self->CIRCUITS}) {
     if ( $_->first == $set ) {
	$pos_circuits += $_->second;
     } else {
       if ( $_->second == $set ) {
        $pos_circuits += $_->first;
       }
     }
   }
   return $pos_circuits;
}


object Polytope {

rule CHIROTOPE : VERTICES {
   $this->CHIROTOPE=chirotope($this->VERTICES);
}
weight 6.10;


rule topcom.triangulation.poly: TRIANGULATION(new).FACETS : CHIROTOPE {
    $this->TRIANGULATION->FACETS = call_topcom_chiro2placingtriang($this->CHIROTOPE);
}

} # end object Polytope


object VectorConfiguration {

rule CHIROTOPE : VECTORS {
   $this->CHIROTOPE=chirotope($this->VECTORS);
}
weight 6.10;
precondition : FULL_DIM;

rule topcom.circuits : CIRCUITS : CHIROTOPE {
   $this->CIRCUITS=call_topcom_circuits($this->CHIROTOPE);
}
weight 6.10;
precondition : FULL_DIM;

rule topcom.cocircuits : COCIRCUITS : CHIROTOPE {
   $this->COCIRCUITS=call_topcom_cocircuits($this->CHIROTOPE);
}
weight 6.10;
precondition : FULL_DIM;

} # end object VectorConfiguration


object PointConfiguration {

rule topcom.triangulation.pc : TRIANGULATION(new).FACETS : CHIROTOPE {
    $this->TRIANGULATION->FACETS = call_topcom_chiro2placingtriang($this->CHIROTOPE);
}
precondition : FULL_DIM;

} # end object PointConfiguration




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