yarrg/web/routetrade

   1 <%doc>
   2
   3  This is part of the YARRG website.  YARRG is a tool and website
   4  for assisting players of Yohoho Puzzle Pirates.
   5
   6  Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   7  Copyright (C) 2009 Clare Boothby
   8
   9   YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
  10   The YARRG website is covered by the GNU Affero GPL v3 or later, which
  11    basically means that every installation of the website will let you
  12    download the source.
  13
  14  This program is free software: you can redistribute it and/or modify
  15  it under the terms of the GNU Affero General Public License as
  16  published by the Free Software Foundation, either version 3 of the
  17  License, or (at your option) any later version.
  18
  19  This program is distributed in the hope that it will be useful,
  20  but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  GNU Affero General Public License for more details.
  23
  24  You should have received a copy of the GNU Affero General Public License
  25  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26
  27  Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  28  are used without permission.  This program is not endorsed or
  29  sponsored by Three Rings.
  30
  31
  32  This Mason component is the core trade planner for a specific route.
  33
  34
  35 </%doc>
  36 <%args>
  37 $dbh
  38 @islandids
  39 @archipelagoes
  40 $qa
  41 $max_mass
  42 $max_volume
  43 </%args>
  44 <&| script &>
  45   da_pageload= Date.now();
  46 </&script>
  47
  48 % if (defined $max_mass || defined $max_volume) {
  49 <strong>WARNING - VESSEL CAPACITY LIMIT NOT YET IMPLEMENTED</strong>
  50 <p>
  51 % }
  52
  53 <%perl>
  54
  55 my $now= time;
  56 my $loss_per_league= 1e-7;
  57
  58 my @flow_conds;
  59 my @query_params;
  60 my %dists;
  61
  62 my $sd_condition= sub {
  63         my ($bs, $ix) = @_;
  64         my $islandid= $islandids[$ix];
  65         if (defined $islandid) {
  66                 return "${bs}.islandid = $islandid";
  67         } else {
  68                 push @query_params, $archipelagoes[$ix];
  69                 return "${bs}_islands.archipelago = ?";
  70         }
  71 };
  72
  73 my %islandpair;
  74 # $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
  75
  76 my $specific= !grep { !defined $_ } @islandids;
  77 my $confusing= 0;
  78
  79 foreach my $src_i (0..$#islandids) {
  80         my $src_isle= $islandids[$src_i];
  81         my $src_cond= $sd_condition->('sell',$src_i);
  82         my @dst_conds;
  83         foreach my $dst_i ($src_i..$#islandids) {
  84                 my $dst_isle= $islandids[$dst_i];
  85                 my $dst_cond= $sd_condition->('buy',$dst_i);
  86                 if ($dst_i==$src_i and !defined $src_isle) {
  87                         # we always want arbitrage, but mentioning an arch
  88                         # once shouldn't produce intra-arch trades
  89                         $dst_cond=
  90                                 "($dst_cond AND sell.islandid = buy.islandid)";
  91                 }
  92                 push @dst_conds, $dst_cond;
  93
  94                 if ($specific && !$confusing &&
  95                     # With a circular route, do not carry goods round the loop
  96                     !(($src_i==0 || $src_i==$#islandids) &&
  97                       $dst_i==$#islandids &&
  98                       $src_isle == $islandids[$dst_i])) {
  99                         if ($islandpair{$src_isle,$dst_isle}) {
 100                                 $confusing= 1;
 101 print "confusing $src_i $src_isle  $dst_i $dst_isle\n";
 102                         } else {
 103                                 $islandpair{$src_isle,$dst_isle}=
 104                                         [ $src_i, $dst_i ];
 105                         }
 106                 }
 107         }
 108         push @flow_conds, "$src_cond AND (
 109                         ".join("
 110                      OR ",@dst_conds)."
 111                 )";
 112 }
 113
 114 my $stmt= "
 115         SELECT  sell_islands.islandname                         org_name,
 116                 sell_islands.islandid                           org_id,
 117                 sell.price                                      org_price,
 118                 sell.qty                                        org_qty_stall,
 119                 sell_stalls.stallname                           org_stallname,
 120                 sell.stallid                                    org_stallid,
 121                 sell_uploads.timestamp                          org_timestamp,
 122                 buy_islands.islandname                          dst_name,
 123                 buy_islands.islandid                            dst_id,
 124                 buy.price                                       dst_price,
 125                 buy.qty                                         dst_qty_stall,
 126                 buy_stalls.stallname                            dst_stallname,
 127                 buy.stallid                                     dst_stallid,
 128                 buy_uploads.timestamp                           dst_timestamp,
 129 ".($qa->{ShowStalls} ? "
 130                 sell.qty                                        org_qty_agg,
 131                 buy.qty                                         dst_qty_agg,
 132 " : "
 133                 (SELECT sum(qty) FROM sell AS sell_agg
 134                   WHERE sell_agg.commodid = commods.commodid
 135                   AND   sell_agg.islandid = sell.islandid
 136                   AND   sell_agg.price = sell.price)            org_qty_agg,
 137                 (SELECT sum(qty) FROM buy AS buy_agg
 138                   WHERE buy_agg.commodid = commods.commodid
 139                   AND   buy_agg.islandid = buy.islandid
 140                   AND   buy_agg.price = buy.price)              dst_qty_agg,
 141 ")."
 142                 commods.commodname                              commodname,
 143                 commods.commodid                                commodid,
 144                 commods.unitmass                                unitmass,
 145                 commods.unitvolume                              unitvolume,
 146                 dist                                            dist,
 147                 buy.price - sell.price                          unitprofit
 148         FROM commods
 149         JOIN sell ON commods.commodid = sell.commodid
 150         JOIN buy  ON commods.commodid = buy.commodid
 151         JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
 152         JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
 153         JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
 154         JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
 155         JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
 156         JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
 157         JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 158         WHERE   (
 159                 ".join("
 160            OR   ", @flow_conds)."
 161         )
 162           AND   buy.price > sell.price
 163         ORDER BY org_name, dst_name, commodname, unitprofit DESC,
 164                  org_price, dst_price DESC,
 165                  org_stallname, dst_stallname
 166      ";
 167
 168 my $sth= $dbh->prepare($stmt);
 169 $sth->execute(@query_params);
 170 my @flows;
 171
 172 my $distquery= $dbh->prepare("
 173                 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
 174                 ");
 175 my $distance= sub {
 176         my ($from,$to)= @_;
 177         my $d= $dists{$from}{$to};
 178         return $d if defined $d;
 179         $distquery->execute($from,$to);
 180         $d = $distquery->fetchrow_array();
 181         defined $d or die "$from $to ?";
 182         $dists{$from}{$to}= $d;
 183         return $d;
 184 };
 185
 186 my @cols= ({ NoSort => 1 });
 187
 188 my $addcols= sub {
 189         my $base= shift @_;
 190         foreach my $name (@_) {
 191                 my $col= { Name => $name, %$base };
 192                 $col->{Numeric}=1 if !$col->{Text};
 193                 push @cols, $col;
 194         }
 195 };
 196
 197 if ($qa->{ShowStalls}) {
 198         $addcols->({ Text => 1 }, qw(
 199                 org_name org_stallname
 200                 dst_name dst_stallname
 201         ));
 202 } else {
 203         $addcols->({Text => 1 }, qw(
 204                 org_name dst_name
 205         ));
 206 }
 207 $addcols->({ Text => 1 }, qw(commodname));
 208 $addcols->({ DoReverse => 1 },
 209         qw(     org_price org_qty_agg dst_price dst_qty_agg
 210         ));
 211 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
 212         qw(     Margin
 213         ));
 214 $addcols->({ DoReverse => 1 },
 215         qw(     unitprofit MaxQty MaxCapital MaxProfit dist
 216         ));
 217 foreach my $v (qw(MaxMass MaxVolume)) {
 218    $addcols->({
 219         DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
 220 }
 221
 222 </%perl>
 223
 224 % if ($qa->{'debug'}) {
 225 <pre>
 226 <% $stmt |h %>
 227 <% join(' | ',@query_params) |h %>
 228 </pre>
 229 % }
 230
 231 <& dumptable:start, qa => $qa, sth => $sth &>
 232 % {
 233 %   my $got;
 234 %   while ($got= $sth->fetchrow_hashref()) {
 235 <%perl>
 236
 237         my $f= $flows[$#flows];
 238         if (    !$f ||
 239                 $qa->{ShowStalls} ||
 240                 grep { $f->{$_} ne $got->{$_} }
 241                         qw(org_id org_price dst_id dst_price commodid)
 242         ) {
 243                 # Make a new flow rather than adding to the existing one
 244
 245                 $f= {
 246                         Ix => scalar(@flows),
 247                         Var => "f".@flows,
 248                         %$got
 249                 };
 250                 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
 251                         if !$qa->{ShowStalls};
 252                 push @flows, $f;
 253         }
 254         foreach my $od (qw(org dst)) {
 255                 $f->{"${od}Stalls"}{
 256                         $got->{"${od}_stallname"}
 257                     } =
 258                         $got->{"${od}_qty_stall"}
 259                     ;
 260         }
 261
 262 </%perl>
 263 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 264 %    }
 265 <& dumptable:end, qa => $qa &>
 266 % }
 267
 268 <%perl>
 269
 270 if (!@flows) {
 271         print 'No profitable trading opportunities were found.';
 272         return;
 273 }
 274
 275 foreach my $f (@flows) {
 276
 277         $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
 278                 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
 279         $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
 280         $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 281
 282         $f->{MaxMassSortKey}= $f->{MaxQty} * $f->{'unitmass'};
 283         $f->{MaxVolumeSortKey}= $f->{MaxQty} * $f->{'unitvolume'};
 284         foreach my $v (qw(Mass Volume)) {
 285                 $f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6;
 286         }
 287
 288         $f->{MarginSortKey}= sprintf "%d",
 289                 $f->{'dst_price'} * 10000 / $f->{'org_price'};
 290         $f->{Margin}= sprintf "%3.1f%%",
 291                 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 292
 293         $f->{ExpectedUnitProfit}=
 294                 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 295                 - $f->{'org_price'};
 296
 297         $dists{'org_id'}{'dst_id'}= $f->{'dist'};
 298
 299         my @uid= $f->{commodid};
 300         foreach my $od (qw(org dst)) {
 301                 push @uid,
 302                         $f->{"${od}_id"},
 303                         $f->{"${od}_price"};
 304                 push @uid,
 305                         $f->{"${od}_stallid"}
 306                                 if $qa->{ShowStalls};
 307         }
 308         $f->{UidLong}= join '_', @uid;
 309
 310         my $base= 31;
 311         my $cmpu= '';
 312         map {
 313                 my $uue= $_;
 314                 my $first= $base;
 315                 do {
 316                         my $this= $uue % $base;
 317 print STDERR "uue=$uue this=$this ";
 318                         $uue -= $this;
 319                         $uue /= $base;
 320                         $this += $first;
 321                         $first= 0;
 322                         $cmpu .= chr($this + ($this < 26 ? ord('a') :
 323                                               $this < 52 ? ord('A')-26
 324                                                          : ord('0')-52));
 325 print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
 326 die "$cmpu $uue ?" if length $cmpu > 20;
 327                 } while ($uue);
 328                 $cmpu;
 329         } @uid;
 330         $f->{UidShort}= $cmpu;
 331
 332         if ($qa->{'debug'}) {
 333                 my @outuid;
 334                 $_= $f->{UidShort};
 335                 my $mul;
 336                 while (m/./) {
 337                         my $v= m/^[a-z]/ ? ord($&)-ord('a') :
 338                                m/^[A-Z]/ ? ord($&)-ord('A')+26 :
 339                                m/^[0-9]/ ? ord($&)-ord('0')+52 :
 340                                die "$_ ?";
 341                         if ($v >= $base) {
 342                                 push @outuid, 0;
 343                                 $v -= $base;
 344                                 $mul= 1;
 345 #print STDERR "(next)\n";
 346                         }
 347                         die "$f->{UidShort} $_ ?" unless defined $mul;
 348                         $outuid[$#outuid] += $v * $mul;
 349
 350 #print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
 351 #                       "[vs.".ord('a').",".ord('A').",".ord('0')."]".
 352 #                       "  outuid=@outuid\n";
 353
 354                         $mul *= $base;
 355                         s/^.//;
 356                 }
 357                 my $recons_long= join '_', @outuid;
 358                 $f->{UidLong} eq $recons_long or
 359                         die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 360         }
 361
 362         if (defined $qa->{"R$f->{UidShort}"} &&
 363             !defined $qa->{"T$f->{UidShort}"}) {
 364                 $f->{Suppress}= 1;
 365         }
 366
 367 }
 368 </%perl>
 369
 370 % my $optimise= $specific && !$confusing && @islandids>1;
 371 % if (!$optimise) {
 372
 373 <p>
 374 % if (@islandids<=1) {
 375 Route is trivial.
 376 % }
 377 % if (!$specific) {
 378 Route contains archipelago(es), not just specific islands.
 379 % }
 380 % if ($confusing) {
 381 Route is complex - it visits the same island several times
 382 and isn't a simple loop.
 383 % }
 384 Therefore, optimal voyage trade plan not calculated.
 385
 386 % } else { # ========== OPTMISATION ==========
 387 <%perl>
 388
 389 my $cplex= "
 390 Maximize
 391
 392   totalprofit:
 393                   ".(join " +
 394                   ", map {
 395                         sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
 396                         } @flows)."
 397
 398 Subject To
 399 ";
 400
 401 my %avail_csts;
 402 foreach my $flow (@flows) {
 403         if ($flow->{Suppress}) {
 404                 $cplex .= "
 405    $flow->{Var} = 0
 406 ";
 407                 next;
 408         }
 409         foreach my $od (qw(org dst)) {
 410                 my $cstname= join '_', (
 411                         'avail',
 412                         $flow->{'commodid'},
 413                         $od,
 414                         $flow->{"${od}_id"},
 415                         $flow->{"${od}_price"},
 416                         $flow->{"${od}_stallid"},
 417                 );
 418
 419                 push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
 420                 $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
 421         }
 422 }
 423 foreach my $cstname (sort keys %avail_csts) {
 424         my $c= $avail_csts{$cstname};
 425         $cplex .= "
 426    ".   sprintf("%-30s","$cstname:")." ".
 427         join("+", @{ $c->{Flows} }).
 428         " <= ".$c->{Qty}."\n";
 429 }
 430
 431 $cplex.= "
 432 Bounds
 433         ".(join "
 434         ", map { "$_->{Var} >= 0" } @flows)."
 435
 436 End
 437 ";
 438
 439 if ($qa->{'debug'}) {
 440 </%perl>
 441 <pre>
 442 <% $cplex |h %>
 443 </pre>
 444 <%perl>
 445 }
 446
 447 {
 448         my $input= pipethrough_prep();
 449         print $input $cplex or die $!;
 450         my $output= pipethrough_run_along($input, undef, 'glpsol',
 451                 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
 452         print "<pre>\n" if $qa->{'debug'};
 453         my $found_section= 0;
 454         my $glpsol_out= '';
 455         while (<$output>) {
 456                 $glpsol_out.= $_;
 457                 print encode_entities($_) if $qa->{'debug'};
 458                 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
 459                         die if $found_section>0;
 460                         $found_section= 1;
 461                         next;
 462                 }
 463                 next unless $found_section==1;
 464                 next if m/^[- ]+$/;
 465                 if (!/\S/) {
 466                         $found_section= 2;
 467                         next;
 468                 }
 469                 my ($ix, $qty) =
 470                         m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
 471                 my $flow= $flows[$ix] or die;
 472                 $flow->{OptQty}= $qty;
 473                 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 474                 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 475         }
 476         print "</pre>\n" if $qa->{'debug'};
 477         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 478         pipethrough_run_finish($output,$prerr);
 479         die $prerr unless $found_section;
 480 };
 481
 482 $addcols->({ DoReverse => 1 }, qw(
 483                 OptQty
 484         ));
 485 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 486                 OptCapital OptProfit
 487         ));
 488
 489 </%perl>
 490
 491 % } # ========== OPTIMISATION ==========
 492
 493 % my %ts_sortkeys;
 494 % {
 495 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 496 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 497 <table id="trades" rules=groups>
 498 <colgroup span=1>
 499 <colgroup span=2>
 500 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 501 <colgroup span=1>
 502 <colgroup span=2>
 503 <colgroup span=2>
 504 <colgroup span=2>
 505 <colgroup span=3>
 506 <colgroup span=3>
 507 %       if ($optimise) {
 508 <colgroup span=3>
 509 %       }
 510 <tr class="spong">
 511 <th>
 512 <th<% $cdspan %>>Collect
 513 <th<% $cdspan %>>Deliver
 514 <th>
 515 <th colspan=2>Collect
 516 <th colspan=2>Deliver
 517 <th colspan=2>Profit
 518 <th colspan=3>Max
 519 <th colspan=1>
 520 <th colspan=2>Max
 521 %       if ($optimise) {
 522 <th colspan=3>Planned
 523 %       }
 524
 525 <tr>
 526 <th>
 527 <th>Island <% $cdstall %>
 528 <th>Island <% $cdstall %>
 529 <th>Commodity
 530 <th>Price
 531 <th>Qty
 532 <th>Price
 533 <th>Qty
 534 <th>Margin
 535 <th>Unit
 536 <th>Qty
 537 <th>Capital
 538 <th>Profit
 539 <th>Dist
 540 <th>Mass
 541 <th>Vol
 542 %       if ($optimise) {
 543 <th>Qty
 544 <th>Capital
 545 <th>Profit
 546 %       }
 547 % }
 548
 549 <tr id="trades_sort">
 550 % foreach my $col (@cols) {
 551 <th>
 552 % }
 553
 554 % foreach my $flowix (0..$#flows) {
 555 %       my $flow= $flows[$flowix];
 556 %       my $rowid= "id_row_$flow->{UidShort}";
 557 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 558 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 559     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 560        <% $flow->{Suppress} ? '' : 'checked' %> >
 561 %       foreach my $ci (1..$#cols) {
 562 %               my $col= $cols[$ci];
 563 %               my $v= $flow->{$col->{Name}};
 564 %               $col->{Total} += $v
 565 %                       if defined $col->{Total} and not $flow->{Suppress};
 566 %               $v='' if !$col->{Text} && !$v;
 567 %               my $sortkey= $col->{SortColKey} ?
 568 %                       $flow->{$col->{SortColKey}} : $v;
 569 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 570 <td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
 571 %       }
 572 % }
 573 <tr id="trades_total">
 574 <th>
 575 <th colspan=2>Total
 576 % foreach my $ci (3..$#cols) {
 577 %       my $col= $cols[$ci];
 578 <td align=right>
 579 %       if (defined $col->{Total}) {
 580 <% $col->{Total} |h %>
 581 %       }
 582 % }
 583 </table>
 584
 585 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 586         throw => 'trades_sort', tbrow => 'trades_total' &>
 587   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 588 </&tabsort>
 589
 590 <input type=submit name=update value="Update">
 591
 592 % if ($optimise) { # ========== TRADING PLAN ==========
 593 %
 594 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 595 %                               WHERE islandid = ?');
 596 % my %da_ages;
 597 % my $total_total= 0;
 598 % my $total_dist= 0;
 599 %
 600 <h1>Voyage trading plan</h1>
 601 <table rules=groups>
 602 % foreach my $i (0..$#islandids) {
 603 <tbody>
 604 <tr><td colspan=3>
 605 %       $iquery->execute($islandids[$i]);
 606 %       my ($islandname) = $iquery->fetchrow_array();
 607 %       if (!$i) {
 608 <strong>Start at <% $islandname |h %></strong>
 609 %       } else {
 610 %               my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
 611 %               $total_dist += $this_dist;
 612 <strong>Sail to <% $islandname |h %></strong>
 613 - <% $this_dist |h %> leagues </td>
 614 %       }
 615 <%perl>
 616      my $age_reported= 0;
 617      my %flowlists;
 618      foreach my $od (qw(org dst)) {
 619         foreach my $f (@flows) {
 620                 next if $f->{Suppress};
 621                 next unless $f->{"${od}_id"} == $islandids[$i];
 622                 next unless $f->{OptQty};
 623                 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
 624                 my $loop= $islandids[0] == $islandids[-1] &&
 625                           ($i==0 || $i==$#islandids);
 626                 next if $loop and ($arbitrage ? $i :
 627                         !!$i == !!($od eq 'org'));
 628                 my $price= $f->{"${od}_price"};
 629                 my $stallname= $f->{"${od}_stallname"};
 630                 my $todo= \$flowlists{$od}{
 631                                 $f->{'commodname'},
 632                                 (sprintf "%07d", ($od eq 'dst' ?
 633                                                 9999999-$price : $price)),
 634                                 $stallname
 635                         };
 636                 $$todo= {
 637                         Qty => 0,
 638                         orgArbitrage => 0,
 639                         dstArbitrage => 0,
 640                 } unless $$todo;
 641                 $$todo->{'commodname'}= $f->{'commodname'};
 642                 $$todo->{'stallname'}= $stallname;
 643                 $$todo->{Price}= $price;
 644                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 645                 $$todo->{Qty} += $f->{OptQty};
 646                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 647                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 648                 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
 649         }
 650      }
 651
 652      my $total;
 653      my $dline= 0;
 654      my $show_flows= sub {
 655         my ($od,$arbitrage,$collectdeliver) = @_;
 656 </%perl>
 657 %
 658 %       my $todo= $flowlists{$od};
 659 %       return unless $todo;
 660 %       foreach my $tkey (sort keys %$todo) {
 661 %               my $t= $todo->{$tkey};
 662 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 663 %               if (!$age_reported++) {
 664 %                       my $age= $now - $t->{Timestamp};
 665 %                       my $cellid= "da_${i}";
 666 %                       $da_ages{$cellid}= $age;
 667 <td colspan=3>\
 668 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 669 %               } elsif (!defined $total) {
 670 %                       $total= 0;
 671 <tbody>
 672 %               }
 673 %               $total += $t->{Total};
 674 %               my $span= 0 + keys %{ $t->{Stalls} };
 675 %               my $td= "td rowspan=$span";
 676 <tr class="datarow<% $dline %>">
 677 <<% $td %>><% $collectdeliver %>
 678 <<% $td %>><% $t->{'commodname'} |h %>
 679 %
 680 %               my @stalls= sort keys %{ $t->{Stalls} };
 681 %               my $pstall= sub {
 682 %                       my $name= $stalls[$_[0]];
 683 <td><% $name |h %>
 684 %               };
 685 %
 686 %               $pstall->(0);
 687 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 688 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 689 <<% $td %> align=right><% $t->{Total} |h %> total
 690 %
 691 %               foreach my $stallix (1..$#stalls) {
 692 <tr class="datarow<% $dline %>">
 693 %                       $pstall->($stallix);
 694 %               }
 695 %
 696 %               $dline ^= 1;
 697 %       }
 698 %    };
 699 %    my $show_total= sub {
 700 %       my ($totaldesc, $sign)= @_;
 701 %       if (defined $total) {
 702 <tr>
 703 <td colspan=3>
 704 <td colspan=2 align=right><% $totaldesc %>
 705 <td align=right><% $total |h %> total
 706 %               $total_total += $sign * $total;
 707 %       }
 708 %       $total= undef;
 709 %       $dline= 0;
 710 <%perl>
 711      };
 712
 713      $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
 714      $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
 715      $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
 716      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
 717
 718 }
 719 </%perl>
 720 <tbody><tr>
 721 <td colspan=2>Total distance: <% $total_dist %> leagues.
 722 <td colspan=3 align=right>Overall net cash flow
 723 <td align=right><strong><%
 724   $total_total < 0 ? -$total_total." loss" : $total_total." gain"
 725  %></strong>
 726 </table>
 727 <& query_age:dataages, id2age => \%da_ages &>
 728 %
 729 % } # ========== TRADING PLAN ==========
 730
 731 <%init>
 732 use CommodsWeb;
 733 use Commods;
 734 </%init>