#  Copyright (c) 1997-2010
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.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: _4ti2.rules 9502 2010-02-24 00:26:29Z gawrilow $

# path to groebner
custom $groebner;

# path to zsolve
custom $zsolve;

# path to hilbert
custom $hilbert;

CONFIGURE {
    find_via_path($groebner,"groebner") &&
    find_via_path($zsolve,"zsolve") &&
    find_via_path($hilbert,"hilbert");
}

# FIXME additional command line parameter for 4ti2's "groebner"
# see the manual of 4ti2 for explanations of the various possible options
custom $_4ti2_groebner_param="";

label _4ti2

# @topic credits/4ti2
# 4ti2 -- A software package for algebraic, geometric and combinatorial problems on linear spaces.
# Copyright by 4ti2 team.
# http://www.4ti2.de/

object LatticePolytope {

    rule GROEBNER_BASIS.BASIS : AMBIENT_DIM , LATTICE_POINTS {
        my $dim = $this->AMBIENT_DIM;
        my $lp = $this->LATTICE_POINTS->rows;
        my $tempname=new Tempfile;

        # write all lattice points into $tempname.mat
	groebner_write( $tempname,'mat',transpose($this->LATTICE_POINTS) );

	# check whether a term order is defined
	# otherwise take 4ti2's default
        if (defined (my $tom = $this->lookup("GROEBNER_BASIS.TERM_ORDER_MATRIX") ) ) {
          # write all lattice points into $tempname.cost
	  groebner_write( $tempname,'cost', $tom );
        } elsif (defined (my $ton = $this->lookup("GROEBNER_BASIS.TERM_ORDER_NAME") ) ) {
	  if ( $ton eq 'lex' ) {
	    groebner_write( $tempname,'cost', unit_matrix<Int>($lp) );
	  } elsif ( $ton eq 'degrevlex' ) {
	    my $tom = new Matrix<Int>($lp,$lp);
	    $tom->row(0) = ones_vector<Int>($lp);
            foreach (1..$lp-1) { $tom->[$_][$lp-$_] = -1; }
	    groebner_write( $tempname,'cost', $tom );
	  } elsif ( $ton eq 'deglex' ) {
	    my $tom = new Matrix<Int>($lp,$lp);
	    $tom->row(0) = ones_vector<Int>($lp);
            foreach (1..$lp-1) { $tom->[$_][$_-1] = 1; }
	    groebner_write( $tempname,'cost', $tom );
	  } else {
	    die "unknown term order";
	  }
	}
        
        # run groebner with standard precision
        my $runarb = 0;
        if ($Verbose::external) {
            dbg_print( "running 4ti2's groebner: $groebner $_4ti2_groebner_param $tempname" );
        }
        open(my $P, "$groebner $_4ti2_groebner_param $tempname 2>&1 |")
            or die "couldn't run 4ti2's 'groebner': $!";

        local $_;
        while(<$P>) {
            if (/ERROR: Try running 4ti2 with arbitrary precision/) {
                $runarb = 1;
            }
        }
        close $P;
        open($P, "<$tempname.gro")
            or $runarb = 1;
        
        close $P;

        # run groebner with arbitrary precision if necessary
        if ($runarb == 1) {
            if ($Verbose::external) {
               dbg_print( "running 4ti2's groebner: $groebner -parb $_4ti2_groebner_param $tempname" );
            }
            open(my $P, "$groebner -parb $_4ti2_groebner_param $tempname 2>&1 |")
                or die "couldn't run 4ti2's 'groebner': $!";

            while(<$P>) {
            }
            close $P;
        }

        # read groebner basis
        open(my $outfile, "<$tempname.gro")
            or die "can't open output file $tempname.gro: $!";
        my $dimline = <$outfile>;
        my @gromat=();
        my $i;
        while (<$outfile>) {
            my @vec = split;
            push @gromat, \@vec;
            $i++;
        }
        if ($i > 0) {
            $this->GROEBNER_BASIS->BASIS = \@gromat;
        }
        close $outfile;
    }
    weight 5.10;

}

object Polytope<Rational> {

    rule _4ti2.npoints: N_LATTICE_POINTS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname=new Tempfile;
        
        zsolve_print($tempname,$this);
        
        _4ti2_run($zsolve,$tempname);
        
        zsolve_parse($tempname,$this,npoints=>1);
    }
    precondition : BOUNDED;
    weight 5.15;
    
    rule _4ti2.points: LATTICE_POINTS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname=new Tempfile;
        
        zsolve_print($tempname,$this);
        
        _4ti2_run($zsolve,$tempname);
        
        zsolve_parse($tempname,$this,points=>1);
    }
    precondition : BOUNDED;
    weight 5.20;
    
    
    rule _4ti2.nhilbert: N_HILBERT_BASIS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname = new Tempfile;
        
        hilbert_print($tempname,$this);
        
        _4ti2_run($hilbert,$tempname);
        
        hilbert_parse($tempname,$this,nhilb=>1);
    }
    precondition : POINTED;
    weight 5.20;
    
    rule _4ti2.npoints, _4ti2.nhilbert: N_HILBERT_BASIS , N_LATTICE_POINTS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname = new Tempfile;
        
        hilbert_print($tempname,$this);
        
        _4ti2_run($hilbert,$tempname);
        
        hilbert_parse($tempname,$this,nhilb=>1,npoints=>1);
    }
    precondition : BOUNDED;
    weight 5.20;
    
    rule _4ti2.points, _4ti2.nhilbert: N_HILBERT_BASIS , LATTICE_POINTS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname = new Tempfile;
        
        hilbert_print($tempname,$this);
        
        _4ti2_run($hilbert,$tempname);
        
        hilbert_parse($tempname,$this,nhilb=>1,points=>1);
    }
    precondition : BOUNDED;
    weight 5.30;
    
    rule _4ti2.hilbert: HILBERT_BASIS : AMBIENT_DIM , FACETS | INEQUALITIES {
        my $tempname = new Tempfile;
        
        hilbert_print($tempname,$this);
        
        _4ti2_run($hilbert,$tempname);
        
        hilbert_parse($tempname,$this,hilb=>1);
    }
    precondition : POINTED;
    weight 5.40;
    
}

sub groebner_write {
  my ($filebase,$suffix,$m) = @_;

  open(my $M, ">$filebase.$suffix")
    or die "can't create temporary file $filebase.$suffix: $!";
  #header
  print $M $m->rows, " ", $m->cols, "\n";
  print $M new Matrix<Integer>($m);
  close $M;
}

sub _4ti2_run {
    my $prog = shift;
    # run $prog
    if ($Verbose::external) {
        dbg_print( "running 4ti2: $prog -q @_" );
    }
    system("$prog -q @_".(!$DebugLevel && " >/dev/null 2>&1"))
        and die "couldn't run 4ti2: $prog -q @_\n";
}

sub zsolve_print {
    my ($tempname, $this) = @_;
    
    # prepare data: ineq / eq
    my $dim = $this->AMBIENT_DIM;
    my $n_ineq = ($this->FACETS | INEQUALITIES)->rows;
    my $facets = eliminate_denominators($this->FACETS | INEQUALITIES);

    if (!check_int_limit($facets)) {
        die("input values exceed int limits");
    }

    my $n_lines = $n_ineq;
    my $ah;
    if (defined (my $AH = $this->lookup("AFFINE_HULL | EQUATIONS"))) {
        $n_lines += $AH->rows;
        $ah=eliminate_denominators($AH);
        if (!check_int_limit($ah)) {
            die("input values exceed int limits");
        }
    }
    
    
    
    # matrix file
    open(my $M, ">$tempname.mat")
        or die "can't create temporary file $tempname.mat: $!";
    
    # right hand side
    open(my $R, ">$tempname.rhs")
        or die "can't create temporary file $tempname.rhs: $!";
    
    # relations file
    open(my $E, ">$tempname.rel")
        or die "can't create temporary file $tempname.rel: $!";
    
    # print the data for all files
    # inequalities
    print $M "$n_lines $dim\n",
             $facets->minor(All,range(1,$dim));
    
    print $R "1 $n_lines\n",
             -($facets->col(0)), " ";
    
    print $E "1 $n_lines\n",
             "> " x $n_ineq;

    # equalities if necessary
    if ($n_lines > $n_ineq) {
        print $M $ah->minor(All,range(1,$dim));
        print $R -($ah->col(0));
        print $E "= " x ($n_lines-$n_ineq);
    }

    close $E;
    close $M;
    close $R;
}

sub hilbert_print {
    my ($tempname, $this) = @_;
    
    # prepare data: ineq / eq
    my $dim = $this->AMBIENT_DIM;
    my $n_ineq = ($this->FACETS | INEQUALITIES)->rows;
    my $facets = eliminate_denominators($this->FACETS|INEQUALITIES);
    if (!check_int_limit($facets)) {
        die("input values exceed int limits");
    }
    my $n_lines = $n_ineq;
    my $ah;
    if (defined (my $AH = $this->lookup("AFFINE_HULL | EQUATIONS"))) {
       $n_lines += $AH->rows;
       $ah = eliminate_denominators($AH);
        if (!check_int_limit($ah)) {
            die("input values exceed int limits");
        }
    }
    
    # matrix file
    open(my $M, ">$tempname.mat")
       or die "can't create temporary file $tempname.mat: $!";
    print $M $n_lines, " ", $dim+1, "\n";
    print $M $facets;
    
    # relations file
    open(my $E, ">$tempname.rel")
        or die "can't create temporary file $tempname.rel: $!";
    print $E "1 $n_lines\n",
             "> " x $n_ineq;
    
    if ($n_lines > $n_ineq) {
        print $M $ah;
        print $E "= " x ($n_lines-$n_ineq);
    }
    
    # sign file
    open(my $S, ">$tempname.sign")
        or die "can't create temporary file $tempname.sign: $!";
    print $S 1, " ", $dim+1, "\n";
    print $S "0 " x ($dim+1);
    
    close $E;
    close $M;
    close $S;
}


sub zsolve_parse {
    my ($tempname,$this,%flags) = @_;
    
    # parse output
    open(my $outfile, "<$tempname.zinhom")
        or die "can't open output file $tempname.zinhom: $!";
    my $dimline = <$outfile>;
    my @points=();
    my $count=0;
    local $_;
    while(<$outfile>) {
        if(/^$/) {
            next;
        }
        # read one point and append to output inklusive proj 1
        $count++;
        if ($flags{points}) {
            my @p = (1, split);
            push @points, \@p;
            
        }
    }
    $this->N_LATTICE_POINTS=$count if $flags{npoints};
    $this->LATTICE_POINTS=\@points if $flags{points};
    
    close $outfile;
}

sub hilbert_parse {
    my ($tempname,$this,%flags) = @_;
    
    # parse output
    open(my $outfile, "<$tempname.hil")
        or die "can't open output file $tempname.hil: $!";
    my $dimline = <$outfile>;
    my @hilb = ();
    my @points = ();
    my $nhilb = 0;
    my $npoints = 0;
    my $normal = 1;
    
    local $_;
    while(<$outfile>) {
        if(/^$/) {
            next;
        }
        
        $nhilb++;
        if ($flags{hilb}) {
            my @p = split;
            push @hilb, \@p;
        }
        
        if (/^\s*1\s+/) {
            $npoints++;
            if ($flags{points}) {
                my @p = split;
                push @points, \@p;
            }
        } else {
            $normal = 0;
        }
    }
    
    $this->NORMAL=$normal if ($flags{norm});
    $this->HILBERT_BASIS=\@hilb if ($flags{hilb});
    $this->N_HILBERT_BASIS=$nhilb if ($flags{nhilb});
    
    $this->LATTICE_POINTS=\@points if ($flags{points});
    $this->N_LATTICE_POINTS=$npoints if ($flags{npoints});
    
    close $outfile;
}
# Local Variables:
# mode: perl
# c-basic-offset:4
# End:
