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