Choose columns for routetrade

[ypp-sc-tools.web-live.git] / yarrg / web / routetrade

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 1924503b9ce706b888c2450de30403ba19f96a8b..f8e0f89145b11888878067f383a74f5e9c1872fd 100644 (file)
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -55,18 +55,38 @@ my $sd_condition= sub {
        }
 };
 
+my %islandpair;
+# $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
+
+my $specific= !grep { !defined $_ } @islandids;
+my $confusing= 0;
+
 foreach my $src_i (0..$#islandids) {
+       my $src_isle= $islandids[$src_i];
        my $src_cond= $sd_condition->('sell',$src_i);
        my @dst_conds;
        foreach my $dst_i ($src_i..$#islandids) {
+               my $dst_isle= $islandids[$dst_i];
                my $dst_cond= $sd_condition->('buy',$dst_i);
-               if ($dst_i==$src_i and !defined $islandids[$src_i]) {
+               if ($dst_i==$src_i and !defined $src_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)";
                }
                push @dst_conds, $dst_cond;
+
+               if ($specific && !$confusing &&
+                   # With a circular route, do not carry goods round the loop
+                   !($src_i==0 && $dst_i==$#islandids &&
+                     $src_isle == $islandids[$dst_i])) {
+                       if ($islandpair{$src_isle,$dst_isle}) {
+                               $confusing= 1;
+                       } else {
+                               $islandpair{$src_isle,$dst_isle}=
+                                       [ $src_i, $dst_i ];
+                       }
+               }
        }
        push @flow_conds, "$src_cond AND (
                        ".join("
@@ -85,11 +105,11 @@ my $stmt= "
                sum(buy.qty)                                    dst_qty,
                commods.commodname                              commodname,
                commods.commodid                                commodid,
-               commods.unitmass                                mass,
-               commods.unitvolume                              volume,
+               commods.unitmass                                unitmass,
+               commods.unitvolume                              unitvolume,
                buy.price - sell.price                          unitprofit,
-               min(sell.qty,buy.qty)                           tqty,
-               min(sell.qty,buy.qty) * (buy.price-sell.price)  profit
+               min(sell.qty,buy.qty)                           max_qty,
+               min(sell.qty,buy.qty) * (buy.price-sell.price)  max_profit
        FROM commods
        JOIN buy  on commods.commodid = buy.commodid
        JOIN sell on commods.commodid = sell.commodid
@@ -101,7 +121,7 @@ my $stmt= "
        )
          AND   buy.price > sell.price
        GROUP BY commods.commodid, org_id, org_price, dst_id, dst_price
-       ORDER BY org_name, dst_name, profit DESC, commodname,
+       ORDER BY org_name, dst_name, max_profit DESC, commodname,
                 org_price, dst_price DESC
      ";
 
@@ -109,6 +129,10 @@ my $sth= $dbh->prepare($stmt);
 $sth->execute(@query_params);
 my @flows;
 
+my @columns= qw(org_name dst_name commodname
+               org_price org_qty dst_price dst_qty
+               max_qty max_profit);
+
 </%perl>
 
 % if ($qa->{'debug'}) {
@@ -130,6 +154,22 @@ my @flows;
 <& dumpqueryresults:end &>
 % }
 
+% if (!$specific || $confusing || @islandids<=1) {
+
+<p>
+% if (@islandids<=1) {
+Route is trivial.
+% }
+% if (!$specific) {
+Route contains archipelago(es), not just specific islands.
+% }
+% if ($confusing) {
+Route is complex - it visits the same island several times
+and isn't a simple loop.
+% }
+Therefore, optimal trade pattern not calculated.
+
+% } else { # ========== OPTMISATION ==========
 <%perl>
 
 my $cplex= "
@@ -137,7 +177,7 @@ Maximize
 
   totalprofit:
                   ".(join " +
-                  ", map { "$_->{profit} $_->{Var}" } @flows)."
+                  ", map { "$_->{unit_profit} $_->{Var}" } @flows)."
 
 Subject To
 ";
@@ -170,13 +210,56 @@ Bounds
 
 End
 ";
-# glpsol --cpxlp /dev/stdin <t.cplex -o /dev/stdout
 
+if ($qa->{'debug'}) {
 </%perl>
 <pre>
 <% $cplex |h %>
 </pre>
+<%perl>
+}
+
+{
+       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));
+       print "<pre>\n" if $qa->{'debug'};
+       my $found_section= 0;
+       while (<$output>) {
+               print encode_entities($_) if $qa->{'debug'};
+               if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
+                       die if $found_section>0;
+                       $found_section= 1;
+                       next;
+               }
+               next unless $found_section==1;
+               next if m/^[- ]+$/;
+               if (!/\S/) {
+                       $found_section= 2;
+                       next;
+               }
+               my ($ix, $qty) =
+                       m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
+               my $flow= $flows[$ix] or die;
+               $flow->{Opt_qty}= $qty;
+               $flow->{Opt_profit}= $flow->{'unitprofit'} * $qty;
+       }
+       print "</pre>\n" if $qa->{'debug'};
+       pipethrough_run_finish($output, 'glpsol');
+       die unless $found_section;
+};
+
+print join ' ', map { $_->{Optimal} } @flows;
+
+push @columns, qw(Opt_qty Opt_profit);
+
+</%perl>
+<% join ' ', @columns %>
+
+% } # ========== OPTIMISATION ==========
 
 <%init>
 use CommodsWeb;
+use Commods;
 </%init>