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 $max_capital
  45 </%args>
  46 <&| script &>
  47   da_pageload= Date.now();
  48 </&script>
  49
  50 <%perl>
  51
  52 my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
  53
  54 my $now= time;
  55
  56 my @flow_conds;
  57 my @query_params;
  58 my %dists;
  59
  60 my $sd_condition= sub {
  61         my ($bs, $ix) = @_;
  62         my $islandid= $islandids[$ix];
  63         if (defined $islandid) {
  64                 return "${bs}.islandid = $islandid";
  65         } else {
  66                 push @query_params, $archipelagoes[$ix];
  67                 return "${bs}_islands.archipelago = ?";
  68         }
  69 };
  70
  71 my %islandpair;
  72 # $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
  73
  74 my $specific= !grep { !defined $_ } @islandids;
  75 my $confusing= 0;
  76
  77 foreach my $src_i (0..$#islandids) {
  78         my $src_isle= $islandids[$src_i];
  79         my $src_cond= $sd_condition->('sell',$src_i);
  80         my @dst_conds;
  81         foreach my $dst_i ($src_i..$#islandids) {
  82                 my $dst_isle= $islandids[$dst_i];
  83                 my $dst_cond= $sd_condition->('buy',$dst_i);
  84                 if ($dst_i==$src_i and !defined $src_isle) {
  85                         # we always want arbitrage, but mentioning an arch
  86                         # once shouldn't produce intra-arch trades
  87                         $dst_cond=
  88                                 "($dst_cond AND sell.islandid = buy.islandid)";
  89                 }
  90                 push @dst_conds, $dst_cond;
  91
  92                 if ($specific && !$confusing &&
  93                     # With a circular route, do not carry goods round the loop
  94                     !(($src_i==0 || $src_i==$#islandids) &&
  95                       $dst_i==$#islandids &&
  96                       $src_isle == $islandids[$dst_i])) {
  97                         if ($islandpair{$src_isle,$dst_isle}) {
  98                                 $confusing= 1;
  99 print "confusing $src_i $src_isle  $dst_i $dst_isle\n";
 100                         } else {
 101                                 $islandpair{$src_isle,$dst_isle}=
 102                                         [ $src_i, $dst_i ];
 103                         }
 104                 }
 105         }
 106         push @flow_conds, "$src_cond AND (
 107                         ".join("
 108                      OR ",@dst_conds)."
 109                 )";
 110 }
 111
 112 my $stmt= "
 113         SELECT  sell_islands.islandname                         org_name,
 114                 sell_islands.islandid                           org_id,
 115                 sell.price                                      org_price,
 116                 sell.qty                                        org_qty_stall,
 117                 sell_stalls.stallname                           org_stallname,
 118                 sell.stallid                                    org_stallid,
 119                 sell_uploads.timestamp                          org_timestamp,
 120                 buy_islands.islandname                          dst_name,
 121                 buy_islands.islandid                            dst_id,
 122                 buy.price                                       dst_price,
 123                 buy.qty                                         dst_qty_stall,
 124                 buy_stalls.stallname                            dst_stallname,
 125                 buy.stallid                                     dst_stallid,
 126                 buy_uploads.timestamp                           dst_timestamp,
 127 ".($qa->{ShowStalls} ? "
 128                 sell.qty                                        org_qty_agg,
 129                 buy.qty                                         dst_qty_agg,
 130 " : "
 131                 (SELECT sum(qty) FROM sell AS sell_agg
 132                   WHERE sell_agg.commodid = commods.commodid
 133                   AND   sell_agg.islandid = sell.islandid
 134                   AND   sell_agg.price = sell.price)            org_qty_agg,
 135                 (SELECT sum(qty) FROM buy AS buy_agg
 136                   WHERE buy_agg.commodid = commods.commodid
 137                   AND   buy_agg.islandid = buy.islandid
 138                   AND   buy_agg.price = buy.price)              dst_qty_agg,
 139 ")."
 140                 commods.commodname                              commodname,
 141                 commods.commodid                                commodid,
 142                 commods.unitmass                                unitmass,
 143                 commods.unitvolume                              unitvolume,
 144                 dist                                            dist,
 145                 buy.price - sell.price                          unitprofit
 146         FROM commods
 147         JOIN sell ON commods.commodid = sell.commodid
 148         JOIN buy  ON commods.commodid = buy.commodid
 149         JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
 150         JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
 151         JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
 152         JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
 153         JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
 154         JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
 155         JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 156         WHERE   (
 157                 ".join("
 158            OR   ", @flow_conds)."
 159         )
 160           AND   buy.price > sell.price
 161         ORDER BY org_name, dst_name, commodname, unitprofit DESC,
 162                  org_price, dst_price DESC,
 163                  org_stallname, dst_stallname
 164      ";
 165
 166 my $sth= $dbh->prepare($stmt);
 167 $sth->execute(@query_params);
 168 my @flows;
 169
 170 my $distquery= $dbh->prepare("
 171                 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
 172                 ");
 173 my $distance= sub {
 174         my ($from,$to)= @_;
 175         my $d= $dists{$from}{$to};
 176         return $d if defined $d;
 177         $distquery->execute($from,$to);
 178         $d = $distquery->fetchrow_array();
 179         defined $d or die "$from $to ?";
 180         $dists{$from}{$to}= $d;
 181         return $d;
 182 };
 183
 184 my @cols= ({ NoSort => 1 });
 185
 186 my $addcols= sub {
 187         my $base= shift @_;
 188         foreach my $name (@_) {
 189                 my $col= { Name => $name, %$base };
 190                 $col->{Numeric}=1 if !$col->{Text};
 191                 push @cols, $col;
 192         }
 193 };
 194
 195 if ($qa->{ShowStalls}) {
 196         $addcols->({ Text => 1 }, qw(
 197                 org_name org_stallname
 198                 dst_name dst_stallname
 199         ));
 200 } else {
 201         $addcols->({Text => 1 }, qw(
 202                 org_name dst_name
 203         ));
 204 }
 205 $addcols->({ Text => 1 }, qw(commodname));
 206 $addcols->({ DoReverse => 1 },
 207         qw(     org_price org_qty_agg dst_price dst_qty_agg
 208         ));
 209 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
 210         qw(     Margin
 211         ));
 212 $addcols->({ DoReverse => 1 },
 213         qw(     unitprofit MaxQty MaxCapital MaxProfit dist
 214         ));
 215 foreach my $v (qw(MaxMass MaxVolume)) {
 216    $addcols->({
 217         DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
 218 }
 219
 220 </%perl>
 221
 222 % if ($qa->{'debug'}) {
 223 <pre>
 224 <% $stmt |h %>
 225 <% join(' | ',@query_params) |h %>
 226 </pre>
 227 % }
 228
 229 <& dumptable:start, qa => $qa, sth => $sth &>
 230 % {
 231 %   my $got;
 232 %   while ($got= $sth->fetchrow_hashref()) {
 233 <%perl>
 234
 235         my $f= $flows[$#flows];
 236         if (    !$f ||
 237                 $qa->{ShowStalls} ||
 238                 grep { $f->{$_} ne $got->{$_} }
 239                         qw(org_id org_price dst_id dst_price commodid)
 240         ) {
 241                 # Make a new flow rather than adding to the existing one
 242
 243                 $f= {
 244                         Ix => scalar(@flows),
 245                         Var => "f".@flows,
 246                         %$got
 247                 };
 248                 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
 249                         if !$qa->{ShowStalls};
 250                 push @flows, $f;
 251         }
 252         foreach my $od (qw(org dst)) {
 253                 $f->{"${od}Stalls"}{
 254                         $got->{"${od}_stallname"}
 255                     } =
 256                         $got->{"${od}_qty_stall"}
 257                     ;
 258         }
 259
 260 </%perl>
 261 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 262 %    }
 263 <& dumptable:end, qa => $qa &>
 264 % }
 265
 266 <%perl>
 267
 268 my @total_massvol;
 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 contains only one location.
 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 foreach my $ci (0..($#islandids-1)) {
 432         my @rel_flows;
 433         foreach my $f (@flows) {
 434                 next if $f->{Suppress};
 435                 next if $f->{'org_id'} == $f->{'dst_id'};
 436                 next unless grep { $f->{'org_id'} == $_ }
 437                         @islandids[0..$ci];
 438                 next unless grep { $f->{'dst_id'} == $_ }
 439                         @islandids[$ci+1..@islandids-1];
 440                 push @rel_flows, $f;
 441 #print " RELEVANT $ci $f->{Ix}  ";
 442         }
 443 #print " RELEVANT $ci COUNT ".scalar(@rel_flows)."  ";
 444         next unless @rel_flows;
 445         foreach my $mv (qw(mass volume)) {
 446                 my $max_vn= "max_$mv";
 447                 my $max= $mv eq 'mass' ? $max_mass : $max_volume;
 448                 $max= 1e9 unless defined $max;
 449 #print " DEFINED MAX $mv $max ";
 450                 $cplex .= "
 451    ". sprintf("%-10s","${mv}_$ci:")." ".
 452         join(" + ", map { ($_->{"unit$mv"}*1e-3).' f'.$_->{Ix} } @rel_flows).
 453         " <= $max";
 454         }
 455         if (defined $max_capital) {
 456            $cplex .= "
 457    ". sprintf("%-10s","capital_$ci:")." ".
 458         join(" + ", map { ($_->{"org_price"}).' f'.$_->{Ix} } @rel_flows).
 459         " <= $max_capital";
 460         }
 461         $cplex.= "\n";
 462 }
 463
 464 $cplex.= "
 465 Bounds
 466         ".(join "
 467         ", map { "$_->{Var} >= 0" } @flows)."
 468
 469 ";
 470
 471 $cplex.= "
 472 Integer
 473         ".(join "
 474         ", map { "f$_" } (0..$#flows))."
 475
 476 End
 477 ";
 478
 479 if ($qa->{'debug'}) {
 480 </%perl>
 481 <pre>
 482 <% $cplex |h %>
 483 </pre>
 484 <%perl>
 485 }
 486
 487 {
 488         my $input= pipethrough_prep();
 489         print $input $cplex or die $!;
 490         my $output= pipethrough_run_along($input, undef, 'glpsol',
 491                 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
 492         print "<pre>\n" if $qa->{'debug'};
 493         my $found_section= 0;
 494         my $glpsol_out= '';
 495         my $continuation='';
 496         while (<$output>) {
 497                 $glpsol_out.= $_;
 498                 print encode_entities($_) if $qa->{'debug'};
 499                 if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
 500                         die "$_ $found_section ?" if $found_section>0;
 501                         $found_section= 1;
 502                         next;
 503                 }
 504                 next unless $found_section==1;
 505                 if (!length $continuation) {
 506                         next if !$continuation &&  m/^[- ]+$/;
 507                         if (!/\S/) {
 508                                 $found_section= 0;
 509                                 next;
 510                         }
 511                         if (m/^ \s* \d+ \s+ \w+ $/x) {
 512                                 $continuation= $&;
 513                                 next;
 514                         }
 515                 }
 516                 $_= $continuation.$_;
 517                 $continuation= '';
 518                 my ($varname, $qty) = m/^
 519                         \s* \d+ \s+
 520                         (\w+) \s+ (?: [A-Z*]+ \s+ )?
 521                         ([0-9.]+) \s
 522                         /x or die "$_ ?";
 523                 if ($varname =~ m/^f(\d+)$/) {
 524                         my ($ix) = $1;
 525                         my $flow= $flows[$ix] or die;
 526                         $flow->{OptQty}= $qty;
 527                         $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 528                         $flow->{OptCapital}= $flow->{OptQty} *
 529                                 $flow->{'org_price'};
 530                 } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
 531                         my ($mv,$ix) = ($1,$2);
 532                         $total_massvol[$ix]{$mv}= $qty;
 533                 }
 534         }
 535         print "</pre>\n" if $qa->{'debug'};
 536         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 537         pipethrough_run_finish($output,$prerr);
 538         map { defined $_->{OptQty} or die "$prerr $_->{Ix}" } @flows;
 539 #       map { defined
 540 #       die $prerr if grep { ! } @flows;
 541 #       map { die
 542 #       die $prerr if map {
 543 };
 544
 545 $addcols->({ DoReverse => 1, Special => sub {
 546         my ($flow,$col,$v,$spec) = @_;
 547         if ($flow->{ExpectedUnitProfit} < 0) {
 548                 $spec->{Span}= 3;
 549                 $spec->{String}= '(Small margin)';
 550                 $spec->{Align}= 'align=center';
 551         }
 552 } }, qw(
 553                 OptQty
 554         ));
 555 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 556                 OptCapital OptProfit
 557         ));
 558
 559 </%perl>
 560
 561 % } # ========== OPTIMISATION ==========
 562
 563 % my %ts_sortkeys;
 564 % {
 565 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 566 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 567 <table id="trades" rules=groups>
 568 <colgroup span=1>
 569 <colgroup span=2>
 570 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 571 <colgroup span=1>
 572 <colgroup span=2>
 573 <colgroup span=2>
 574 <colgroup span=2>
 575 <colgroup span=3>
 576 <colgroup span=3>
 577 %       if ($optimise) {
 578 <colgroup span=3>
 579 %       }
 580 <tr class="spong">
 581 <th>
 582 <th<% $cdspan %>>Collect
 583 <th<% $cdspan %>>Deliver
 584 <th>
 585 <th colspan=2>Collect
 586 <th colspan=2>Deliver
 587 <th colspan=2>Profit
 588 <th colspan=3>Max
 589 <th colspan=1>
 590 <th colspan=2>Max
 591 %       if ($optimise) {
 592 <th colspan=3>Planned
 593 %       }
 594
 595 <tr>
 596 <th>
 597 <th>Island <% $cdstall %>
 598 <th>Island <% $cdstall %>
 599 <th>Commodity
 600 <th>Price
 601 <th>Qty
 602 <th>Price
 603 <th>Qty
 604 <th>Margin
 605 <th>Unit
 606 <th>Qty
 607 <th>Capital
 608 <th>Profit
 609 <th>Dist
 610 <th>Mass
 611 <th>Vol
 612 %       if ($optimise) {
 613 <th>Qty
 614 <th>Capital
 615 <th>Profit
 616 %       }
 617 % }
 618
 619 <tr id="trades_sort">
 620 % foreach my $col (@cols) {
 621 <th>
 622 % }
 623
 624 % foreach my $flowix (0..$#flows) {
 625 %       my $flow= $flows[$flowix];
 626 %       my $rowid= "id_row_$flow->{UidShort}";
 627 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 628 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 629     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 630        <% $flow->{Suppress} ? '' : 'checked' %> >
 631 %       my $ci= 1;
 632 %       while ($ci < @cols) {
 633 %               my $col= $cols[$ci];
 634 %               my $spec= {
 635 %                       Span => 1,
 636 %                       Align => ($col->{Text} ? '' : 'align=right')
 637 %               };
 638 %               my $v= $flow->{$col->{Name}};
 639 %               if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
 640 %               $col->{Total} += $v
 641 %                       if defined $col->{Total} and not $flow->{Suppress};
 642 %               $v='' if !$col->{Text} && !$v;
 643 %               my $sortkey= $col->{SortColKey} ?
 644 %                       $flow->{$col->{SortColKey}} : $v;
 645 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 646 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
 647  %> <% $spec->{Align}
 648  %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
 649 %               $ci += $spec->{Span};
 650 %       }
 651 % }
 652 <tr id="trades_total">
 653 <th>
 654 <th colspan=2>Total
 655 % foreach my $ci (3..$#cols) {
 656 %       my $col= $cols[$ci];
 657 <td align=right>
 658 %       if (defined $col->{Total}) {
 659 <% $col->{Total} |h %>
 660 %       }
 661 % }
 662 </table>
 663
 664 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 665         throw => 'trades_sort', tbrow => 'trades_total' &>
 666   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 667 </&tabsort>
 668
 669 <input type=submit name=update value="Update">
 670
 671 % if ($optimise) { # ========== TRADING PLAN ==========
 672 %
 673 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 674 %                               WHERE islandid = ?');
 675 % my %da_ages;
 676 % my $total_total= 0;
 677 % my $total_dist= 0;
 678 %
 679 <h1>Voyage trading plan</h1>
 680 <table rules=groups>
 681 % foreach my $i (0..$#islandids) {
 682 <tbody>
 683 <tr><td colspan=3>
 684 %       $iquery->execute($islandids[$i]);
 685 %       my ($islandname) = $iquery->fetchrow_array();
 686 %       if (!$i) {
 687 <strong>Start at <% $islandname |h %></strong>
 688 %       } else {
 689 %               my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
 690 %               $total_dist += $this_dist;
 691 <strong>Sail to <% $islandname |h %></strong>
 692 - <% $this_dist |h %> leagues </td>
 693 %       }
 694 <%perl>
 695      my $age_reported= 0;
 696      my %flowlists;
 697      foreach my $od (qw(org dst)) {
 698         foreach my $f (@flows) {
 699                 next if $f->{Suppress};
 700                 next unless $f->{"${od}_id"} == $islandids[$i];
 701                 next unless $f->{OptQty};
 702                 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
 703                 my $loop= $islandids[0] == $islandids[-1] &&
 704                           ($i==0 || $i==$#islandids);
 705                 next if $loop and ($arbitrage ? $i :
 706                         !!$i == !!($od eq 'org'));
 707                 my $price= $f->{"${od}_price"};
 708                 my $stallname= $f->{"${od}_stallname"};
 709                 my $todo= \$flowlists{$od}{
 710                                 $f->{'commodname'},
 711                                 (sprintf "%07d", ($od eq 'dst' ?
 712                                                 9999999-$price : $price)),
 713                                 $stallname
 714                         };
 715                 $$todo= {
 716                         Qty => 0,
 717                         orgArbitrage => 0,
 718                         dstArbitrage => 0,
 719                 } unless $$todo;
 720                 $$todo->{'commodname'}= $f->{'commodname'};
 721                 $$todo->{'stallname'}= $stallname;
 722                 $$todo->{Price}= $price;
 723                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 724                 $$todo->{Qty} += $f->{OptQty};
 725                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 726                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 727                 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
 728         }
 729      }
 730
 731      my ($total, $total_to_show);
 732      my $dline= 0;
 733      my $show_total= sub {
 734         my ($totaldesc, $sign) = @_;
 735         if (defined $total) {
 736                 die if defined $total_to_show;
 737                 $total_total += $sign * $total;
 738                 $total_to_show= [ $totaldesc, $total ];
 739                 $total= undef;
 740         }
 741         $dline= 0;
 742      };
 743      my $show_total_now= sub {
 744         my ($xinfo) = @_;
 745         return unless defined $total_to_show;
 746         my ($totaldesc,$totalwas) = @$total_to_show;
 747 </%perl>
 748 <tr>
 749 <td colspan=1>
 750 <td colspan=2><% $xinfo %>
 751 <td colspan=2 align=right><% $totaldesc %>
 752 <td align=right><% $totalwas |h %> total
 753 <%perl>
 754         $total_to_show= undef;
 755      };
 756 </%perl>
 757 %    my $show_flows= sub {
 758 %       my ($od,$arbitrage,$collectdeliver) = @_;
 759 %       my $todo= $flowlists{$od};
 760 %       return unless $todo;
 761 %       foreach my $tkey (sort keys %$todo) {
 762 %               my $t= $todo->{$tkey};
 763 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 764 %               $show_total_now->('');
 765 %               if (!$age_reported++) {
 766 %                       my $age= $now - $t->{Timestamp};
 767 %                       my $cellid= "da_${i}";
 768 %                       $da_ages{$cellid}= $age;
 769 <td colspan=3>\
 770 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 771 %               } elsif (!defined $total) {
 772 %                       $total= 0;
 773 <tbody>
 774 %               }
 775 %               $total += $t->{Total};
 776 %               my $span= 0 + keys %{ $t->{Stalls} };
 777 %               my $td= "td rowspan=$span";
 778 <tr class="datarow<% $dline %>">
 779 <<% $td %>><% $collectdeliver %>
 780 <<% $td %>><% $t->{'commodname'} |h %>
 781 %
 782 %               my @stalls= sort keys %{ $t->{Stalls} };
 783 %               my $pstall= sub {
 784 %                       my $name= $stalls[$_[0]];
 785 <td><% $name |h %>
 786 %               };
 787 %
 788 %               $pstall->(0);
 789 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 790 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 791 <<% $td %> align=right><% $t->{Total} |h %> total
 792 %
 793 %               foreach my $stallix (1..$#stalls) {
 794 <tr class="datarow<% $dline %>">
 795 %                       $pstall->($stallix);
 796 %               }
 797 %
 798 %               $dline ^= 1;
 799 %       }
 800 %    };
 801 <%perl>
 802
 803      $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
 804      $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
 805      $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
 806      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
 807      my $totals= '';
 808      if ($i < $#islandids) {
 809         $totals .=      "In hold $total_massvol[$i]{mass} kg,".
 810                         " $total_massvol[$i]{volume} l";
 811         my $delim= '; spare ';
 812         my $domv= sub {
 813                 my ($max, $got, $units) = @_;
 814                 return unless defined $max;
 815                 $totals .= $delim;
 816                 $totals .= sprintf "%g %s", ($max-$got), $units;
 817                 $delim= ', ';
 818         };
 819         $domv->($max_mass,   $total_massvol[$i]{mass},   'kg');
 820         $domv->($max_volume, $total_massvol[$i]{volume}, 'l');
 821         $totals .= ".\n";
 822      }
 823      $show_total_now->($totals);
 824 }
 825 </%perl>
 826 <tbody><tr>
 827 <td colspan=2>Total distance: <% $total_dist %> leagues.
 828 <td colspan=3 align=right>Overall net cash flow
 829 <td align=right><strong><%
 830   $total_total < 0 ? -$total_total." loss" : $total_total." gain"
 831  %></strong>
 832 </table>
 833 <& query_age:dataages, id2age => \%da_ages &>
 834 %
 835 % } # ========== TRADING PLAN ==========
 836
 837 <%init>
 838 use CommodsWeb;
 839 use Commods;
 840 </%init>