#!/usr/bin/perl
#
#  Copyright (c) 1997-2004
#  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: lp2poly 5757 2005-02-02 17:56:46Z gawrilow $

#  @file lp2poly
#
#  Convert a linear programming problem given in LP-Format (as used by cplex & Co.)
#  to polymake description and print it to stdout.
#
#  @synopsis lp2poly IN_FILE.lp >OUT_FILE.poly
#
#  @index utilities

die "usage: $0 LPFILE >POLYFILE\n" if @ARGV!=1;
open LP, $ARGV[0] or die "$0: can't read $ARGV[0]: $!\n";

$lp="";

while (<LP>) {
   s/\\.*$//;			# comments are starting with '\'
   $lp.=$_;
}
close LP;

@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
%X=();				# variable name => index

$lp =~ /maximize\s|minimize\s|maximum\s|minimum\s|max\s|min\s/is
   or die "$0: no objective function found\n";
$lp=$';
$objsense= lc(substr($&,0,3)) eq "max" ? "+" : "-";

$lp =~ /subject\s+to\s|such\s+that\s|s\.?t\.?\s/is
   or die "$0: no constraints found\n";
$lp=$';
@C=make_vector($`, "+");

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

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

if ($lp =~ /bounds?\s/is) {
   $lp=$';
   while ($lp and $lp !~ /^\s*end/is) {
      my ($x, $rel, $b, $inf);
      if ($lp =~ /^([^\n]*?)[ \t]+free\s*/i) {
	 $lp=$';
	 my $name=$1;
	 ($_, $x)=parse_name($name);
	 if (defined $x) {
	    undef $L[$x];  undef $U[$x];
	 } else {
	    die "$0: invalid free variable declaration: $name\n";
	 }
	 next;
      }

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

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

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

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

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

die "$0: unrecognized section\n" if $lp !~ /^\s*end\s*$/is;

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

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

print "_application polytope\n\n",
      "# converted by lp2poly from $ARGV[0]\n",
      "# objective sense was ", $objsense eq "+" ? "MAXIMIZE" : "MINIMIZE",
      "\nLINEAR_OBJECTIVE\n";
print join(" ", 0, map { $C[$xorder[$_]] or "0" } 0..$#X), "\n\n";

print "# converted by lp2poly from $ARGV[0]\nINEQUALITIES\n";
$i=0;
foreach $line (@A) {
   print join(" ", $B[$i++], map { $line->[$xorder[$_]] or "0" } 0..$#X), "\n";
}

print "\n# converted by lp2poly from $ARGV[0]\nEQUATIONS\n";
$i=0;
foreach $line (@P) {
   print join(" ", $Q[$i++], map { $line->[$xorder[$_]] or "0" } 0..$#X), "\n";
}

print "\n# converted by lp2poly from $ARGV[0]\nVARIABLE_NAMES\n";
print join(" ", @X[@xorder]), "\n";

exit 0;

sub parse_number {		# "line", positive_sign => "advanced line", number
   my ($line,$positive)=@_;
   $line =~ m'^\s*([+-])?([ \t\d]*\.?[ \t\d]*(e[ \t]*[+-]?[ \t\d]+)?)?\s*'si;
   $line=$';
   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 ? "" : "-";
   ($line, "$sign$number")
}

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

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

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

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

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


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