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 dist MaxQty
 209                 MaxCapital MaxProfit
 210         ));
 211
 212 </%perl>
 213
 214 % if ($qa->{'debug'}) {
 215 <pre>
 216 <% $stmt |h %>
 217 <% join(' | ',@query_params) |h %>
 218 </pre>
 219 % }
 220
 221 <& dumptable:start, qa => $qa, sth => $sth &>
 222 % {
 223 %   my $got;
 224 %   while ($got= $sth->fetchrow_hashref()) {
 225 <%perl>
 226
 227         my $f= $flows[$#flows];
 228         if (    !$f ||
 229                 $qa->{ShowStalls} ||
 230                 grep { $f->{$_} ne $got->{$_} }
 231                         qw(org_id org_price dst_id dst_price commodid)
 232         ) {
 233                 # Make a new flow rather than adding to the existing one
 234
 235                 $f= {
 236                         Ix => scalar(@flows),
 237                         Var => "f".@flows,
 238                         %$got
 239                 };
 240                 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
 241                         if !$qa->{ShowStalls};
 242                 push @flows, $f;
 243         }
 244         foreach my $od (qw(org dst)) {
 245                 $f->{"${od}Stalls"}{
 246                         $got->{"${od}_stallname"}
 247                     } =
 248                         $got->{"${od}_qty_stall"}
 249                     ;
 250         }
 251
 252 </%perl>
 253 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 254 %    }
 255 <& dumptable:end, qa => $qa &>
 256 % }
 257
 258 <%perl>
 259
 260 if (!@flows) {
 261         print 'No profitable trading opportunities were found.';
 262         return;
 263 }
 264
 265 foreach my $f (@flows) {
 266
 267         $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
 268                 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
 269         $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
 270         $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 271
 272         $f->{MarginSortKey}= sprintf "%d",
 273                 $f->{'dst_price'} * 10000 / $f->{'org_price'};
 274         $f->{Margin}= sprintf "%3.1f%%",
 275                 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 276
 277         $f->{ExpectedUnitProfit}=
 278                 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 279                 - $f->{'org_price'};
 280
 281         $dists{'org_id'}{'dst_id'}= $f->{'dist'};
 282
 283         my @uid= $f->{commodid};
 284         foreach my $od (qw(org dst)) {
 285                 push @uid,
 286                         $f->{"${od}_id"},
 287                         $f->{"${od}_price"};
 288                 push @uid,
 289                         $f->{"${od}_stallid"}
 290                                 if $qa->{ShowStalls};
 291         }
 292         $f->{UidLong}= join '_', @uid;
 293
 294         my $base= 31;
 295         my $cmpu= '';
 296         map {
 297                 my $uue= $_;
 298                 my $first= $base;
 299                 do {
 300                         my $this= $uue % $base;
 301 print STDERR "uue=$uue this=$this ";
 302                         $uue -= $this;
 303                         $uue /= $base;
 304                         $this += $first;
 305                         $first= 0;
 306                         $cmpu .= chr($this + ($this < 26 ? ord('a') :
 307                                               $this < 52 ? ord('A')-26
 308                                                          : ord('0')-52));
 309 print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
 310 die "$cmpu $uue ?" if length $cmpu > 20;
 311                 } while ($uue);
 312                 $cmpu;
 313         } @uid;
 314         $f->{UidShort}= $cmpu;
 315
 316         if ($qa->{'debug'}) {
 317                 my @outuid;
 318                 $_= $f->{UidShort};
 319                 my $mul;
 320                 while (m/./) {
 321                         my $v= m/^[a-z]/ ? ord($&)-ord('a') :
 322                                m/^[A-Z]/ ? ord($&)-ord('A')+26 :
 323                                m/^[0-9]/ ? ord($&)-ord('0')+52 :
 324                                die "$_ ?";
 325                         if ($v >= $base) {
 326                                 push @outuid, 0;
 327                                 $v -= $base;
 328                                 $mul= 1;
 329 #print STDERR "(next)\n";
 330                         }
 331                         die "$f->{UidShort} $_ ?" unless defined $mul;
 332                         $outuid[$#outuid] += $v * $mul;
 333
 334 #print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
 335 #                       "[vs.".ord('a').",".ord('A').",".ord('0')."]".
 336 #                       "  outuid=@outuid\n";
 337
 338                         $mul *= $base;
 339                         s/^.//;
 340                 }
 341                 my $recons_long= join '_', @outuid;
 342                 $f->{UidLong} eq $recons_long or
 343                         die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 344         }
 345
 346         if (defined $qa->{"R$f->{UidShort}"} &&
 347             !defined $qa->{"T$f->{UidShort}"}) {
 348                 $f->{Suppress}= 1;
 349         }
 350
 351 }
 352 </%perl>
 353
 354 % my $optimise= $specific && !$confusing && @islandids>1;
 355 % if (!$optimise) {
 356
 357 <p>
 358 % if (@islandids<=1) {
 359 Route is trivial.
 360 % }
 361 % if (!$specific) {
 362 Route contains archipelago(es), not just specific islands.
 363 % }
 364 % if ($confusing) {
 365 Route is complex - it visits the same island several times
 366 and isn't a simple loop.
 367 % }
 368 Therefore, optimal voyage trade plan not calculated.
 369
 370 % } else { # ========== OPTMISATION ==========
 371 <%perl>
 372
 373 my $cplex= "
 374 Maximize
 375
 376   totalprofit:
 377                   ".(join " +
 378                   ", map {
 379                         sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
 380                         } @flows)."
 381
 382 Subject To
 383 ";
 384
 385 my %avail_csts;
 386 foreach my $flow (@flows) {
 387         if ($flow->{Suppress}) {
 388                 $cplex .= "
 389    $flow->{Var} = 0
 390 ";
 391                 next;
 392         }
 393         foreach my $od (qw(org dst)) {
 394                 my $cstname= join '_', (
 395                         'avail',
 396                         $flow->{'commodid'},
 397                         $od,
 398                         $flow->{"${od}_id"},
 399                         $flow->{"${od}_price"},
 400                         $flow->{"${od}_stallid"},
 401                 );
 402
 403                 push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
 404                 $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
 405         }
 406 }
 407 foreach my $cstname (sort keys %avail_csts) {
 408         my $c= $avail_csts{$cstname};
 409         $cplex .= "
 410    ".   sprintf("%-30s","$cstname:")." ".
 411         join("+", @{ $c->{Flows} }).
 412         " <= ".$c->{Qty}."\n";
 413 }
 414
 415 $cplex.= "
 416 Bounds
 417         ".(join "
 418         ", map { "$_->{Var} >= 0" } @flows)."
 419
 420 End
 421 ";
 422
 423 if ($qa->{'debug'}) {
 424 </%perl>
 425 <pre>
 426 <% $cplex |h %>
 427 </pre>
 428 <%perl>
 429 }
 430
 431 {
 432         my $input= pipethrough_prep();
 433         print $input $cplex or die $!;
 434         my $output= pipethrough_run_along($input, undef, 'glpsol',
 435                 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
 436         print "<pre>\n" if $qa->{'debug'};
 437         my $found_section= 0;
 438         my $glpsol_out= '';
 439         while (<$output>) {
 440                 $glpsol_out.= $_;
 441                 print encode_entities($_) if $qa->{'debug'};
 442                 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
 443                         die if $found_section>0;
 444                         $found_section= 1;
 445                         next;
 446                 }
 447                 next unless $found_section==1;
 448                 next if m/^[- ]+$/;
 449                 if (!/\S/) {
 450                         $found_section= 2;
 451                         next;
 452                 }
 453                 my ($ix, $qty) =
 454                         m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
 455                 my $flow= $flows[$ix] or die;
 456                 $flow->{OptQty}= $qty;
 457                 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 458                 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 459         }
 460         print "</pre>\n" if $qa->{'debug'};
 461         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 462         pipethrough_run_finish($output,$prerr);
 463         die $prerr unless $found_section;
 464 };
 465
 466 $addcols->({ DoReverse => 1 }, qw(
 467                 OptQty
 468         ));
 469 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 470                 OptCapital OptProfit
 471         ));
 472
 473 </%perl>
 474
 475 % } # ========== OPTIMISATION ==========
 476
 477 % my %ts_sortkeys;
 478 % {
 479 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 480 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 481 <table id="trades" rules=groups>
 482 <colgroup span=1>
 483 <colgroup span=2>
 484 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 485 <colgroup span=1>
 486 <colgroup span=2>
 487 <colgroup span=2>
 488 <colgroup span=2>
 489 <colgroup span=1>
 490 <colgroup span=3>
 491 %       if ($optimise) {
 492 <colgroup span=3>
 493 %       }
 494 <tr class="spong">
 495 <th>
 496 <th<% $cdspan %>>Collect
 497 <th<% $cdspan %>>Deliver
 498 <th>
 499 <th colspan=2>Collect
 500 <th colspan=2>Deliver
 501 <th colspan=2>Profit
 502 <th colspan=1>
 503 <th colspan=3>Max
 504 %       if ($optimise) {
 505 <th colspan=3>Planned
 506 %       }
 507
 508 <tr>
 509 <th>
 510 <th>Island <% $cdstall %>
 511 <th>Island <% $cdstall %>
 512 <th>Commodity
 513 <th>Price
 514 <th>Qty
 515 <th>Price
 516 <th>Qty
 517 <th>Margin
 518 <th>Unit
 519 <th>Dist
 520 <th>Qty
 521 <th>Capital
 522 <th>Profit
 523 %       if ($optimise) {
 524 <th>Qty
 525 <th>Capital
 526 <th>Profit
 527 %       }
 528 % }
 529
 530 <tr id="trades_sort">
 531 % foreach my $col (@cols) {
 532 <th>
 533 % }
 534
 535 % foreach my $flowix (0..$#flows) {
 536 %       my $flow= $flows[$flowix];
 537 %       my $rowid= "id_row_$flow->{UidShort}";
 538 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 539 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 540     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 541        <% $flow->{Suppress} ? '' : 'checked' %> >
 542 %       foreach my $ci (1..$#cols) {
 543 %               my $col= $cols[$ci];
 544 %               my $v= $flow->{$col->{Name}};
 545 %               $col->{Total} += $v if defined $col->{Total};
 546 %               $v='' if !$col->{Text} && !$v;
 547 %               my $sortkey= $col->{SortColKey} ?
 548 %                       $flow->{$col->{SortColKey}} : $v;
 549 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 550 <td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
 551 %       }
 552 % }
 553 <tr id="trades_total">
 554 <th>
 555 <th colspan=2>Total
 556 % foreach my $ci (3..$#cols) {
 557 %       my $col= $cols[$ci];
 558 <td align=right>
 559 %       if (defined $col->{Total}) {
 560 <% $col->{Total} |h %>
 561 %       }
 562 % }
 563 </table>
 564
 565 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 566         throw => 'trades_sort', tbrow => 'trades_total' &>
 567   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 568 </&tabsort>
 569
 570 <input type=submit name=update value="Update">
 571
 572 % if ($optimise) { # ========== TRADING PLAN ==========
 573 %
 574 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 575 %                               WHERE islandid = ?');
 576 % my %da_ages;
 577 % my $total_total= 0;
 578 % my $total_dist= 0;
 579 %
 580 <h1>Voyage trading plan</h1>
 581 <table rules=groups>
 582 % foreach my $i (0..$#islandids) {
 583 <tbody>
 584 <tr><td colspan=3>
 585 %       $iquery->execute($islandids[$i]);
 586 %       my ($islandname) = $iquery->fetchrow_array();
 587 %       my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
 588 %       $total_dist += $this_dist;
 589 %       if (!$i) {
 590 <strong>Start at <% $islandname |h %></strong>
 591 %       } else {
 592 <strong>Sail to <% $islandname |h %></strong>
 593 - <% $this_dist |h %> leagues </td>
 594 %       }
 595 <%perl>
 596      my $age_reported= 0;
 597      my %flowlists;
 598      foreach my $od (qw(org dst)) {
 599         foreach my $f (@flows) {
 600                 next if $f->{Suppress};
 601                 next unless $f->{"${od}_id"} == $islandids[$i];
 602                 next unless $f->{OptQty};
 603                 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
 604                 my $loop= $islandids[0] == $islandids[-1] &&
 605                           ($i==0 || $i==$#islandids);
 606                 next if $loop and ($arbitrage ? $i :
 607                         !!$i == !!($od eq 'org'));
 608                 my $price= $f->{"${od}_price"};
 609                 my $stallname= $f->{"${od}_stallname"};
 610                 my $todo= \$flowlists{$od}{
 611                                 $f->{'commodname'},
 612                                 (sprintf "%07d", ($od eq 'dst' ?
 613                                                 9999999-$price : $price)),
 614                                 $stallname
 615                         };
 616                 $$todo= {
 617                         Qty => 0,
 618                         orgArbitrage => 0,
 619                         dstArbitrage => 0,
 620                 } unless $$todo;
 621                 $$todo->{'commodname'}= $f->{'commodname'};
 622                 $$todo->{'stallname'}= $stallname;
 623                 $$todo->{Price}= $price;
 624                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 625                 $$todo->{Qty} += $f->{OptQty};
 626                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 627                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 628                 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
 629         }
 630      }
 631
 632      my $total;
 633      my $dline= 0;
 634      my $show_flows= sub {
 635         my ($od,$arbitrage,$collectdeliver) = @_;
 636 </%perl>
 637 %
 638 %       my $todo= $flowlists{$od};
 639 %       return unless $todo;
 640 %       foreach my $tkey (sort keys %$todo) {
 641 %               my $t= $todo->{$tkey};
 642 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 643 %               if (!$age_reported++) {
 644 %                       my $age= $now - $t->{Timestamp};
 645 %                       my $cellid= "da_${i}";
 646 %                       $da_ages{$cellid}= $age;
 647 <td colspan=3>\
 648 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 649 %               } elsif (!defined $total) {
 650 %                       $total= 0;
 651 <tbody>
 652 %               }
 653 %               $total += $t->{Total};
 654 %               my $span= 0 + keys %{ $t->{Stalls} };
 655 %               my $td= "td rowspan=$span";
 656 <tr class="datarow<% $dline %>">
 657 <<% $td %>><% $collectdeliver %>
 658 <<% $td %>><% $t->{'commodname'} |h %>
 659 %
 660 %               my @stalls= sort keys %{ $t->{Stalls} };
 661 %               my $pstall= sub {
 662 %                       my $name= $stalls[$_[0]];
 663 <td><% $name |h %>
 664 %               };
 665 %
 666 %               $pstall->(0);
 667 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 668 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 669 <<% $td %> align=right><% $t->{Total} |h %> total
 670 %
 671 %               foreach my $stallix (1..$#stalls) {
 672 <tr class="datarow<% $dline %>">
 673 %                       $pstall->($stallix);
 674 %               }
 675 %
 676 %               $dline ^= 1;
 677 %       }
 678 %    };
 679 %    my $show_total= sub {
 680 %       my ($totaldesc, $sign)= @_;
 681 %       if (defined $total) {
 682 <tr>
 683 <td colspan=3>
 684 <td colspan=2 align=right><% $totaldesc %>
 685 <td align=right><% $total |h %> total
 686 %               $total_total += $sign * $total;
 687 %       }
 688 %       $total= undef;
 689 %       $dline= 0;
 690 <%perl>
 691      };
 692
 693      $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
 694      $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
 695      $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
 696      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
 697
 698 }
 699 </%perl>
 700 <tbody><tr>
 701 <td colspan=2>Total distance: <% $total_dist %> leagues.
 702 <td colspan=3 align=right>Overall net cash flow
 703 <td align=right><strong><%
 704   $total_total < 0 ? -$total_total." loss" : $total_total." gain"
 705  %></strong>
 706 </table>
 707 <& query_age:dataages, id2age => \%da_ages &>
 708 %
 709 % } # ========== TRADING PLAN ==========
 710
 711 <%init>
 712 use CommodsWeb;
 713 use Commods;
 714 </%init>