3 This is part of the YARRG website. YARRG is a tool and website
4 for assisting players of Yohoho Puzzle Pirates.
6 Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
7 Copyright (C) 2009 Clare Boothby
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
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.
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.
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/>.
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.
32 This Mason component is the core trade planner for a specific route.
44 <& query_age:pageload &>
48 my $loss_per_league= defined $routeparams->{LossPerLeaguePct}
49 ? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7;
50 my $loss_per_delay_slot= 1e-8;
52 my $minprofit= $routeparams->{MinProfit} || 0;
59 my $expected_total_profit;
61 my $sd_condition= sub {
63 my $islandid= $islandids[$ix];
64 if (defined $islandid) {
65 return "${bs}.islandid = $islandid";
67 push @query_params, $archipelagoes[$ix];
68 return "${bs}_islands.archipelago = ?";
72 my $specific= !grep { !defined $_ } @islandids;
74 my %ipair2subflowinfs;
75 # $ipair2subflowinfs{$orgi,$dsti}= [ [$orgix,$distix], ... ]
78 # $subflows[0]{Flow} = { ... }
79 # $subflows[0]{Org} = $orgix
80 # $subflows[0]{Dst} = $dstix
82 foreach my $org_i (0..$#islandids) {
83 my $org_isle= $islandids[$org_i];
84 my $org_cond= $sd_condition->('sell',$org_i);
86 foreach my $dst_i ($org_i..$#islandids) {
87 my $dst_isle= $islandids[$dst_i];
88 # Don't ever consider sailing things round the houses:
89 next if defined $dst_isle and
90 grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
91 next if defined $org_isle and
92 grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
94 if ($dst_i==$org_i and !defined $org_isle) {
95 # we always want arbitrage, but mentioning an arch
96 # once shouldn't produce intra-arch trades
97 $dst_cond= "sell.islandid = buy.islandid";
99 $dst_cond= $sd_condition->('buy',$dst_i);
101 push @dst_conds, $dst_cond;
104 push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
108 push @flow_conds, "$org_cond AND (
115 SELECT sell_islands.islandname org_name,
116 sell_islands.islandid org_id,
117 sell.price org_price,
118 sell.qty org_qty_stall,
119 sell_stalls.stallname org_stallname,
120 sell.stallid org_stallid,
121 sell_uploads.timestamp org_timestamp,
122 buy_islands.islandname dst_name,
123 buy_islands.islandid dst_id,
125 buy.qty dst_qty_stall,
126 buy_stalls.stallname dst_stallname,
127 buy.stallid dst_stallid,
128 buy_uploads.timestamp dst_timestamp,
129 ".($qa->{ShowStalls} ? "
130 sell.qty org_qty_agg,
133 (SELECT sum(qty) FROM sell AS sell_agg
134 WHERE sell_agg.commodid = commods.commodid
135 AND sell_agg.islandid = sell.islandid
136 AND sell_agg.price = sell.price) org_qty_agg,
137 (SELECT sum(qty) FROM buy AS buy_agg
138 WHERE buy_agg.commodid = commods.commodid
139 AND buy_agg.islandid = buy.islandid
140 AND buy_agg.price = buy.price) dst_qty_agg,
142 commods.commodname commodname,
143 commods.commodid commodid,
144 commods.unitmass unitmass,
145 commods.unitvolume unitvolume,
146 commods.ordval ordval,
147 commods.posinclass posinclass,
148 commods.commodclassid commodclassid,
150 buy.price - sell.price unitprofit
152 JOIN sell ON commods.commodid = sell.commodid
153 JOIN buy ON commods.commodid = buy.commodid
154 JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
155 JOIN islands AS buy_islands ON buy.islandid = buy_islands.islandid
156 JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
157 JOIN uploads AS buy_uploads ON buy.islandid = buy_uploads.islandid
158 JOIN stalls AS sell_stalls ON sell.stallid = sell_stalls.stallid
159 JOIN stalls AS buy_stalls ON buy.stallid = buy_stalls.stallid
160 JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
165 AND buy.price > sell.price
166 ORDER BY org_name, dst_name, commodname, unitprofit DESC,
167 org_price, dst_price DESC,
168 org_stallname, dst_stallname
171 my $sth= $dbh->prepare($stmt);
172 $sth->execute(@query_params);
175 my $distquery= $dbh->prepare("
176 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
180 my $d= $dists{$from}{$to};
181 return $d if defined $d;
182 $distquery->execute($from,$to);
183 $d = $distquery->fetchrow_array();
184 defined $d or die "$from $to ?";
185 $dists{$from}{$to}= $d;
189 my @cols= ({ NoSort => 1 });
193 foreach my $name (@_) {
194 my $col= { Name => $name, %$base };
195 $col->{Numeric}=1 if !$col->{Text};
200 if ($qa->{ShowStalls}) {
201 $addcols->({ Text => 1 }, qw(
202 org_name org_stallname
203 dst_name dst_stallname
206 $addcols->({Text => 1 }, qw(
210 $addcols->({ Text => 1 }, qw(commodname));
211 $addcols->({ DoReverse => 1 },
212 qw( org_price org_qty_agg dst_price dst_qty_agg
214 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
217 $addcols->({ DoReverse => 1 },
218 qw( unitprofit MaxQty MaxCapital MaxProfit dist
220 foreach my $v (qw(MaxMass MaxVolume)) {
222 DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
227 % if ($qa->{'debug'}) {
230 <% join(' | ',@query_params) |h %>
234 <& dumptable:start, qa => $qa, sth => $sth &>
237 % while ($got= $sth->fetchrow_hashref()) {
240 my $f= $flows[$#flows];
243 grep { $f->{$_} ne $got->{$_} }
244 qw(org_id org_price dst_id dst_price commodid)
246 # Make a new flow rather than adding to the existing one
249 Ix => scalar(@flows),
252 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
253 if !$qa->{ShowStalls};
256 foreach my $od (qw(org dst)) {
258 $got->{"${od}_stallname"}
260 $got->{"${od}_qty_stall"}
265 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
267 <& dumptable:end, qa => $qa &>
270 % if (@islandids==1) {
271 % if (defined $islandids[0]) {
272 Searched for arbitrage trades only.
274 Searched for arbitrage trades only, in <% $archipelagoes[0] |h %>
275 <a href="docs#arbitrage">[?]</a>.
282 print 'No profitable trading opportunities were found.';
287 my %opportunity_value;
291 return join '_', map { $f->{$_} } qw(org_id dst_id commodid);
294 foreach my $f (@flows) {
296 $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
297 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
298 $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
299 $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
301 $f->{MaxMassSortKey}= $f->{MaxQty} * $f->{'unitmass'};
302 $f->{MaxVolumeSortKey}= $f->{MaxQty} * $f->{'unitvolume'};
303 foreach my $v (qw(Mass Volume)) {
304 $f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6;
307 $f->{MarginSortKey}= sprintf "%d",
308 $f->{'dst_price'} * 10000 / $f->{'org_price'};
309 $f->{Margin}= sprintf "%3.1f%%",
310 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
312 $f->{ExpectedUnitProfit}=
313 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
316 $dists{'org_id'}{'dst_id'}= $f->{'dist'};
318 $opportunity_value{ $oppo_key->($f) } += $f->{MaxProfit};
320 my @uid= $f->{commodid};
321 foreach my $od (qw(org dst)) {
326 $f->{"${od}_stallid"}
327 if $qa->{ShowStalls};
329 $f->{UidLong}= join '_', @uid;
337 my $this= $uue % $base;
338 #print STDERR "uue=$uue this=$this ";
343 $cmpu .= chr($this + ($this < 26 ? ord('a') :
344 $this < 52 ? ord('A')-26
346 #print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
347 die "$cmpu $uue ?" if length $cmpu > 20;
351 $f->{UidShort}= $cmpu;
353 if ($qa->{'debug'}) {
358 my $v= m/^[a-z]/ ? ord($&)-ord('a') :
359 m/^[A-Z]/ ? ord($&)-ord('A')+26 :
360 m/^[0-9]/ ? ord($&)-ord('0')+52 :
366 #print STDERR "(next)\n";
368 die "$f->{UidShort} $_ ?" unless defined $mul;
369 $outuid[$#outuid] += $v * $mul;
371 #print STDERR "$f->{UidShort} $_ $& v=$v mul=$mul ord()=".ord($&).
372 # "[vs.".ord('a').",".ord('A').",".ord('0')."]".
373 # " outuid=@outuid\n";
378 my $recons_long= join '_', @outuid;
379 $f->{UidLong} eq $recons_long or
380 die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
384 foreach my $f (@flows) {
386 if ($reset_suppressions || !defined $qa->{"R$f->{UidShort}"}) {
387 if ($opportunity_value{ $oppo_key->($f) } < $minprofit) {
391 if (!defined $qa->{"T$f->{UidShort}"}) {
395 if (!$f->{Suppress}) {
396 my $sfis= $ipair2subflowinfs{$f->{'org_id'},$f->{'dst_id'}};
397 foreach my $sfi (@$sfis) {
402 Var => sprintf "f%ss%s_c%d_p%d_%d_p%d_%d",
405 $sfi->[0], $f->{'org_price'},
406 $sfi->[1], $f->{'dst_price'}
408 push @{ $f->{Subflows} }, $subflow;
409 push @subflows, $subflow;
415 % my $optimise= $specific;
420 Route contains archipelago(es), not just specific islands.
422 Therefore, optimal voyage trade plan not calculated.
424 % } else { # ========== OPTMISATION ==========
433 my %stall_poe_limits;
435 foreach my $sf (@subflows) {
436 my $eup= $sf->{Flow}{ExpectedUnitProfit};
437 $eup *= (1.0-$loss_per_delay_slot) ** $sf->{Org};
439 %+.20f %s", $eup, $sf->{Var};
440 if ($qa->{ShowStalls}>=2) {
441 my $stall= $sf->{Flow}{'dst_stallid'};
442 push @{ $stall_poe_limits{$stall} }, $sf;
451 foreach my $flow (@flows) {
452 next if $flow->{Suppress};
453 foreach my $od (qw(org dst)) {
454 my $limname= join '_', (
456 'i'.$flow->{"${od}_id"},
457 'c'.$flow->{'commodid'},
458 $flow->{"${od}_price"},
459 $flow->{"${od}_stallid"},
462 push @{ $avail_lims{$limname}{SubflowVars} },
463 map { $_->{Var} } @{ $flow->{Subflows} };
464 $avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
467 foreach my $limname (sort keys %avail_lims) {
468 my $c= $avail_lims{$limname};
470 sprintf(" %-30s","$limname:")." ".
471 join("+", @{ $c->{SubflowVars} }).
472 " <= ".$c->{Qty}."\n";
475 foreach my $ci (0..($#islandids-1)) {
478 foreach my $f (@flows) {
479 next if $f->{Suppress};
480 my @relsubflow= grep {
483 } @{ $f->{Subflows} };
484 next unless @relsubflow;
485 die unless @relsubflow == 1;
486 push @rel_subflows, @relsubflow;
487 #print " RELEVANT $ci $relsubflow[0]->{Var} ";
489 #print " RELEVANT $ci COUNT ".scalar(@rel_subflows)." ";
490 if (!@rel_subflows) {
491 foreach my $mv (qw(mass volume)) {
492 $sail_total[$ci]{$mv}= 0;
497 my $applylimit= sub {
498 my ($mv, $f2val) = @_;
499 my $max= $routeparams->{"Max".ucfirst $mv};
500 $max= 1e9 unless defined $max;
501 #print " DEFINED MAX $mv $max ";
503 ". sprintf("%-10s","${mv}_$ci:")." ".
505 #print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
506 $f2val->($_->{Flow}) .' '. $_->{Var};
511 $applylimit->('mass', sub { $_[0]{'unitmass'} *1e-3 });
512 $applylimit->('volume', sub { $_[0]{'unitvolume'}*1e-3 });
513 $applylimit->('capital', sub { $_[0]{'org_price'} });
517 if ($qa->{ShowStalls}>=2) {
518 my $stallpoe= $dbh->prepare(<<END);
519 SELECT max(qty*price) FROM buy WHERE stallid=?
521 foreach my $stallid (sort { $a <=> $b } keys %stall_poe_limits) {
522 $stallpoe->execute($stallid);
523 my ($lim)= $stallpoe->fetchrow_array();
526 ". sprintf("%-15s","poe_$stallid:")." ".
528 sprintf "%d %s", $_->{Flow}{'dst_price'}, $_->{Var};
529 } @{ $stall_poe_limits{$stallid} }).
538 ", map { "$_->{Var} >= 0" } @subflows)."
545 ", map { $_->{Var} } @subflows)."
550 if ($qa->{'debug'}) {
559 my $input= pipethrough_prep();
560 print $input $cplex or die $!;
561 my $output= pipethrough_run_along($input, undef, 'glpsol',
562 qw(glpsol --tmlim 5 --memlim 5 --intopt --cuts --bfs
563 --cpxlp /dev/stdin -o /dev/stdout));
564 print "<pre>\n" if $qa->{'debug'};
565 my $found_section= 0;
570 print encode_entities($_) if $qa->{'debug'};
571 if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
572 die "$_ $found_section ?" if $found_section>0;
576 if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
577 $expected_total_profit= $1;
579 next unless $found_section==1;
580 if (!length $continuation) {
581 next if !$continuation && m/^[- ]+$/;
586 if (m/^ \s* \d+ \s+ \w+ $/x) {
591 $_= $continuation.$_;
593 my ($varname, $qty) = m/^
595 (\w+) \s+ (?: [A-Z*]+ \s+ )?
597 /x or die "$cplex \n==\n $glpsol_out $_ ?";
598 if ($varname =~ m/^f(\d+)s(\d+)_/) {
599 my ($ix,$orgix) = ($1,$2);
600 my $flow= $flows[$ix] or die;
601 my @relsubflow= grep { $_->{Org} == $orgix }
602 @{ $flow->{Subflows} };
603 die "$ix $orgix @relsubflow" unless @relsubflow == 1;
604 my $sf= $relsubflow[0];
606 $sf->{OptProfit}= $qty * $flow->{'unitprofit'};
607 $sf->{OptCapital}= $qty * $flow->{'org_price'};
608 } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
609 my ($mv,$ix) = ($1,$2);
610 $sail_total[$ix]{$mv}= $qty;
613 print "</pre>\n" if $qa->{'debug'};
614 my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
615 pipethrough_run_finish($output,$prerr);
616 map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
617 defined $expected_total_profit or die "$prerr ?";
620 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
621 my ($flow,$col,$v,$spec) = @_;
622 if ($flow->{ExpectedUnitProfit} < 0) {
624 $spec->{String}= '(Small margin)';
625 $spec->{Align}= 'align=center';
630 $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
636 % } # ========== OPTIMISATION ==========
638 % if (!printable($m)) {
642 <li><a href="#plan">Voyage trading plan</a>
644 <li><a href="#summary">Summary statistics</a>
646 <input type=submit name=printable_pdf value="PDF">
647 <input type=submit name=printable_html value="HTML">
648 <input type=submit name=printable_ps value="PostScript">
649 <input type=submit name=printable_pdf2 value="PDF 2-up">
650 <input type=submit name=printable_ps2 value="PostScript 2-up">
653 <li><a href="#dataage">Data age summary</a>
654 <li><a href="#trades">Relevant trades</a>
657 % my @tl= gmtime $now or die $!;
659 Generated by YARRG at <strong><%
660 sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC",
661 $tl[5]+1900, @tl[4,3,2,1,0]
665 % if ($optimise) { # ========== TRADING PLAN ==========
667 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
668 % WHERE islandid = ?');
670 % my $total_total= 0;
673 <h2><a name="plan">Voyage trading plan</a></h2>
675 <table class="data" rules=groups <% printable($m) ? 'width=100%' : '' %> >
677 % if (!printable($m)) { return '<tbody>'; }
678 %# return "<tr><td colspan=7><hr>";
679 % my ($c)= qw(40 00)[$_[0]];
680 % return "<tr><td bgcolor=\"#${c}${c}${c}\" height=1 colspan=7>";
683 % foreach my $i (0..$#islandids) {
686 % $iquery->execute($islandids[$i]);
687 % my ($islandname) = $iquery->fetchrow_array();
690 <strong>Start at <% $islandname |h %></strong>
691 <td colspan=2><a href="docs#posinclass">[what are these codes?]</a>
694 % my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
695 % $total_dist += $this_dist;
699 foreach my $sf (@subflows) {
700 next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
702 $sf->{OptQty} * $sf->{Flow}{'dst_price'};
705 <strong>Sail to <% $islandname |h %></strong>
706 - <% $this_dist |h %> leagues,
707 <% $total_value %>poe at risk
713 #print "<tr><td colspan=7>" if $qa->{'debug'};
714 foreach my $od (qw(org dst)) {
715 #print " [[ i $i od $od " if $qa->{'debug'};
716 foreach my $sf (@subflows) {
718 next unless $sf->{ucfirst $od} == $i;
719 #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
721 next unless $sf->{OptQty};
722 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
723 die if $arbitrage and $sf->{Org} != $sf->{Dst};
724 my $price= $f->{"${od}_price"};
725 my $stallname= $f->{"${od}_stallname"};
726 my $todo= \$flowlists{$od}{
727 (sprintf "%010d", $f->{'ordval'}),
729 (sprintf "%07d", ($od eq 'dst' ?
730 9999999-$price : $price)),
738 $$todo->{'commodname'}= $f->{'commodname'};
739 $$todo->{'posinclass'}= '';
740 my $incl= $f->{'posinclass'};
742 my $findclass= $dbh->prepare(<<END);
743 SELECT commodclass, maxposinclass FROM commodclasses WHERE commodclassid = ?
745 $findclass->execute($f->{'commodclassid'});
746 my $classinfo= $findclass->fetchrow_hashref();
748 my $clname= $classinfo->{'commodclass'};
749 my $desc= encode_entities(sprintf "%s is under %s",
750 $f->{'commodname'}, $clname);
751 my $abbrev= substr($clname,0,1);
753 my $maxpic= $classinfo->{'maxposinclass'};
754 $desc.= (sprintf ", commodity %d of %d",
756 if ($classinfo->{'maxposinclass'} >= 8) {
757 my @tmbs= qw(0 1 2 3 4 5 6 7 8 9);
758 my $tmbi= ($incl+0.5)*$#tmbs/$maxpic;
759 $abbrev.= " ".$tmbs[$tmbi]." ";
762 $$todo->{'posinclass'}=
763 "<div class=mouseover title=\"$desc\">"
766 $$todo->{'stallname'}= $stallname;
767 $$todo->{Price}= $price;
768 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
769 $$todo->{Qty} += $sf->{OptQty};
770 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
771 $$todo->{Stalls}= $f->{"${od}Stalls"};
772 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
774 #print "]] " if $qa->{'debug'};
776 #print "</tr>" if $qa->{'debug'};
778 my ($total, $total_to_show);
780 my $show_total= sub {
781 my ($totaldesc, $sign) = @_;
782 if (defined $total) {
783 die if defined $total_to_show;
784 $total_total += $sign * $total;
785 $total_to_show= [ $totaldesc, $total ];
790 my $show_total_now= sub {
792 return unless defined $total_to_show;
793 my ($totaldesc,$totalwas) = @$total_to_show;
797 <td colspan=3><% $xinfo %>
798 <td colspan=2 align=right><% $totaldesc %>
799 <td align=right><% $totalwas |h %> total
801 $total_to_show= undef;
804 % my $show_flows= sub {
805 % my ($od,$arbitrage,$collectdeliver) = @_;
806 % my $todo= $flowlists{$od};
807 % return unless $todo;
808 % foreach my $tkey (sort keys %$todo) {
809 % my $t= $todo->{$tkey};
810 % next if $t->{"${od}Arbitrage"} != $arbitrage;
811 % $show_total_now->('');
812 % if (!$age_reported++) {
813 % my $age= $now - $t->{Timestamp};
814 % my $cellid= "da_${i}";
815 % $da_ages{$cellid}= $age;
817 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
818 % } elsif (!defined $total) {
822 % $total += $t->{Total};
823 % my $span= 0 + keys %{ $t->{Stalls} };
824 % my $td= "td rowspan=$span";
825 % tr_datarow($m,$dline);
826 <<% $td %>><% $collectdeliver %>
827 <<% $td %>><% $t->{'commodname'} |h %>
828 <<% $td %>><% $t->{'posinclass'} %>
830 % my @stalls= sort keys %{ $t->{Stalls} };
832 % my $name= $stalls[$_[0]];
837 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
838 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
839 <<% $td %> align=right><% $t->{Total} |h %> total
841 % foreach my $stallix (1..$#stalls) {
842 % tr_datarow($m,$dline);
843 % $pstall->($stallix);
851 $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
852 $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
853 $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
854 $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
856 if ($i < $#islandids) {
857 $totals .= "In hold $sail_total[$i]{mass}kg,".
858 " $sail_total[$i]{volume} l";
859 my $delim= '; spare ';
861 my ($max, $got, $units) = @_;
862 return unless defined $max;
864 $totals .= sprintf "%g %s", ($max-$got), $units;
867 $domv->($routeparams->{MaxMass}, $sail_total[$i]{mass}, 'kg');
868 $domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
871 $show_total_now->($totals);
873 </%perl><a name="summary"></a>
874 <% $tbody->(1) %><tr>
875 <td colspan=3>Total distance: <% $total_dist %> leagues.
876 <td colspan=3 align=right>Overall net cash flow
877 <td align=right><strong><%
878 $total_total < 0 ? -$total_total." loss" : $total_total." gain"
881 <& query_age:dataages, id2age => \%da_ages &>
882 Expected average profit:
883 approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
884 (considering expected losses, but ignoring rum consumed)
886 % } # ========== TRADING PLAN ==========
888 % if (!printable($m)) {
889 <h2><a name="dataage">Data age summary</a></h2>
891 my $sth_i= $dbh->prepare(<<END);
892 SELECT archipelago, islandid, islandname, timestamp
893 FROM uploads NATURAL JOIN islands
896 my $sth_a= $dbh->prepare(<<END);
897 SELECT archipelago, islandid, islandname, timestamp
898 FROM uploads NATURAL JOIN islands
899 WHERE archipelago = ?
908 my $row= $sth_current->fetchrow_hashref();
910 next if $idone{$row->{'islandid'}}++;
914 return undef if $ix < 0;
915 my $iid= $islandids[$ix];
917 $sth_i->execute($iid);
918 $sth_current= $sth_i;
920 my $arch= $archipelagoes[$ix];
921 die unless defined $arch && length $arch;
922 $sth_a->execute($arch);
923 $sth_current= $sth_a;
929 <&| query_age:agestable, now => $now, fetchrow => $fetchrow &>
930 Islands shown in reverse order of visits.<br>
934 % if (!printable($m)) {
937 % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
938 % my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
939 <h2><a name="trades">Relevant trades</a></h2>
940 <table class="data" id="trades" rules=groups>
943 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
955 <th<% $cdspan %>>Collect
956 <th<% $cdspan %>>Deliver
958 <th colspan=2>Collect
959 <th colspan=2>Deliver
965 <th colspan=3>Planned
970 <th>Island <% $cdstall %>
971 <th>Island <% $cdstall %>
992 <tr id="trades_sort">
993 % foreach my $col (@cols) {
997 % foreach my $flowix (0..$#flows) {
998 % my $flow= $flows[$flowix];
999 % my $rowid= "id_row_$flow->{UidShort}";
1000 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
1001 <td><input type=hidden name=R<% $flow->{UidShort} %> value="">
1002 <input type=checkbox name=T<% $flow->{UidShort} %> value=""
1003 <% $flow->{Suppress} ? '' : 'checked' %> >
1005 % while ($ci < @cols) {
1006 % my $col= $cols[$ci];
1009 % Align => ($col->{Text} ? '' : 'align=right')
1011 % my $cn= $col->{Name};
1013 % if (!$col->{TotalSubflows}) {
1017 % $v += $_->{$cn} foreach @{ $flow->{Subflows} };
1019 % if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
1020 % $col->{Total} += $v
1021 % if defined $col->{Total} and not $flow->{Suppress};
1022 % $v='' if !$col->{Text} && !$v;
1023 % my $sortkey= $col->{SortColKey} ?
1024 % $flow->{$col->{SortColKey}} : $v;
1025 % $ts_sortkeys{$ci}{$rowid}= $sortkey;
1026 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
1027 %> <% $spec->{Align}
1028 %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
1029 % $ci += $spec->{Span};
1032 <tr id="trades_total">
1035 % foreach my $ci (3..$#cols) {
1036 % my $col= $cols[$ci];
1038 % if (defined $col->{Total}) {
1039 <% $col->{Total} |h %>
1044 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
1045 throw => 'trades_sort', tbrow => 'trades_total' &>
1046 ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
1049 <input type=submit name=update value="Update">