Try LP-only if MIP fails, and round everything down

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 59b02674f1034bb82c983f803afa44e54600075b..b2bbf2e04da0386c20464edcd83a4916dbf8e419 100644 (file)
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -580,16 +580,23 @@ if ($qa->{'debug'}) {
 <%perl>
 }
 
 <%perl>
 }
 

-{
+my $try_solve= sub {
+       my (@opts) = @_;

        my $input= pipethrough_prep();
        print $input $cplex or die $!;
        my $output= pipethrough_run_along($input, undef, 'glpsol',
        my $input= pipethrough_prep();
        print $input $cplex or die $!;
        my $output= pipethrough_run_along($input, undef, 'glpsol',

-               qw(glpsol --tmlim 5 --memlim 5 --intopt --cuts --bfs
-                         --cpxlp /dev/stdin -o /dev/stdout));
-       print "<pre>\n" if $qa->{'debug'};
+               qw(glpsol --tmlim 1 --memlim 5), @opts,
+               qw( --cpxlp /dev/stdin -o /dev/stdout));
+       if ($qa->{'debug'}) {
+               print "<h3>@opts</h3>\n<pre>\n";
+       }
+       $expected_total_profit= undef;
+       $_->{OptQty}= undef foreach @subflows;

        my $found_section= 0;
        my $glpsol_out= '';
        my $continuation='';
        my $found_section= 0;
        my $glpsol_out= '';
        my $continuation='';

+       my $timelimit= 0;
+       my $somemip= 0;

        while (<$output>) {
                $glpsol_out.= $_;
                print encode_entities($_) if $qa->{'debug'};
        while (<$output>) {
                $glpsol_out.= $_;
                print encode_entities($_) if $qa->{'debug'};


@@ -598,6 +605,14 @@ if ($qa->{'debug'}) {
                        $found_section= 1;
                        next;
                }
                        $found_section= 1;
                        next;
                }

+               if ((m/^Integer optimization begins/ .. 0) &&
+                   m/^\+ \s* \d+\: \s* mip \s* = \s* \d/) {
+                       $somemip= 1;
+                       next;
+               }
+               if (m/^TIME LIMIT EXCEEDED/) {
+                       $timelimit= 1;
+               }

                if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
                        $expected_total_profit= $1;
                }
                if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
                        $expected_total_profit= $1;
                }


@@ -618,7 +633,7 @@ if ($qa->{'debug'}) {
                my ($varname, $qty) = m/^
                        \s* \d+ \s+
                        (\w+) \s+ (?: [A-Z*]+ \s+ )?
                my ($varname, $qty) = m/^
                        \s* \d+ \s+
                        (\w+) \s+ (?: [A-Z*]+ \s+ )?

-                       ([+-e0-9.]+) \s
+                       ([-+0-9]+)(?: [.e][-+e0-9.]* )? \s

                        /x or die "$cplex \n==\n $glpsol_out $_ ?";
                if ($varname =~ m/^f(\d+)s(\d+)_/) {
                        my ($ix,$orgix) = ($1,$2);
                        /x or die "$cplex \n==\n $glpsol_out $_ ?";
                if ($varname =~ m/^f(\d+)s(\d+)_/) {
                        my ($ix,$orgix) = ($1,$2);


@@ -640,8 +655,23 @@ if ($qa->{'debug'}) {
        pipethrough_run_finish($output,$prerr);
        map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
        defined $expected_total_profit or die "$prerr ?";
        pipethrough_run_finish($output,$prerr);
        map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
        defined $expected_total_profit or die "$prerr ?";

+       return $somemip || !$timelimit;

 };
 
 };
 

+unless ($try_solve->(qw( --intopt --cuts --bfs )) or
+       $try_solve->(qw( --nomip ))) {
+</%perl>
+<h2>Optimisation failed</h2>
+The linear/mixed-integer optimisation failed.
+Please report this problem.
+
+<pre>
+<% $cplex |h %>
+</pre>
+<%perl>
+       return;
+}
+

 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
        my ($flow,$col,$v,$spec) = @_;
        if ($flow->{ExpectedUnitProfit} < 0) {
 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
        my ($flow,$col,$v,$spec) = @_;
        if ($flow->{ExpectedUnitProfit} < 0) {