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.
45 <& query_age:pageload &>
49 my $loss_per_league= defined $routeparams->{LossPerLeaguePct}
50 ? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7;
51 my $loss_per_delay_slot= 1e-8;
54 my $minprofit= $routeparams->{MinProfit} || 0;
61 my $expected_total_profit;
63 my $sd_condition= sub {
65 my $islandid= $islandids[$ix];
66 if (defined $islandid) {
67 return "${bs}.islandid = $islandid";
69 push @query_params, $archipelagoes[$ix];
70 return "${bs}_islands.archipelago = ?";
74 my $specific= !grep { !defined $_ } @islandids;
76 my %ipair2subflowinfs;
77 # $ipair2subflowinfs{$orgi,$dsti}= [ [$orgix,$distix], ... ]
80 # $subflows[0]{Flow} = { ... }
81 # $subflows[0]{Org} = $orgix
82 # $subflows[0]{Dst} = $dstix
84 foreach my $org_i (0..$#islandids) {
85 my $org_isle= $islandids[$org_i];
86 my $org_cond= $sd_condition->('sell',$org_i);
88 foreach my $dst_i ($org_i..$#islandids) {
89 my $dst_isle= $islandids[$dst_i];
90 # Don't ever consider sailing things round the houses:
91 next if defined $dst_isle and
92 grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
93 next if defined $org_isle and
94 grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
96 if ($dst_i==$org_i and !defined $org_isle) {
97 # we always want arbitrage, but mentioning an arch
98 # once shouldn't produce intra-arch trades
99 $dst_cond= "sell.islandid = buy.islandid";
101 $dst_cond= $sd_condition->('buy',$dst_i);
103 push @dst_conds, $dst_cond;
106 push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
110 push @flow_conds, "$org_cond AND (
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,
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,
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,
144 commods.commodname commodname,
145 commods.commodid commodid,
146 commods.unitmass unitmass,
147 commods.unitvolume unitvolume,
148 commods.ordval ordval,
149 commods.posinclass posinclass,
150 commods.commodclassid commodclassid,
153 buy.price - sell.price unitprofit
155 JOIN sell ON commods.commodid = sell.commodid
156 JOIN buy ON commods.commodid = buy.commodid
157 JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
158 JOIN islands AS buy_islands ON buy.islandid = buy_islands.islandid
159 JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
160 JOIN uploads AS buy_uploads ON buy.islandid = buy_uploads.islandid
161 JOIN stalls AS sell_stalls ON sell.stallid = sell_stalls.stallid
162 JOIN stalls AS buy_stalls ON buy.stallid = buy_stalls.stallid
163 JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
168 AND buy.price > sell.price
169 ORDER BY org_name, dst_name, commodname, unitprofit DESC,
170 org_price, dst_price DESC,
171 org_stallname, dst_stallname
174 my $sth= $dbh->prepare($stmt);
175 $sth->execute(@query_params);
178 my $distquery= $dbh->prepare("
179 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
183 my $d= $dists{$from}{$to};
184 return $d if defined $d;
185 $distquery->execute($from,$to);
186 $d = $distquery->fetchrow_array();
187 defined $d or die "$from $to ?";
188 $dists{$from}{$to}= $d;
192 my @cols= ({ NoSort => 1 });
196 foreach my $name (@_) {
197 my $col= { Name => $name, %$base };
198 $col->{Numeric}=1 if !$col->{Text};
203 if ($qa->{ShowStalls}) {
204 $addcols->({ Text => 1 }, qw(
205 org_name org_stallname
206 dst_name dst_stallname
209 $addcols->({Text => 1 }, qw(
213 $addcols->({ Text => 1 }, qw(commodname));
214 $addcols->({ DoReverse => 1 },
215 qw( org_price org_qty_agg dst_price dst_qty_agg
217 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
220 $addcols->({ DoReverse => 1 },
221 qw( unitprofit MaxQty MaxCapital MaxProfit dist
223 foreach my $v (qw(MaxMass MaxVolume)) {
225 DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
230 % if ($qa->{'debug'}) {
233 <% join(' | ',@query_params) |h %>
237 <& dumptable:start, qa => $qa, sth => $sth &>
240 % while ($got= $sth->fetchrow_hashref()) {
243 my $f= $flows[$#flows];
246 grep { $f->{$_} ne $got->{$_} }
247 qw(org_id org_price dst_id dst_price commodid)
249 # Make a new flow rather than adding to the existing one
252 Ix => scalar(@flows),
255 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
256 if !$qa->{ShowStalls};
259 foreach my $od (qw(org dst)) {
261 $got->{"${od}_stallname"}
263 $got->{"${od}_qty_stall"}
268 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
270 <& dumptable:end, qa => $qa &>
273 % if (@islandids==1) {
274 % if (defined $islandids[0]) {
275 Searched for arbitrage trades only.
277 Searched for arbitrage trades only, in <% $archipelagoes[0] |h %>
278 <a href="docs#arbitrage">[?]</a>.
285 print 'No profitable trading opportunities were found.';
290 my %opportunity_value;
294 return join '_', map { $f->{$_} } qw(org_id dst_id commodid);
297 my $any_previous_suppression= 0;
299 foreach my $f (@flows) {
301 $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
302 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
303 $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
304 $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
306 $f->{MaxMassSortKey}= $f->{MaxQty} * $f->{'unitmass'};
307 $f->{MaxVolumeSortKey}= $f->{MaxQty} * $f->{'unitvolume'};
308 foreach my $v (qw(Mass Volume)) {
309 $f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6;
312 $f->{MarginSortKey}= sprintf "%d",
313 $f->{'dst_price'} * 10000 / $f->{'org_price'};
314 $f->{Margin}= sprintf "%3.1f%%",
315 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
317 $f->{ExpectedUnitProfit}=
318 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
321 $dists{'org_id'}{'dst_id'}= $f->{'dist'};
323 $opportunity_value{ $oppo_key->($f) } += $f->{MaxProfit};
325 my @uid= $f->{commodid};
326 foreach my $od (qw(org dst)) {
331 $f->{"${od}_stallid"}
332 if $qa->{ShowStalls};
334 $f->{UidLong}= join '_', @uid;
342 my $this= $uue % $base;
343 #print STDERR "uue=$uue this=$this ";
348 $cmpu .= chr($this + ($this < 26 ? ord('a') :
349 $this < 52 ? ord('A')-26
351 #print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
352 die "$cmpu $uue ?" if length $cmpu > 20;
356 $f->{UidShort}= $cmpu;
358 if ($qa->{'debug'}) {
363 my $v= m/^[a-z]/ ? ord($&)-ord('a') :
364 m/^[A-Z]/ ? ord($&)-ord('A')+26 :
365 m/^[0-9]/ ? ord($&)-ord('0')+52 :
371 #print STDERR "(next)\n";
373 die "$f->{UidShort} $_ ?" unless defined $mul;
374 $outuid[$#outuid] += $v * $mul;
376 #print STDERR "$f->{UidShort} $_ $& v=$v mul=$mul ord()=".ord($&).
377 # "[vs.".ord('a').",".ord('A').",".ord('0')."]".
378 # " outuid=@outuid\n";
383 my $recons_long= join '_', @outuid;
384 $f->{UidLong} eq $recons_long or
385 die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
389 foreach my $f (@flows) {
391 if ($reset_suppressions || !defined $qa->{"R$f->{UidShort}"}) {
392 if ($opportunity_value{ $oppo_key->($f) } < $minprofit) {
396 if (!defined $qa->{"T$f->{UidShort}"}) {
397 $any_previous_suppression= 1;
401 if (!$f->{Suppress}) {
402 my $sfis= $ipair2subflowinfs{$f->{'org_id'},$f->{'dst_id'}};
403 foreach my $sfi (@$sfis) {
408 Var => sprintf "f%ss%s_c%d_p%d_%d_p%d_%d",
411 $sfi->[0], $f->{'org_price'},
412 $sfi->[1], $f->{'dst_price'}
414 push @{ $f->{Subflows} }, $subflow;
415 push @subflows, $subflow;
426 Route contains archipelago(es), not just specific islands.
427 % } elsif (!@subflows) {
429 % if ($any_previous_suppression) {
430 All available trades deselected.
432 No available trades meet the specified minimum trade value, so
433 all available trades deselected.
440 Therefore, optimal voyage trade plan not calculated.
442 % } else { # ========== OPTMISATION ==========
451 my %stall_poe_limits;
453 foreach my $sf (@subflows) {
454 my $eup= $sf->{Flow}{ExpectedUnitProfit};
455 $eup *= (1.0-$loss_per_delay_slot) ** $sf->{Org};
457 %+.20f %s", $eup, $sf->{Var};
458 if ($qa->{ShowStalls}>=2) {
459 my $stall= $sf->{Flow}{'dst_stallid'};
460 push @{ $stall_poe_limits{$stall} }, $sf;
469 foreach my $flow (@flows) {
470 next if $flow->{Suppress};
471 foreach my $od (qw(org dst)) {
472 my $limname= join '_', (
474 'i'.$flow->{"${od}_id"},
475 'c'.$flow->{'commodid'},
476 $flow->{"${od}_price"},
477 $flow->{"${od}_stallid"},
480 push @{ $avail_lims{$limname}{SubflowVars} },
481 map { $_->{Var} } @{ $flow->{Subflows} };
482 $avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
485 foreach my $limname (sort keys %avail_lims) {
486 my $c= $avail_lims{$limname};
488 sprintf(" %-30s","$limname:")." ".
489 join("+", @{ $c->{SubflowVars} }).
490 " <= ".$c->{Qty}."\n";
493 foreach my $ci (0..($#islandids-1)) {
496 foreach my $f (@flows) {
497 next if $f->{Suppress};
498 my @relsubflow= grep {
501 } @{ $f->{Subflows} };
502 next unless @relsubflow;
503 die unless @relsubflow == 1;
504 push @rel_subflows, @relsubflow;
505 #print " RELEVANT $ci $relsubflow[0]->{Var} ";
507 #print " RELEVANT $ci COUNT ".scalar(@rel_subflows)." ";
508 if (!@rel_subflows) {
509 foreach my $mv (qw(mass volume capital)) {
510 $sail_total[$ci]{$mv}= 0;
515 my $applylimit= sub {
516 my ($mv, $f2val) = @_;
517 my $max= $routeparams->{"Max".ucfirst $mv};
518 $max= 1e9 unless defined $max;
519 #print " DEFINED MAX $mv $max ";
521 ". sprintf("%-10s","${mv}_$ci:")." ".
523 #print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
524 $f2val->($_->{Flow}) .' '. $_->{Var};
529 $applylimit->('mass', sub { $_[0]{'unitmass'} *1e-3 });
530 $applylimit->('volume', sub { $_[0]{'unitvolume'}*1e-3 });
531 $applylimit->('capital', sub { $_[0]{'org_price'} });
533 my @gem_subflows= grep { $_->{Flow}{flags} =~ m/g/ } @rel_subflows;
536 ". sprintf("%-10s","gems_$ci:")." ".
537 join(" + ", map { $_->{Var} } @gem_subflows). " <= $max_gems";
543 if ($qa->{ShowStalls}>=2) {
544 my $stallpoe= $dbh->prepare(<<END);
545 SELECT max(qty*price) FROM buy WHERE stallid=?
547 foreach my $stallid (sort { $a <=> $b } keys %stall_poe_limits) {
548 $stallpoe->execute($stallid);
549 my ($lim)= $stallpoe->fetchrow_array();
552 ". sprintf("%-15s","poe_$stallid:")." ".
554 sprintf "%d %s", $_->{Flow}{'dst_price'}, $_->{Var};
555 } @{ $stall_poe_limits{$stallid} }).
564 ", map { "$_->{Var} >= 0" } @subflows)."
571 ", map { $_->{Var} } @subflows)."
576 if ($qa->{'debug'}) {
585 my ($how, @opts) = @_;
586 my $input= pipethrough_prep();
587 print $input $cplex or die $!;
588 my $output= pipethrough_run_along($input, undef, 'glpsol',
589 qw(glpsol --tmlim 5 --memlim 20), @opts,
590 qw( --cpxlp /dev/stdin -o /dev/stdout));
591 if ($qa->{'debug'}) {
592 print "<h3>@opts</h3>\n<pre>\n";
594 $expected_total_profit= undef;
595 $_->{OptQty}= undef foreach @subflows;
596 my $found_section= 0;
603 print encode_entities($_) if $qa->{'debug'};
604 if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
605 die "$_ $found_section ?" if $found_section>0;
609 if ((m/^Integer optimization begins/ .. 0) &&
610 m/^\+ \s* \d+\: \s* mip \s* = \s* \d/) {
614 if (m/^TIME LIMIT EXCEEDED/) {
617 if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
618 $expected_total_profit= $1;
620 next unless $found_section==1;
621 if (!length $continuation) {
622 next if !$continuation && m/^[- ]+$/;
627 if (m/^ \s* \d+ \s+ \w+ $/x) {
632 $_= $continuation.$_;
634 my ($varname, $qty) = m/^
636 (\w+) \s+ (?: [A-Z*]+ \s+ )?
637 ([-+0-9]+)(?: [.e][-+e0-9.]* )? \s
638 /x or die "$cplex \n==\n $glpsol_out $_ ?";
639 if ($varname =~ m/^f(\d+)s(\d+)_/) {
640 my ($ix,$orgix) = ($1,$2);
641 my $flow= $flows[$ix] or die;
642 my @relsubflow= grep { $_->{Org} == $orgix }
643 @{ $flow->{Subflows} };
644 die "$ix $orgix @relsubflow" unless @relsubflow == 1;
645 my $sf= $relsubflow[0];
647 $sf->{OptProfit}= $qty * $flow->{'unitprofit'};
648 $sf->{OptCapital}= $qty * $flow->{'org_price'};
649 } elsif ($varname =~ m/^(mass|volume|capital)_(\d+)$/) {
650 my ($mv,$ix) = ($1,$2);
651 $sail_total[$ix]{$mv}= $qty;
654 print "</pre>\n" if $qa->{'debug'};
655 my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
656 pipethrough_run_finish($output,$prerr);
657 map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
658 defined $expected_total_profit or die "$prerr ?";
659 return 0 unless $somemip || !$timelimit;
664 unless ($try_solve->('Optimisation successful',
665 qw( --intopt --cuts --bfs )) or
666 $try_solve->('<strong>Complex problem, downgraded</strong>'.
667 ' to rounded-down LP.',
670 <h2>Optimisation failed</h2>
671 The linear/mixed-integer optimisation failed.
672 Please report this problem.
681 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
682 my ($flow,$col,$v,$spec) = @_;
683 if ($flow->{ExpectedUnitProfit} < 0) {
685 $spec->{String}= '(Small margin)';
686 $spec->{Align}= 'align=center';
691 $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
697 % } # ========== OPTIMISATION ==========
699 % if (!printable($m)) {
703 <li><a href="#summary">Summary</a>
704 <li><a href="#plan">Voyage trading plan</a>
707 <input type=submit name=printable_pdf value="PDF">
708 <input type=submit name=printable_html value="HTML">
709 <input type=submit name=printable_ps value="PostScript">
710 <input type=submit name=printable_pdf2 value="PDF 2-up">
711 <input type=submit name=printable_ps2 value="PostScript 2-up">
714 <li><a href="#dataage">Relevant data ages</a>
715 <li><a href="#trades">Relevant trades</a>
718 % my @tl= gmtime $now or die $!;
720 Generated by YARRG at <strong><%
721 sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC",
722 $tl[5]+1900, @tl[4,3,2,1,0]
726 % if ($optimise) { # ========== TRADING PLAN ==========
728 my $iquery= $dbh->prepare('SELECT islandname FROM islands
729 WHERE islandid = ?');
733 my @oldest= (-1, 'nowhere');
736 my $plan_table_info= printable($m) ? 'width=100%' : '';
738 <table class="data" rules=groups $plan_table_info >
742 if (!printable($m)) { return '<tbody>'; }
743 my ($c)= qw(40 00)[$_[0]];
744 return "<tr><td bgcolor=\"#${c}${c}${c}\" height=1 colspan=7>";
747 foreach my $i (0..$#islandids) {
748 $plan_html .= $tbody->(1);
749 $plan_html .= "<tr>\n";
750 $iquery->execute($islandids[$i]);
751 my ($islandnamepr)= encode_entities( $iquery->fetchrow_array() );
756 <strong>Start at $islandnamepr</strong>
757 <td colspan=2><a href="docs#posinclass">[what are these codes?]</a>
761 my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
762 $total_dist += $this_dist;
767 foreach my $sf (@subflows) {
768 next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
770 $sf->{OptQty} * $sf->{Flow}{'dst_price'};
773 <strong>Sail to $islandnamepr</strong>
774 - $this_dist leagues, $total_value poe at risk
780 #print "<tr><td colspan=7>" if $qa->{'debug'};
781 foreach my $od (qw(org dst)) {
782 #print " [[ i $i od $od " if $qa->{'debug'};
783 foreach my $sf (@subflows) {
785 next unless $sf->{ucfirst $od} == $i;
786 #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
788 next unless $sf->{OptQty};
789 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
790 die if $arbitrage and $sf->{Org} != $sf->{Dst};
791 my $price= $f->{"${od}_price"};
792 my $stallname= $f->{"${od}_stallname"};
793 my $todo= \$flowlists{$od}{
794 (sprintf "%010d", $f->{'ordval'}),
796 (sprintf "%07d", ($od eq 'dst' ?
797 9999999-$price : $price)),
805 $$todo->{'commodid'}= $f->{'commodid'};
806 $$todo->{'commodname'}= $f->{'commodname'};
807 $$todo->{'posinclass'}= '';
808 my $incl= $f->{'posinclass'};
810 my $findclass= $dbh->prepare(<<END);
811 SELECT commodclass, maxposinclass FROM commodclasses WHERE commodclassid = ?
813 $findclass->execute($f->{'commodclassid'});
814 my $classinfo= $findclass->fetchrow_hashref();
816 my $clname= $classinfo->{'commodclass'};
817 my $desc= encode_entities(sprintf "%s is under %s",
818 $f->{'commodname'}, $clname);
819 my $abbrev= substr($clname,0,1);
821 my $maxpic= $classinfo->{'maxposinclass'};
822 $desc.= (sprintf ", commodity %d of %d",
824 if ($classinfo->{'maxposinclass'} >= 8) {
825 my @tmbs= qw(0 1 2 3 4 5 6 7 8 9);
826 my $tmbi= ($incl+0.5)*$#tmbs/$maxpic;
827 $abbrev.= " ".$tmbs[$tmbi]." ";
830 $$todo->{'posinclass'}=
831 "<div class=mouseover title=\"$desc\">"
834 $$todo->{'stallname'}= $stallname;
835 $$todo->{Price}= $price;
836 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
837 $$todo->{Qty} += $sf->{OptQty};
838 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
839 $$todo->{Stalls}= $f->{"${od}Stalls"};
840 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
842 #print "]] " if $qa->{'debug'};
844 #print "</tr>" if $qa->{'debug'};
846 my ($total, $total_to_show);
848 my $show_total= sub {
849 my ($totaldesc, $sign) = @_;
850 if (defined $total) {
851 die if defined $total_to_show;
852 $total_total += $sign * $total;
853 $total_to_show= [ $totaldesc, $total ];
858 my $show_total_now= sub {
860 return unless defined $total_to_show;
861 my ($totaldesc,$totalwas) = @$total_to_show;
866 <td colspan=2 align=right>$totaldesc
867 <td align=right>$totalwas total
869 $total_to_show= undef;
871 my $show_flows= sub {
872 my ($od,$arbitrage,$collectdeliver) = @_;
873 my $todo= $flowlists{$od};
875 foreach my $tkey (sort keys %$todo) {
876 my $t= $todo->{$tkey};
877 next if $t->{"${od}Arbitrage"} != $arbitrage;
878 $show_total_now->('');
879 if (!$age_reported++) {
880 my $age= $now - $t->{Timestamp};
881 @oldest= ($age,$islandnamepr) if $oldest[0] < $age;
882 my $cellid= "da_${i}";
883 my $agepr= prettyprint_age($age);
884 $da_ages{$cellid}= $age;
886 <td colspan=2>(Data age: <span id="$cellid">$agepr</span>)
888 } elsif (!defined $total) {
890 $plan_html .= $tbody->(0);
892 $total += $t->{Total};
893 my $span= 0 + keys %{ $t->{Stalls} };
894 my $td= "td rowspan=$span";
895 my %linkqf= (%{ $qa->{'baseqf'} }, %{ $qa->{'queryqf'} });
896 $linkqf{'query'}= 'commod';
897 $linkqf{'commodstring'}= $t->{'commodname'};
898 $linkqf{'commodid'}= $t->{'commodid'};
899 my $linkqfpr= encode_entities( $quri->(%linkqf) );
900 my $commodnamepr= encode_entities($t->{'commodname'});
901 $plan_html .= tr_datarow_s($m,$dline) . <<END;
903 <$td><a href="$linkqfpr">$commodnamepr</a>
904 <$td>$t->{'posinclass'}
906 my @stalls= sort keys %{ $t->{Stalls} };
908 my $namepr= encode_entities( $stalls[$_[0]] );
916 <$td align=right>$t->{Price} poe ea.
917 <$td align=right>$t->{Qty} unit(s)
918 <$td align=right>$t->{Total} total
920 foreach my $stallix (1..$#stalls) {
921 $plan_html .= tr_datarow_s($m,$dline);
929 $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
930 $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
931 $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
932 $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
934 if ($i < $#islandids) {
935 $totals .= "In hold $sail_total[$i]{mass}kg,".
936 " $sail_total[$i]{volume} l";
937 my $delim= '; spare ';
939 my ($max, $got, $units) = @_;
940 return unless defined $max;
942 $totals .= sprintf "%g %s", ($max-$got), $units;
945 $domv->($routeparams->{MaxMass}, $sail_total[$i]{mass}, 'kg');
946 $domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
949 $show_total_now->($totals);
952 my $cashflowpr= $total_total < 0
953 ? -$total_total." loss"
954 : $total_total." gain";
957 foreach my $cap (map { $_->{capital} } @sail_total) {
958 $max_capital= $cap if $cap > $max_capital;
961 $da_ages{'oldest'}= $oldest[0];
963 $plan_html .= $tbody->(1) . <<END;
965 <td colspan=3>Total distance: $total_dist leagues.
966 <td colspan=3 align=right>Overall net cash flow
967 <td align=right><strong>$cashflowpr</strong>
972 % if (!printable($m)) {
973 <h2><a name="summary">Summary</a></h2>
979 <td><strong><% $total_dist %></strong> leagues,
980 <strong><% scalar(@islandids) %></strong> island(s)
982 <td>Planned net cash flow:
983 <td><strong><% $cashflowpr %></strong>
985 <td>Expected profit on average: approx.
987 <strong><% sprintf "%d", $expected_total_profit %></strong> poe
988 (considering expected losses, but ignoring rum consumed)
990 <td>Capital required:
992 <strong><% $max_capital %></strong> poe or less
994 <td>Oldest market data used:
995 <td><strong id="oldest"><% prettyprint_age($oldest[0]) %></strong>
998 <td colspan=2><% $opt_how %>
1002 <h2><a name="plan">Voyage trading plan</a></h2>
1004 <& query_age:dataages, id2age => \%da_ages &>
1006 % } # ========== TRADING PLAN ==========
1008 % if (!printable($m)) {
1009 <h2><a name="dataage">Relevant data ages</a></h2>
1011 my $sth_i= $dbh->prepare(<<END);
1012 SELECT archipelago, islandid, islandname, timestamp
1013 FROM uploads NATURAL JOIN islands
1016 my $sth_a= $dbh->prepare(<<END);
1017 SELECT archipelago, islandid, islandname, timestamp
1018 FROM uploads NATURAL JOIN islands
1019 WHERE archipelago = ?
1028 my $row= $sth_current->fetchrow_hashref();
1030 next if $idone{$row->{'islandid'}}++;
1034 return undef if $ix < 0;
1035 my $iid= $islandids[$ix];
1037 $sth_i->execute($iid);
1038 $sth_current= $sth_i;
1040 my $arch= $archipelagoes[$ix];
1041 die unless defined $arch && length $arch;
1042 $sth_a->execute($arch);
1043 $sth_current= $sth_a;
1049 <&| query_age:agestable, now => $now, fetchrow => $fetchrow &>
1050 Islands shown in reverse order of visits.<br>
1054 % if (!printable($m)) {
1057 % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
1058 % my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
1059 <h2><a name="trades">Relevant trades</a></h2>
1060 <table class="data" id="trades" rules=groups>
1063 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
1075 <th<% $cdspan %>>Collect
1076 <th<% $cdspan %>>Deliver
1078 <th colspan=2>Collect
1079 <th colspan=2>Deliver
1080 <th colspan=2>Profit
1085 <th colspan=3>Planned
1090 <th>Island <% $cdstall %>
1091 <th>Island <% $cdstall %>
1112 <tr id="trades_sort">
1113 % foreach my $col (@cols) {
1117 % foreach my $flowix (0..$#flows) {
1118 % my $flow= $flows[$flowix];
1119 % my $rowid= "id_row_$flow->{UidShort}";
1120 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
1121 <td><input type=hidden name=R<% $flow->{UidShort} %> value="">
1122 <input type=checkbox name=T<% $flow->{UidShort} %> value=""
1123 <% $flow->{Suppress} ? '' : 'checked' %> >
1125 % while ($ci < @cols) {
1126 % my $col= $cols[$ci];
1129 % Align => ($col->{Text} ? '' : 'align=right')
1131 % my $cn= $col->{Name};
1133 % if (!$col->{TotalSubflows}) {
1137 % $v += $_->{$cn} foreach @{ $flow->{Subflows} };
1139 % if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
1140 % $col->{Total} += $v
1141 % if defined $col->{Total} and not $flow->{Suppress};
1142 % $v='' if !$col->{Text} && !$v;
1143 % my $sortkey= $col->{SortColKey} ?
1144 % $flow->{$col->{SortColKey}} : $v;
1145 % $ts_sortkeys{$ci}{$rowid}= $sortkey;
1146 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
1147 %> <% $spec->{Align}
1148 %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
1149 % $ci += $spec->{Span};
1152 <tr id="trades_total">
1155 % foreach my $ci (3..$#cols) {
1156 % my $col= $cols[$ci];
1158 % if (defined $col->{Total}) {
1159 <% $col->{Total} |h %>
1164 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
1165 throw => 'trades_sort', tbrow => 'trades_total' &>
1166 ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
1169 <input type=submit name=update value="Update">