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 my $loss_per_delay_slot= 1e-8;
  54
  55 my $now= time;
  56
  57 my @flow_conds;
  58 my @query_params;
  59 my %dists;
  60 my $expected_total_profit;
  61
  62 my $sd_condition= sub {
  63         my ($bs, $ix) = @_;
  64         my $islandid= $islandids[$ix];
  65         if (defined $islandid) {
  66                 return "${bs}.islandid = $islandid";
  67         } else {
  68                 push @query_params, $archipelagoes[$ix];
  69                 return "${bs}_islands.archipelago = ?";
  70         }
  71 };
  72
  73 my $specific= !grep { !defined $_ } @islandids;
  74
  75 my %ipair2subflowinfs;
  76 # $ipair2subflowinfs{$orgi,$dsti}= [ [$orgix,$distix], ... ]
  77
  78 my @subflows;
  79 # $subflows[0]{Flow} = { ... }
  80 # $subflows[0]{Org} = $orgix
  81 # $subflows[0]{Dst} = $dstix
  82
  83 foreach my $org_i (0..$#islandids) {
  84         my $org_isle= $islandids[$org_i];
  85         my $org_cond= $sd_condition->('sell',$org_i);
  86         my @dst_conds;
  87         foreach my $dst_i ($org_i..$#islandids) {
  88                 my $dst_isle= $islandids[$dst_i];
  89                 # Don't ever consider sailing things round the houses:
  90                 next if defined $dst_isle and
  91                         grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
  92                 next if defined $org_isle and
  93                         grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
  94                 my $dst_cond;
  95                 if ($dst_i==$org_i and !defined $org_isle) {
  96                         # we always want arbitrage, but mentioning an arch
  97                         # once shouldn't produce intra-arch trades
  98                         $dst_cond= "sell.islandid = buy.islandid";
  99                 } else {
 100                         $dst_cond= $sd_condition->('buy',$dst_i);
 101                 }
 102                 push @dst_conds, $dst_cond;
 103
 104                 if ($specific) {
 105                         push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
 106                                 [ $org_i, $dst_i ];
 107                 }
 108         }
 109         push @flow_conds, "$org_cond AND (
 110                         ".join("
 111                      OR ",@dst_conds)."
 112                 )";
 113 }
 114
 115 my $stmt= "
 116         SELECT  sell_islands.islandname                         org_name,
 117                 sell_islands.islandid                           org_id,
 118                 sell.price                                      org_price,
 119                 sell.qty                                        org_qty_stall,
 120                 sell_stalls.stallname                           org_stallname,
 121                 sell.stallid                                    org_stallid,
 122                 sell_uploads.timestamp                          org_timestamp,
 123                 buy_islands.islandname                          dst_name,
 124                 buy_islands.islandid                            dst_id,
 125                 buy.price                                       dst_price,
 126                 buy.qty                                         dst_qty_stall,
 127                 buy_stalls.stallname                            dst_stallname,
 128                 buy.stallid                                     dst_stallid,
 129                 buy_uploads.timestamp                           dst_timestamp,
 130 ".($qa->{ShowStalls} ? "
 131                 sell.qty                                        org_qty_agg,
 132                 buy.qty                                         dst_qty_agg,
 133 " : "
 134                 (SELECT sum(qty) FROM sell AS sell_agg
 135                   WHERE sell_agg.commodid = commods.commodid
 136                   AND   sell_agg.islandid = sell.islandid
 137                   AND   sell_agg.price = sell.price)            org_qty_agg,
 138                 (SELECT sum(qty) FROM buy AS buy_agg
 139                   WHERE buy_agg.commodid = commods.commodid
 140                   AND   buy_agg.islandid = buy.islandid
 141                   AND   buy_agg.price = buy.price)              dst_qty_agg,
 142 ")."
 143                 commods.commodname                              commodname,
 144                 commods.commodid                                commodid,
 145                 commods.unitmass                                unitmass,
 146                 commods.unitvolume                              unitvolume,
 147                 dist                                            dist,
 148                 buy.price - sell.price                          unitprofit
 149         FROM commods
 150         JOIN sell ON commods.commodid = sell.commodid
 151         JOIN buy  ON commods.commodid = buy.commodid
 152         JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
 153         JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
 154         JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
 155         JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
 156         JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
 157         JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
 158         JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 159         WHERE   (
 160                 ".join("
 161            OR   ", @flow_conds)."
 162         )
 163           AND   buy.price > sell.price
 164         ORDER BY org_name, dst_name, commodname, unitprofit DESC,
 165                  org_price, dst_price DESC,
 166                  org_stallname, dst_stallname
 167      ";
 168
 169 my $sth= $dbh->prepare($stmt);
 170 $sth->execute(@query_params);
 171 my @flows;
 172
 173 my $distquery= $dbh->prepare("
 174                 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
 175                 ");
 176 my $distance= sub {
 177         my ($from,$to)= @_;
 178         my $d= $dists{$from}{$to};
 179         return $d if defined $d;
 180         $distquery->execute($from,$to);
 181         $d = $distquery->fetchrow_array();
 182         defined $d or die "$from $to ?";
 183         $dists{$from}{$to}= $d;
 184         return $d;
 185 };
 186
 187 my @cols= ({ NoSort => 1 });
 188
 189 my $addcols= sub {
 190         my $base= shift @_;
 191         foreach my $name (@_) {
 192                 my $col= { Name => $name, %$base };
 193                 $col->{Numeric}=1 if !$col->{Text};
 194                 push @cols, $col;
 195         }
 196 };
 197
 198 if ($qa->{ShowStalls}) {
 199         $addcols->({ Text => 1 }, qw(
 200                 org_name org_stallname
 201                 dst_name dst_stallname
 202         ));
 203 } else {
 204         $addcols->({Text => 1 }, qw(
 205                 org_name dst_name
 206         ));
 207 }
 208 $addcols->({ Text => 1 }, qw(commodname));
 209 $addcols->({ DoReverse => 1 },
 210         qw(     org_price org_qty_agg dst_price dst_qty_agg
 211         ));
 212 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
 213         qw(     Margin
 214         ));
 215 $addcols->({ DoReverse => 1 },
 216         qw(     unitprofit MaxQty MaxCapital MaxProfit dist
 217         ));
 218 foreach my $v (qw(MaxMass MaxVolume)) {
 219    $addcols->({
 220         DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
 221 }
 222
 223 </%perl>
 224
 225 % if ($qa->{'debug'}) {
 226 <pre>
 227 <% $stmt |h %>
 228 <% join(' | ',@query_params) |h %>
 229 </pre>
 230 % }
 231
 232 <& dumptable:start, qa => $qa, sth => $sth &>
 233 % {
 234 %   my $got;
 235 %   while ($got= $sth->fetchrow_hashref()) {
 236 <%perl>
 237
 238         my $f= $flows[$#flows];
 239         if (    !$f ||
 240                 $qa->{ShowStalls} ||
 241                 grep { $f->{$_} ne $got->{$_} }
 242                         qw(org_id org_price dst_id dst_price commodid)
 243         ) {
 244                 # Make a new flow rather than adding to the existing one
 245
 246                 $f= {
 247                         Ix => scalar(@flows),
 248                         %$got
 249                 };
 250                 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
 251                         if !$qa->{ShowStalls};
 252                 push @flows, $f;
 253         }
 254         foreach my $od (qw(org dst)) {
 255                 $f->{"${od}Stalls"}{
 256                         $got->{"${od}_stallname"}
 257                     } =
 258                         $got->{"${od}_qty_stall"}
 259                     ;
 260         }
 261
 262 </%perl>
 263 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 264 %    }
 265 <& dumptable:end, qa => $qa &>
 266 % }
 267
 268 <%perl>
 269
 270 my @sail_total;
 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         my $sfis= $ipair2subflowinfs{$f->{'org_id'},$f->{'dst_id'}};
 291         foreach my $sfi (@$sfis) {
 292                 my $subflow= {
 293                         Flow => $f,
 294                         Org => $sfi->[0],
 295                         Dst => $sfi->[1],
 296                         Var => sprintf "f%ss%s_c%d_p%d_%d_p%d_%d",
 297                                 $f->{Ix}, $sfi->[0],
 298                                 $f->{'commodid'},
 299                                 $sfi->[0], $f->{'org_price'},
 300                                 $sfi->[1], $f->{'dst_price'}
 301                 };
 302                 push @{ $f->{Subflows} }, $subflow;
 303                 push @subflows, $subflow;
 304         }
 305
 306         $f->{MarginSortKey}= sprintf "%d",
 307                 $f->{'dst_price'} * 10000 / $f->{'org_price'};
 308         $f->{Margin}= sprintf "%3.1f%%",
 309                 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 310
 311         $f->{ExpectedUnitProfit}=
 312                 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 313                 - $f->{'org_price'};
 314
 315         $dists{'org_id'}{'dst_id'}= $f->{'dist'};
 316
 317         my @uid= $f->{commodid};
 318         foreach my $od (qw(org dst)) {
 319                 push @uid,
 320                         $f->{"${od}_id"},
 321                         $f->{"${od}_price"};
 322                 push @uid,
 323                         $f->{"${od}_stallid"}
 324                                 if $qa->{ShowStalls};
 325         }
 326         $f->{UidLong}= join '_', @uid;
 327
 328         my $base= 31;
 329         my $cmpu= '';
 330         map {
 331                 my $uue= $_;
 332                 my $first= $base;
 333                 do {
 334                         my $this= $uue % $base;
 335 #print STDERR "uue=$uue this=$this ";
 336                         $uue -= $this;
 337                         $uue /= $base;
 338                         $this += $first;
 339                         $first= 0;
 340                         $cmpu .= chr($this + ($this < 26 ? ord('a') :
 341                                               $this < 52 ? ord('A')-26
 342                                                          : ord('0')-52));
 343 #print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
 344                         die "$cmpu $uue ?" if length $cmpu > 20;
 345                 } while ($uue);
 346                 $cmpu;
 347         } @uid;
 348         $f->{UidShort}= $cmpu;
 349
 350         if ($qa->{'debug'}) {
 351                 my @outuid;
 352                 $_= $f->{UidShort};
 353                 my $mul;
 354                 while (m/./) {
 355                         my $v= m/^[a-z]/ ? ord($&)-ord('a') :
 356                                m/^[A-Z]/ ? ord($&)-ord('A')+26 :
 357                                m/^[0-9]/ ? ord($&)-ord('0')+52 :
 358                                die "$_ ?";
 359                         if ($v >= $base) {
 360                                 push @outuid, 0;
 361                                 $v -= $base;
 362                                 $mul= 1;
 363 #print STDERR "(next)\n";
 364                         }
 365                         die "$f->{UidShort} $_ ?" unless defined $mul;
 366                         $outuid[$#outuid] += $v * $mul;
 367
 368 #print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
 369 #                       "[vs.".ord('a').",".ord('A').",".ord('0')."]".
 370 #                       "  outuid=@outuid\n";
 371
 372                         $mul *= $base;
 373                         s/^.//;
 374                 }
 375                 my $recons_long= join '_', @outuid;
 376                 $f->{UidLong} eq $recons_long or
 377                         die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 378         }
 379
 380         if (defined $qa->{"R$f->{UidShort}"} &&
 381             !defined $qa->{"T$f->{UidShort}"}) {
 382                 $f->{Suppress}= 1;
 383         }
 384
 385 }
 386 </%perl>
 387
 388 % my $optimise= $specific;
 389 % if (!$optimise) {
 390
 391 <p>
 392 % if (!$specific) {
 393 Route contains archipelago(es), not just specific islands.
 394 % }
 395 Therefore, optimal voyage trade plan not calculated.
 396
 397 % } else { # ========== OPTMISATION ==========
 398 <%perl>
 399
 400 my $cplex= "
 401 Maximize
 402
 403   totalprofit:
 404 ";
 405
 406 foreach my $sf (@subflows) {
 407         my $eup= $sf->{Flow}{ExpectedUnitProfit};
 408         $eup *= (1.0-$loss_per_delay_slot) ** $sf->{Org};
 409         $cplex .= sprintf "
 410                 %+.20f %s", $eup, $sf->{Var};
 411 }
 412 $cplex .= "
 413
 414 Subject To
 415 ";
 416
 417 my %avail_lims;
 418 foreach my $flow (@flows) {
 419         if ($flow->{Suppress}) {
 420                 foreach my $sf (@{ $flow->{Subflows} }) {
 421                         $cplex .= "
 422    $sf->{Var} = 0";
 423                 }
 424                 next;
 425         }
 426         foreach my $od (qw(org dst)) {
 427                 my $limname= join '_', (
 428                         $od,
 429                         'i'.$flow->{"${od}_id"},
 430                         'c'.$flow->{'commodid'},
 431                         $flow->{"${od}_price"},
 432                         $flow->{"${od}_stallid"},
 433                 );
 434
 435                 push @{ $avail_lims{$limname}{SubflowVars} },
 436                         map { $_->{Var} } @{ $flow->{Subflows} };
 437                 $avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
 438         }
 439 }
 440 foreach my $limname (sort keys %avail_lims) {
 441         my $c= $avail_lims{$limname};
 442         $cplex .=
 443                 sprintf("    %-30s","$limname:")." ".
 444                         join("+", @{ $c->{SubflowVars} }).
 445                         " <= ".$c->{Qty}."\n";
 446 }
 447
 448 foreach my $ci (0..($#islandids-1)) {
 449         my @rel_subflows;
 450
 451         foreach my $f (@flows) {
 452                 next if $f->{Suppress};
 453                 my @relsubflow= grep {
 454                         $_->{Org} <= $ci &&
 455                         $_->{Dst} > $ci;
 456                 } @{ $f->{Subflows} };
 457                 next unless @relsubflow;
 458                 die unless @relsubflow == 1;
 459                 push @rel_subflows, @relsubflow;
 460 #print " RELEVANT $ci $relsubflow[0]->{Var} ";
 461         }
 462 #print " RELEVANT $ci COUNT ".scalar(@rel_subflows)."  ";
 463         if (!@rel_subflows) {
 464                 foreach my $mv (qw(mass volume)) {
 465                         $sail_total[$ci]{$mv}= 0;
 466                 }
 467                 next;
 468         }
 469
 470         my $applylimit= sub {
 471                 my ($mv, $max, $f2val) = @_;
 472                 $max= 1e9 unless defined $max;
 473 #print " DEFINED MAX $mv $max ";
 474                 $cplex .= "
 475    ". sprintf("%-10s","${mv}_$ci:")." ".
 476                 join(" + ", map {
 477 #print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
 478                         $f2val->($_->{Flow}) .' '. $_->{Var};
 479                 } @rel_subflows).
 480                 " <= $max";
 481         };
 482
 483         $applylimit->('mass',   $max_mass,   sub { $_[0]{'unitmass'}  *1e-3 });
 484         $applylimit->('volume', $max_volume, sub { $_[0]{'unitvolume'}*1e-3 });
 485         $applylimit->('capital',$max_capital,sub { $_[0]{'org_price'}       });
 486         $cplex.= "\n";
 487 }
 488
 489 $cplex.= "
 490 Bounds
 491         ".(join "
 492         ", map { "$_->{Var} >= 0" } @subflows)."
 493
 494 ";
 495
 496 $cplex.= "
 497 Integer
 498         ".(join "
 499         ", map { $_->{Var} } @subflows)."
 500
 501 End
 502 ";
 503
 504 if ($qa->{'debug'}) {
 505 </%perl>
 506 <pre>
 507 <% $cplex |h %>
 508 </pre>
 509 <%perl>
 510 }
 511
 512 {
 513         my $input= pipethrough_prep();
 514         print $input $cplex or die $!;
 515         my $output= pipethrough_run_along($input, undef, 'glpsol',
 516                 qw(glpsol --tmlim 2 --memlim 5 --intopt --cuts --bfs
 517                           --cpxlp /dev/stdin -o /dev/stdout));
 518         print "<pre>\n" if $qa->{'debug'};
 519         my $found_section= 0;
 520         my $glpsol_out= '';
 521         my $continuation='';
 522         while (<$output>) {
 523                 $glpsol_out.= $_;
 524                 print encode_entities($_) if $qa->{'debug'};
 525                 if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
 526                         die "$_ $found_section ?" if $found_section>0;
 527                         $found_section= 1;
 528                         next;
 529                 }
 530                 if (m/^Objective:\s+totalprofit = (\d+\.\d*) /) {
 531                         $expected_total_profit= $1;
 532                 }
 533                 next unless $found_section==1;
 534                 if (!length $continuation) {
 535                         next if !$continuation &&  m/^[- ]+$/;
 536                         if (!/\S/) {
 537                                 $found_section= 0;
 538                                 next;
 539                         }
 540                         if (m/^ \s* \d+ \s+ \w+ $/x) {
 541                                 $continuation= $&;
 542                                 next;
 543                         }
 544                 }
 545                 $_= $continuation.$_;
 546                 $continuation= '';
 547                 my ($varname, $qty) = m/^
 548                         \s* \d+ \s+
 549                         (\w+) \s+ (?: [A-Z*]+ \s+ )?
 550                         ([0-9.]+) \s
 551                         /x or die "$_ ?";
 552                 if ($varname =~ m/^f(\d+)s(\d+)_/) {
 553                         my ($ix,$orgix) = ($1,$2);
 554                         my $flow= $flows[$ix] or die;
 555                         my @relsubflow= grep { $_->{Org} == $orgix }
 556                                 @{ $flow->{Subflows} };
 557                         die "$ix $orgix @relsubflow" unless @relsubflow == 1;
 558                         my $sf= $relsubflow[0];
 559                         $sf->{OptQty}= $qty;
 560                         $sf->{OptProfit}= $qty * $flow->{'unitprofit'};
 561                         $sf->{OptCapital}= $qty * $flow->{'org_price'};
 562                 } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
 563                         my ($mv,$ix) = ($1,$2);
 564                         $sail_total[$ix]{$mv}= $qty;
 565                 }
 566         }
 567         print "</pre>\n" if $qa->{'debug'};
 568         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 569         pipethrough_run_finish($output,$prerr);
 570         map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
 571 };
 572
 573 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
 574         my ($flow,$col,$v,$spec) = @_;
 575         if ($flow->{ExpectedUnitProfit} < 0) {
 576                 $spec->{Span}= 3;
 577                 $spec->{String}= '(Small margin)';
 578                 $spec->{Align}= 'align=center';
 579         }
 580 } }, qw(
 581                 OptQty
 582         ));
 583 $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
 584                 OptCapital OptProfit
 585         ));
 586
 587 </%perl>
 588
 589 % } # ========== OPTIMISATION ==========
 590
 591 % my %ts_sortkeys;
 592 % {
 593 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 594 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 595 <table id="trades" rules=groups>
 596 <colgroup span=1>
 597 <colgroup span=2>
 598 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 599 <colgroup span=1>
 600 <colgroup span=2>
 601 <colgroup span=2>
 602 <colgroup span=2>
 603 <colgroup span=3>
 604 <colgroup span=3>
 605 %       if ($optimise) {
 606 <colgroup span=3>
 607 %       }
 608 <tr class="spong">
 609 <th>
 610 <th<% $cdspan %>>Collect
 611 <th<% $cdspan %>>Deliver
 612 <th>
 613 <th colspan=2>Collect
 614 <th colspan=2>Deliver
 615 <th colspan=2>Profit
 616 <th colspan=3>Max
 617 <th colspan=1>
 618 <th colspan=2>Max
 619 %       if ($optimise) {
 620 <th colspan=3>Planned
 621 %       }
 622
 623 <tr>
 624 <th>
 625 <th>Island <% $cdstall %>
 626 <th>Island <% $cdstall %>
 627 <th>Commodity
 628 <th>Price
 629 <th>Qty
 630 <th>Price
 631 <th>Qty
 632 <th>Margin
 633 <th>Unit
 634 <th>Qty
 635 <th>Capital
 636 <th>Profit
 637 <th>Dist
 638 <th>Mass
 639 <th>Vol
 640 %       if ($optimise) {
 641 <th>Qty
 642 <th>Capital
 643 <th>Profit
 644 %       }
 645 % }
 646
 647 <tr id="trades_sort">
 648 % foreach my $col (@cols) {
 649 <th>
 650 % }
 651
 652 % foreach my $flowix (0..$#flows) {
 653 %       my $flow= $flows[$flowix];
 654 %       my $rowid= "id_row_$flow->{UidShort}";
 655 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 656 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 657     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 658        <% $flow->{Suppress} ? '' : 'checked' %> >
 659 %       my $ci= 1;
 660 %       while ($ci < @cols) {
 661 %               my $col= $cols[$ci];
 662 %               my $spec= {
 663 %                       Span => 1,
 664 %                       Align => ($col->{Text} ? '' : 'align=right')
 665 %               };
 666 %               my $cn= $col->{Name};
 667 %               my $v;
 668 %               if (!$col->{TotalSubflows}) {
 669 %                       $v= $flow->{$cn};
 670 %               } else {
 671 %                       $v= 0;
 672 %                       $v += $_->{$cn} foreach @{ $flow->{Subflows} };
 673 %               }
 674 %               if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
 675 %               $col->{Total} += $v
 676 %                       if defined $col->{Total} and not $flow->{Suppress};
 677 %               $v='' if !$col->{Text} && !$v;
 678 %               my $sortkey= $col->{SortColKey} ?
 679 %                       $flow->{$col->{SortColKey}} : $v;
 680 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 681 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
 682  %> <% $spec->{Align}
 683  %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
 684 %               $ci += $spec->{Span};
 685 %       }
 686 % }
 687 <tr id="trades_total">
 688 <th>
 689 <th colspan=2>Total
 690 % foreach my $ci (3..$#cols) {
 691 %       my $col= $cols[$ci];
 692 <td align=right>
 693 %       if (defined $col->{Total}) {
 694 <% $col->{Total} |h %>
 695 %       }
 696 % }
 697 </table>
 698
 699 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 700         throw => 'trades_sort', tbrow => 'trades_total' &>
 701   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 702 </&tabsort>
 703
 704 <input type=submit name=update value="Update">
 705
 706 % if ($optimise) { # ========== TRADING PLAN ==========
 707 %
 708 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 709 %                               WHERE islandid = ?');
 710 % my %da_ages;
 711 % my $total_total= 0;
 712 % my $total_dist= 0;
 713 %
 714 <h1>Voyage trading plan</h1>
 715 <table rules=groups>
 716 % foreach my $i (0..$#islandids) {
 717 <tbody>
 718 <tr><td colspan=4>
 719 %       $iquery->execute($islandids[$i]);
 720 %       my ($islandname) = $iquery->fetchrow_array();
 721 %       if (!$i) {
 722 <strong>Start at <% $islandname |h %></strong>
 723 %       } else {
 724 %               my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
 725 %               $total_dist += $this_dist;
 726 <%perl>
 727                 my $total_value= 0;
 728                 foreach my $sf (@subflows) {
 729                         next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
 730                         $total_value +=
 731                                 $sf->{OptQty} * $sf->{Flow}{'dst_price'};
 732                 }
 733 </%perl>
 734 <strong>Sail to <% $islandname |h %></strong>
 735 - <% $this_dist |h %> leagues,
 736  <% $total_value %>poe at risk
 737  </td>
 738 %       }
 739 <%perl>
 740      my $age_reported= 0;
 741      my %flowlists;
 742      #print "<tr><td colspan=6>" if $qa->{'debug'};
 743      foreach my $od (qw(org dst)) {
 744         #print " [[ i $i od $od " if $qa->{'debug'};
 745         foreach my $sf (@subflows) {
 746                 my $f= $sf->{Flow};
 747                 next if $f->{Suppress};
 748                 next unless $sf->{ucfirst $od} == $i;
 749                 #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
 750                 #       if $qa->{'debug'};
 751                 next unless $sf->{OptQty};
 752                 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
 753                 die if $arbitrage and $sf->{Org} != $sf->{Dst};
 754                 my $price= $f->{"${od}_price"};
 755                 my $stallname= $f->{"${od}_stallname"};
 756                 my $todo= \$flowlists{$od}{
 757                                 $f->{'commodname'},
 758                                 (sprintf "%07d", ($od eq 'dst' ?
 759                                                 9999999-$price : $price)),
 760                                 $stallname
 761                         };
 762                 $$todo= {
 763                         Qty => 0,
 764                         orgArbitrage => 0,
 765                         dstArbitrage => 0,
 766                 } unless $$todo;
 767                 $$todo->{'commodname'}= $f->{'commodname'};
 768                 $$todo->{'stallname'}= $stallname;
 769                 $$todo->{Price}= $price;
 770                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 771                 $$todo->{Qty} += $sf->{OptQty};
 772                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 773                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 774                 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
 775         }
 776         #print "]] " if $qa->{'debug'};
 777      }
 778      #print "</tr>" if $qa->{'debug'};
 779
 780      my ($total, $total_to_show);
 781      my $dline= 0;
 782      my $show_total= sub {
 783         my ($totaldesc, $sign) = @_;
 784         if (defined $total) {
 785                 die if defined $total_to_show;
 786                 $total_total += $sign * $total;
 787                 $total_to_show= [ $totaldesc, $total ];
 788                 $total= undef;
 789         }
 790         $dline= 0;
 791      };
 792      my $show_total_now= sub {
 793         my ($xinfo) = @_;
 794         return unless defined $total_to_show;
 795         my ($totaldesc,$totalwas) = @$total_to_show;
 796 </%perl>
 797 <tr>
 798 <td colspan=1>
 799 <td colspan=2><% $xinfo %>
 800 <td colspan=2 align=right><% $totaldesc %>
 801 <td align=right><% $totalwas |h %> total
 802 <%perl>
 803         $total_to_show= undef;
 804      };
 805 </%perl>
 806 %    my $show_flows= sub {
 807 %       my ($od,$arbitrage,$collectdeliver) = @_;
 808 %       my $todo= $flowlists{$od};
 809 %       return unless $todo;
 810 %       foreach my $tkey (sort keys %$todo) {
 811 %               my $t= $todo->{$tkey};
 812 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 813 %               $show_total_now->('');
 814 %               if (!$age_reported++) {
 815 %                       my $age= $now - $t->{Timestamp};
 816 %                       my $cellid= "da_${i}";
 817 %                       $da_ages{$cellid}= $age;
 818 <td colspan=2>\
 819 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 820 %               } elsif (!defined $total) {
 821 %                       $total= 0;
 822 <tbody>
 823 %               }
 824 %               $total += $t->{Total};
 825 %               my $span= 0 + keys %{ $t->{Stalls} };
 826 %               my $td= "td rowspan=$span";
 827 <tr class="datarow<% $dline %>">
 828 <<% $td %>><% $collectdeliver %>
 829 <<% $td %>><% $t->{'commodname'} |h %>
 830 %
 831 %               my @stalls= sort keys %{ $t->{Stalls} };
 832 %               my $pstall= sub {
 833 %                       my $name= $stalls[$_[0]];
 834 <td><% $name |h %>
 835 %               };
 836 %
 837 %               $pstall->(0);
 838 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 839 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 840 <<% $td %> align=right><% $t->{Total} |h %> total
 841 %
 842 %               foreach my $stallix (1..$#stalls) {
 843 <tr class="datarow<% $dline %>">
 844 %                       $pstall->($stallix);
 845 %               }
 846 %
 847 %               $dline ^= 1;
 848 %       }
 849 %    };
 850 <%perl>
 851
 852      $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
 853      $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
 854      $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
 855      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
 856      my $totals= '';
 857      if ($i < $#islandids) {
 858         $totals .=      "In hold $sail_total[$i]{mass}kg,".
 859                         " $sail_total[$i]{volume} l";
 860         my $delim= '; spare ';
 861         my $domv= sub {
 862                 my ($max, $got, $units) = @_;
 863                 return unless defined $max;
 864                 $totals .= $delim;
 865                 $totals .= sprintf "%g %s", ($max-$got), $units;
 866                 $delim= ', ';
 867         };
 868         $domv->($max_mass,   $sail_total[$i]{mass},   'kg');
 869         $domv->($max_volume, $sail_total[$i]{volume}, 'l');
 870         $totals .= ".\n";
 871      }
 872      $show_total_now->($totals);
 873 }
 874 </%perl>
 875 <tbody><tr>
 876 <td colspan=2>Total distance: <% $total_dist %> leagues.
 877 <td colspan=3 align=right>Overall net cash flow
 878 <td align=right><strong><%
 879   $total_total < 0 ? -$total_total." loss" : $total_total." gain"
 880  %></strong>
 881 </table>
 882 <& query_age:dataages, id2age => \%da_ages &>
 883 Expected average profit:
 884  approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
 885  (considering expected losses, but ignoring rum consumed)
 886 %
 887 % } # ========== TRADING PLAN ==========
 888
 889 <%init>
 890 use CommodsWeb;
 891 use Commods;
 892 </%init>