#  Copyright (c) 1997-2009
#  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: LPparser.pm 9298 2009-09-02 23:10:56Z gawrilow $

package Polymake::polytope::LPparser;
use Polymake::Struct (
   [ new => '$' ],
   [ '$LPfile' => '#1' ],
   '@A', '@B',			# inequalities Ax+B>=0
   '@P', '@Q',			# equations Px+Q=0
   '@C',			# objective function Cx -> min
   '@L', '@U',			# variable bounds  l <= x <= u
   '@X',			# variable index => name
   '%Xi',			# variable name => index
   '@Int',			# variable index => is_integer (boolean)
   '$objsense',
);

sub new {
   my $self=&_new;
   open my $LP, $self->LPfile or die "Can't read ", $self->LPfile, ": $!\n";

   local $/;
   my $lp=<$LP>;
   close $LP;
   $lp =~ s/\\.*?\n//mg;	# comments start with '\' and go up to the end of line
   $lp =~ /^\s*(maximize|minimize|maximum|minimum|max|min)\s+/im
      or die "no objective function found\n";
   $lp=$';
   $self->objsense= lc(substr($1,0,3)) eq "max" ? "+" : "-";

   $lp =~ /^\s*(?:subject\s+to|such\s+that|s\.?t\.?)\s+/im
      or die "no constraints found\n";
   $lp=$';
   @{$self->C}=$self->make_vector($`, "+");

   my ($constraints, @optionals)=split /^(bounds?|binar(?:y|ies)|general|end)\s*$/im, $lp;

   while ($constraints =~ /\S/) {
      $constraints =~ /[<>]\s*=?|=\s*[<>]?/
         or die "invalid constraint\n";
      $constraints=$';
      my ($line, $rel)=($`, $&);
      my @vec=$self->make_vector($line, $rel=~/</ ? "-" : "+");
      my $rhs=parse_number($constraints, $rel=~/</ ? "+" : "-");
      die "invalid right hand side in input line '$line'\n" if $rhs eq "" or $rhs eq "-";

      if ($rel=~/[<>]/) {
	 push @{$self->A}, \@vec;
	 push @{$self->B}, $rhs;
      } else {
	 push @{$self->P}, \@vec;
	 push @{$self->Q}, $rhs;
      }
   }

   if ($optionals[0] =~ /bounds?/i) {
      my $bounds=splice @optionals, 0, 2;
      while ($bounds =~ /\S/) {
         $bounds =~ s/^\s+//s;
         my ($x, $rel, $b, $inf);
         if ($bounds =~ /^([^\n]*?)[ \t]+free\s*/i) {
	    $bounds=$';
	    my $name=$1;
	    $x=$self->parse_name($name);
            if (defined $x) {
	       undef $self->L->[$x];  undef $self->U->[$x];
	    } else {
	       die "invalid free variable declaration: $name\n";
	    }
            next;
         }

         if ($bounds =~ /^([^\n]*?)([<>][ \t]*=?|=[ \t]*[<>]?)([^\n]*?)([<>][ \t]*=?|=[ \t]*[<>]?)/) {
	    $bounds="$1$2$3\n$3$4$'";
	 }

         my $xleft=0;
         $x=$self->parse_name($bounds);
         if (defined $x) {
	    $xleft=1;
	    $bounds =~ /[<>]\s*=?|=\s*[<>]?/
	       or die "invalid bound variable declaration: $bounds\n";
	    $bounds=$';
	    $rel=$&;
         }

         if ($bounds =~ /^\s*([+-])[ \t]*inf(inity)?\s*/) {
	    $inf=$1;
	    $bounds=$';
	 } else {
	    $b=parse_number($bounds,"+");
	    die "invalid variable bound value\n" if $b eq "" or $b eq "-";
	 }

         if (!$xleft) {
	    $bounds =~ /[<>]\s*=?|=\s*[<>]?/
	       or die "invalid bound variable declaration\n";
	    $rel=$&;
            $bounds=$';
	    $x=$self->parse_name($bounds);
	    die "invalid bound variable declaration\n" unless defined $x;
         }

         if (defined $inf) {
	    die "invalid infinite bound\n"
	       if $inf eq "+" && $xleft != $rel=~/</
	       or $inf eq "-" && $xleft != $rel=~/>/;
	    if ($inf eq "+") {
	       undef $self->U->[$x];
	    } else {
	       undef $self->L->[$x];
	    }
         } else {
	    if ($rel!=/[<>]/) {
	       $self->L->[$x]=$self->U->[$x]=$b;
	    } elsif ($xleft == $rel=~/</) {
	       $self->U->[$x]=$b;
	    } else {
	       $self->L->[$x]=$b;
	    }
         }
      }
   }

   while (@optionals>1) {
      @{$self->Int}=(0) x @{$self->X} unless @{$self->Int};
      my $binary= shift(@optionals) =~ /binar(?:y|ies)/i;
      my $names=shift(@optionals);
      foreach my $name ($names =~ /\S+/g) {
         if (defined (my $x=$self->Xi->{$name})) {
            if ($binary) {
               $self->L->[$x]=0; $self->U->[$x]=1;
            }
            $self->Int->[$x]=1;
         } else {
            die "unknown variable name '$name' occured in ", ($binary ? "BINARY" : "GENERAL"), " section\n";
         }
      }
   }

   if (@optionals>1 || $optionals[0] !~ /end/i) {
      $optionals[-1] =~ /\S+/;
      die "unrecognized section '$&' near the end of file\n";
   }

   for (my $x=0; $x<=$#{$self->X}; $x++) {
      if (defined $self->L->[$x] and defined $self->U->[$x] and $self->L->[$x]==$self->U->[$x]) {
         my @vec;
         $vec[$x]=-1;
         push @{$self->P}, \@vec;
         push @{$self->Q}, $self->L->[$x];
         next;
      }
      if (defined $self->L->[$x]) {
         my @vec;
         $vec[$x]=1;
         push @{$self->A}, \@vec;
         push @{$self->B}, -$self->L->[$x];
      }
      if (defined $self->U->[$x]) {
         my @vec;
         $vec[$x]=-1;
         push @{$self->A}, \@vec;
         push @{$self->B}, $self->U->[$x];
      }
   }

   my @xorder=sort { $self->X->[$a] cmp $self->X->[$b] } 0..$#{$self->X};

   foreach my $line (@{$self->A}, @{$self->P}, $self->C) {
      @$line=map { $line->[$xorder[$_]]+0 } 0..$#{$self->X};
   }
   @{$self->X}=@{$self->X}[@xorder];
   @{$self->Int}=@{$self->Int}[@xorder];

   $self;
}

sub Ineq {
   my $self=shift;
   [ map { [ $self->B->[$_], @{$self->A->[$_]} ] } 0..$#{$self->A} ]
}

sub Eq {
   my $self=shift;
   [ map { [ $self->Q->[$_], @{$self->P->[$_]} ] } 0..$#{$self->P} ]
}

sub Obj {
   my $self=shift;
   [ 0, @{$self->C} ]
}

sub parse_number {		# "line", positive_sign => "advanced line", number
   my ($line,$positive)=@_;
   $line =~ m'^\s*([+-])?(?:[ \t]*\n)?([ \t\d]*\.?[ \t\d]*(e[ \t]*[+-]?[ \t\d]+)?)?\s*'si;
   $_[0]=$';
   my ($sign, $number)=($1, lc($2));
   $number=~s/\s//g;                                    # in exact powers of 10
   $number="1$number" if substr($number,0,1) eq "e";    #   the leading 1 can be omitted
   $sign= ($sign or "+") eq $positive ? "" : "-";
   "$sign$number"
}

sub varindex {			# "name" => index
   my ($self, $name)=@_;
   if (exists $self->Xi->{$name}) {
      $self->Xi->{$name}
   } else {
      push @{$self->X}, $name;
      push @{$self->L}, 0;
      $self->Xi->{$name}=$#{$self->X}
   }
}

sub parse_name {		# "line" => index or undef
   my ($self, $line)=@_;
   if ($line =~ m'^\s*([A-Za-z!"#$%&()/,;?@_\'`{}|~][A-Za-z0-9.!"#$%&()/,;?@_\'`{}|~ \t]*)\s*') {
      $_[1]=$';
      my $name=$&;
      $name=~s/\s//g;
      $self->varindex($name)
   } else {
      undef
   }
}

sub make_vector {		# "linear expression", positive_sign => (coefficients)
   my @vec;
   my ($self, $line, $positive)=@_;
   my $iline=$line;
   my ($coef, $i);

   $line =~ s/^.*://;		# remove a possible label

   while ($line) {
      $coef=parse_number($line, $positive);
      $coef.="1" if $coef eq "" or $coef eq "-";
      $i=$self->parse_name($line);
      die "$0: invalid expression in input line '$iline'" unless defined $i;
      $vec[$i]=$coef;
   }
   @vec
}


1

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