chiark / gitweb /
routesearch: fix up web performance parameterisation
[ypp-sc-tools.db-test.git] / yarrg / web / routetrade
index 05294b5503ce8bbd8d81319451b686e38f1e1304..d66e8b1772c8bb8a4b8db0dceedac4e244dff740 100644 (file)
@@ -38,10 +38,7 @@ $dbh
 @islandids
 @archipelagoes
 $qa
-$max_mass
-$max_volume
-$lossperleaguepct
-$max_capital
+$routeparams
 </%args>
 <&| script &>
   da_pageload= Date.now();
@@ -49,14 +46,16 @@ $max_capital
 
 <%perl>
 
-my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
+my $loss_per_league= defined $routeparams->{LossPerLeaguePct}
+       ? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7;
 my $loss_per_delay_slot= 1e-8;
 
 my $now= time;
 
-my %flow_conds;
+my @flow_conds;
 my @query_params;
 my %dists;
+my $expected_total_profit;
 
 my $sd_condition= sub {
        my ($bs, $ix) = @_;
@@ -82,30 +81,33 @@ my @subflows;
 foreach my $org_i (0..$#islandids) {
        my $org_isle= $islandids[$org_i];
        my $org_cond= $sd_condition->('sell',$org_i);
-       my %dst_conds;
+       my @dst_conds;
        foreach my $dst_i ($org_i..$#islandids) {
                my $dst_isle= $islandids[$dst_i];
                # Don't ever consider sailing things round the houses:
-               next if grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
-               next if grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
-               my $dst_cond= $sd_condition->('buy',$dst_i);
+               next if defined $dst_isle and
+                       grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
+               next if defined $org_isle and
+                       grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
+               my $dst_cond;
                if ($dst_i==$org_i and !defined $org_isle) {
                        # we always want arbitrage, but mentioning an arch
                        # once shouldn't produce intra-arch trades
-                       $dst_cond=
-                               "($dst_cond AND sell.islandid = buy.islandid)";
+                       $dst_cond= "sell.islandid = buy.islandid";
+               } else {
+                       $dst_cond= $sd_condition->('buy',$dst_i);
                }
-               $dst_conds{$dst_cond}= 1;
+               push @dst_conds, $dst_cond;
 
                if ($specific) {
                        push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
                                [ $org_i, $dst_i ];
                }
        }
-       $flow_conds{ "$org_cond AND (
+       push @flow_conds, "$org_cond AND (
                        ".join("
-                    OR ", sort keys %dst_conds)."
-               )" }= 1;
+                    OR ",@dst_conds)."
+               )";
 }
 
 my $stmt= "            
@@ -154,7 +156,7 @@ my $stmt= "
        JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
        WHERE   (
                ".join("
-          OR   ", sort keys %flow_conds)."
+          OR   ", @flow_conds)."
        )
          AND   buy.price > sell.price
        ORDER BY org_name, dst_name, commodname, unitprofit DESC,
@@ -289,7 +291,11 @@ foreach my $f (@flows) {
                        Flow => $f,
                        Org => $sfi->[0],
                        Dst => $sfi->[1],
-                       Var => sprintf "f%ss%s", $f->{Ix}, $sfi->[0]
+                       Var => sprintf "f%ss%s_c%d_p%d_%d_p%d_%d",
+                               $f->{Ix}, $sfi->[0],
+                               $f->{'commodid'},
+                               $sfi->[0], $f->{'org_price'},
+                               $sfi->[1], $f->{'dst_price'}
                };
                push @{ $f->{Subflows} }, $subflow;
                push @subflows, $subflow;
@@ -324,7 +330,7 @@ foreach my $f (@flows) {
                my $first= $base;
                do {
                        my $this= $uue % $base;
-print STDERR "uue=$uue this=$this ";
+#print STDERR "uue=$uue this=$this ";
                        $uue -= $this;
                        $uue /= $base;
                        $this += $first;
@@ -332,8 +338,8 @@ print STDERR "uue=$uue this=$this ";
                        $cmpu .= chr($this + ($this < 26 ? ord('a') :
                                              $this < 52 ? ord('A')-26
                                                         : ord('0')-52));
-print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
-die "$cmpu $uue ?" if length $cmpu > 20;
+#print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
+                       die "$cmpu $uue ?" if length $cmpu > 20;
                } while ($uue);
                $cmpu;
        } @uid;
@@ -417,10 +423,9 @@ foreach my $flow (@flows) {
        }
        foreach my $od (qw(org dst)) {
                my $limname= join '_', (
-                       'avail',
-                       $flow->{'commodid'},
                        $od,
-                       $flow->{"${od}_id"},
+                       'i'.$flow->{"${od}_id"},
+                       'c'.$flow->{'commodid'},
                        $flow->{"${od}_price"},
                        $flow->{"${od}_stallid"},
                );
@@ -450,9 +455,9 @@ foreach my $ci (0..($#islandids-1)) {
                next unless @relsubflow;
                die unless @relsubflow == 1;
                push @rel_subflows, @relsubflow;
-print " RELEVANT $ci $relsubflow[0]->{Var} ";
+#print " RELEVANT $ci $relsubflow[0]->{Var} ";
        }
-print " RELEVANT $ci COUNT ".scalar(@rel_subflows)."  ";
+#print " RELEVANT $ci COUNT ".scalar(@rel_subflows)."  ";
        if (!@rel_subflows) {
                foreach my $mv (qw(mass volume)) {
                        $sail_total[$ci]{$mv}= 0;
@@ -461,21 +466,22 @@ print " RELEVANT $ci COUNT ".scalar(@rel_subflows)."  ";
        }
 
        my $applylimit= sub {
-               my ($mv, $max, $f2val) = @_;
-               return unless defined $max;
-print " DEFINED MAX $mv $max ";
+               my ($mv, $f2val) = @_;
+               my $max= $routeparams->{"Max".ucfirst $mv};
+               $max= 1e9 unless defined $max;
+#print " DEFINED MAX $mv $max ";
                $cplex .= "
    ". sprintf("%-10s","${mv}_$ci:")." ".
                join(" + ", map {
-print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
+#print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
                        $f2val->($_->{Flow}) .' '. $_->{Var};
                } @rel_subflows).
                " <= $max";
        };
 
-       $applylimit->('mass',   $max_mass,   sub { $_[0]{'unitmass'}  *1e-3 });
-       $applylimit->('volume', $max_volume, sub { $_[0]{'unitvolume'}*1e-3 });
-       $applylimit->('capital',$max_capital,sub { $_[0]{'org_price'}       });
+       $applylimit->('mass',    sub { $_[0]{'unitmass'}  *1e-3 });
+       $applylimit->('volume',  sub { $_[0]{'unitvolume'}*1e-3 });
+       $applylimit->('capital', sub { $_[0]{'org_price'}       });
        $cplex.= "\n";
 }
 
@@ -506,7 +512,8 @@ if ($qa->{'debug'}) {
        my $input= pipethrough_prep();
        print $input $cplex or die $!;
        my $output= pipethrough_run_along($input, undef, 'glpsol',
-               qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
+               qw(glpsol --tmlim 2 --memlim 5 --intopt --cuts --bfs
+                         --cpxlp /dev/stdin -o /dev/stdout));
        print "<pre>\n" if $qa->{'debug'};
        my $found_section= 0;
        my $glpsol_out= '';
@@ -519,6 +526,9 @@ if ($qa->{'debug'}) {
                        $found_section= 1;
                        next;
                }
+               if (m/^Objective:\s+totalprofit = (\d+\.\d*) /) {
+                       $expected_total_profit= $1;
+               }
                next unless $found_section==1;
                if (!length $continuation) {
                        next if !$continuation &&  m/^[- ]+$/;
@@ -538,7 +548,7 @@ if ($qa->{'debug'}) {
                        (\w+) \s+ (?: [A-Z*]+ \s+ )?
                        ([0-9.]+) \s
                        /x or die "$_ ?";
-               if ($varname =~ m/^f(\d+)s(\d+)$/) {
+               if ($varname =~ m/^f(\d+)s(\d+)_/) {
                        my ($ix,$orgix) = ($1,$2);
                        my $flow= $flows[$ix] or die;
                        my @relsubflow= grep { $_->{Org} == $orgix }
@@ -844,7 +854,7 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
      my $totals= '';
      if ($i < $#islandids) {
-       $totals .=      "Hold: $sail_total[$i]{mass}kg,".
+       $totals .=      "In hold $sail_total[$i]{mass}kg,".
                        " $sail_total[$i]{volume} l";
        my $delim= '; spare ';
        my $domv= sub {
@@ -854,8 +864,8 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
                $totals .= sprintf "%g %s", ($max-$got), $units;
                $delim= ', ';
        };
-       $domv->($max_mass,   $sail_total[$i]{mass},   'kg');
-       $domv->($max_volume, $sail_total[$i]{volume}, 'l');
+       $domv->($routeparams->{MaxMass},   $sail_total[$i]{mass},   'kg');
+       $domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
        $totals .= ".\n";
      }
      $show_total_now->($totals);
@@ -869,6 +879,9 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
  %></strong>
 </table>
 <& query_age:dataages, id2age => \%da_ages &>
+Expected average profit:
+ approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
+ (considering expected losses, but ignoring rum consumed)
 %
 % } # ========== TRADING PLAN ==========