Totals

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

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 597f9eea3f7fc937a921e6056348064e1a041d66..cb0ef9379e1a451ebbe3b5c3aff332794ada7850 100644 (file)
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -142,16 +142,31 @@ my $sth= $dbh->prepare($stmt);
 $sth->execute(@query_params);
 my @flows;
 
-my @columns;
+my @cols;
+
+my $addcols= sub {
+       my $base= shift @_;
+       foreach my $name (@_) {
+               push @cols, { Name => $name, %$base };
+       }
+};
+
 if ($qa->{ShowStalls}) {
-       push @columns,       qw(org_name org_stallname dst_name dst_stallname);
+       $addcols->({ Text => 1 }, qw(
+               org_name org_stallname
+               dst_name dst_stallname
+       ));
 } else {
-       push @columns,       qw(org_name dst_name);
+       $addcols->({Text => 1 }, qw(
+               org_name dst_name
+       ));
 }
-push @columns,              qw(commodname
-                               org_price org_qty dst_price dst_qty
-                               unitprofit PctProfit
-                               MaxQty MaxCapital MaxProfit);
+$addcols->({ Text => 1 }, qw(commodname));
+$addcols->({},
+       qw(     org_qty org_price dst_qty dst_price
+               Margin unitprofit MaxQty
+               MaxCapital MaxProfit
+       ));
 
 </%perl>
 
@@ -176,7 +191,7 @@ push @columns,                   qw(commodname
        $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
        $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 
-       $f->{PctProfit}= sprintf "%3.1f%%",
+       $f->{Margin}= sprintf "%3.1f%%",
                $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 
        $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
@@ -186,10 +201,68 @@ push @columns,                 qw(commodname
        foreach my $od (qw(org dst)) {
                push @uid,
                        $f->{"${od}_id"},
-                       $f->{"${od}_price"},
-                       $f->{"${od}_stallid"};
+                       $f->{"${od}_price"};
+               push @uid,
+                       $f->{"${od}_stallid"}
+                               if $qa->{ShowStalls};
+       }
+       $f->{UidLong}= join '_', @uid;
+
+       my $base= 31;
+       my $cmpu= '';
+       map {
+               my $uue= $_;
+               my $first= $base;
+               do {
+                       my $this= $uue % $base;
+print STDERR "uue=$uue this=$this ";
+                       $uue -= $this;
+                       $uue /= $base;
+                       $this += $first;
+                       $first= 0;
+                       $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;
+               } while ($uue);
+               $cmpu;
+       } @uid;
+       $f->{UidShort}= $cmpu;
+
+       if ($qa->{'debug'}) {
+               my @outuid;
+               $_= $f->{UidShort};
+               my $mul;
+               while (m/./) {
+                       my $v= m/^[a-z]/ ? ord($&)-ord('a') :
+                              m/^[A-Z]/ ? ord($&)-ord('A')+26 :
+                              m/^[0-9]/ ? ord($&)-ord('0')+52 :
+                              die "$_ ?";
+                       if ($v >= $base) {
+                               push @outuid, 0;
+                               $v -= $base;
+                               $mul= 1;
+#print STDERR "(next)\n";
+                       }
+                       die "$f->{UidShort} $_ ?" unless defined $mul;
+                       $outuid[$#outuid] += $v * $mul;
+
+#print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
+#                      "[vs.".ord('a').",".ord('A').",".ord('0')."]".
+#                      "  outuid=@outuid\n";
+
+                       $mul *= $base;
+                       s/^.//;
+               }
+               my $recons_long= join '_', @outuid;
+               $f->{UidLong} eq $recons_long or
+                       die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
+       }
+
+       if ($qa->{"R$f->{UidShort}"} && !$qa->{"T$f->{UidShort}"}) {
+               $f->{Suppress}= 1;
        }
-       $f->{Uid}= join '_', @uid;
 
        push @flows, $f;
 
@@ -223,13 +296,19 @@ Maximize
 
   totalprofit:
                   ".(join " +
-                  ", map { "$_->{unit_profit} $_->{Var}" } @flows)."
+                  ", map { "$_->{unitprofit} $_->{Var}" } @flows)."
 
 Subject To
 ";
 
 my %avail_csts;
 foreach my $flow (@flows) {
+       if ($flow->{Suppress}) {
+               $cplex .= "
+   $flow->{Var} = 0
+";
+               next;
+       }
        foreach my $od (qw(org dst)) {
                my $cstname= join '_', (
                        'avail',
@@ -300,9 +379,12 @@ if ($qa->{'debug'}) {
        die unless $found_section;
 };
 
-print join ' ', map { $_->{Optimal} } @flows;
-
-push @columns, qw(OptQty OptCapital OptProfit);
+$addcols->({}, qw(
+               OptQty
+       ));
+$addcols->({ Total => 0 }, qw(
+               OptCapital OptProfit
+       ));
 
 </%perl>
 
@@ -311,8 +393,20 @@ push @columns, qw(OptQty OptCapital OptProfit);
 % {
 %      my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 %      my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
-<table>
+<table rules=groups>
+<colgroup span=1>
+<colgroup span=2>
+<% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
+<colgroup span=1>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=3>
+%      if ($optimise) {
+<colgroup span=3>
+%      }
 <tr>
+<th>
 <th<% $cdspan %>>Collect
 <th<% $cdspan %>>Deliver
 <th>
@@ -325,15 +419,16 @@ push @columns, qw(OptQty OptCapital OptProfit);
 %      }
 
 <tr>
+<th>
 <th>Island <% $cdstall %>
 <th>Island <% $cdstall %>
 <th>Commodity
-<th>Price
 <th>Qty
 <th>Price
 <th>Qty
-<th>Unit
+<th>Price
 <th>Margin
+<th>Unit
 <th>Qty
 <th>Capital
 <th>Profit
@@ -346,12 +441,31 @@ push @columns, qw(OptQty OptCapital OptProfit);
 
 % foreach my $flow (@flows) {
 <tr>
-%      foreach my $col (@columns) {
-<td><% $flow->{$col} |h %>
+<td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
+    <input type=checkbox name=T<% $flow->{UidShort} %> value=""
+       <% $flow->{Suppress} ? '' : 'checked' %> >
+%      foreach my $ci (0..$#cols) {
+%              my $col= $cols[$ci];
+%              my $v= $flow->{$col->{Name}};
+%              $col->{Total} += $v if defined $col->{Total};
+%              $v='' if !$col->{Text} && !$v;
+<td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
+%      }
+% }
+<tr>
+<th>
+<th colspan=2>Total
+% foreach my $ci (2..$#cols) {
+%      my $col= $cols[$ci];
+<td align=right>
+%      if (defined $col->{Total}) {
+<% $col->{Total} |h %>
 %      }
 % }
 </table>
 
+<input type=submit name=update value="Update">
+
 <%init>
 use CommodsWeb;
 use Commods;