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