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;
425 Route contains archipelago(es), not just specific islands.
426 % } elsif (!@subflows) {
428 % if ($any_previous_suppression) {
429 All available trades deselected.
431 No available trades meet the specified minimum trade value, so
432 all available trades deselected.
439 Therefore, optimal voyage trade plan not calculated.
441 % } else { # ========== OPTMISATION ==========
450 my %stall_poe_limits;
452 foreach my $sf (@subflows) {
453 my $eup= $sf->{Flow}{ExpectedUnitProfit};
454 $eup *= (1.0-$loss_per_delay_slot) ** $sf->{Org};
456 %+.20f %s", $eup, $sf->{Var};
457 if ($qa->{ShowStalls}>=2) {
458 my $stall= $sf->{Flow}{'dst_stallid'};
459 push @{ $stall_poe_limits{$stall} }, $sf;
468 foreach my $flow (@flows) {
469 next if $flow->{Suppress};
470 foreach my $od (qw(org dst)) {
471 my $limname= join '_', (
473 'i'.$flow->{"${od}_id"},
474 'c'.$flow->{'commodid'},
475 $flow->{"${od}_price"},
476 $flow->{"${od}_stallid"},
479 push @{ $avail_lims{$limname}{SubflowVars} },
480 map { $_->{Var} } @{ $flow->{Subflows} };
481 $avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
484 foreach my $limname (sort keys %avail_lims) {
485 my $c= $avail_lims{$limname};
487 sprintf(" %-30s","$limname:")." ".
488 join("+", @{ $c->{SubflowVars} }).
489 " <= ".$c->{Qty}."\n";
492 foreach my $ci (0..($#islandids-1)) {
495 foreach my $f (@flows) {
496 next if $f->{Suppress};
497 my @relsubflow= grep {
500 } @{ $f->{Subflows} };
501 next unless @relsubflow;
502 die unless @relsubflow == 1;
503 push @rel_subflows, @relsubflow;
504 #print " RELEVANT $ci $relsubflow[0]->{Var} ";
506 #print " RELEVANT $ci COUNT ".scalar(@rel_subflows)." ";
507 if (!@rel_subflows) {
508 foreach my $mv (qw(mass volume)) {
509 $sail_total[$ci]{$mv}= 0;
514 my $applylimit= sub {
515 my ($mv, $f2val) = @_;
516 my $max= $routeparams->{"Max".ucfirst $mv};
517 $max= 1e9 unless defined $max;
518 #print " DEFINED MAX $mv $max ";
520 ". sprintf("%-10s","${mv}_$ci:")." ".
522 #print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
523 $f2val->($_->{Flow}) .' '. $_->{Var};
528 $applylimit->('mass', sub { $_[0]{'unitmass'} *1e-3 });
529 $applylimit->('volume', sub { $_[0]{'unitvolume'}*1e-3 });
530 $applylimit->('capital', sub { $_[0]{'org_price'} });
532 my @gem_subflows= grep { $_->{Flow}{flags} =~ m/g/ } @rel_subflows;
535 ". sprintf("%-10s","gems_$ci:")." ".
536 join(" + ", map { $_->{Var} } @gem_subflows). " <= $max_gems";
542 if ($qa->{ShowStalls}>=2) {
543 my $stallpoe= $dbh->prepare(<<END);
544 SELECT max(qty*price) FROM buy WHERE stallid=?
546 foreach my $stallid (sort { $a <=> $b } keys %stall_poe_limits) {
547 $stallpoe->execute($stallid);
548 my ($lim)= $stallpoe->fetchrow_array();
551 ". sprintf("%-15s","poe_$stallid:")." ".
553 sprintf "%d %s", $_->{Flow}{'dst_price'}, $_->{Var};
554 } @{ $stall_poe_limits{$stallid} }).
563 ", map { "$_->{Var} >= 0" } @subflows)."
570 ", map { $_->{Var} } @subflows)."
575 if ($qa->{'debug'}) {
585 my $input= pipethrough_prep();
586 print $input $cplex or die $!;
587 my $output= pipethrough_run_along($input, undef, 'glpsol',
588 qw(glpsol --tmlim 1 --memlim 5), @opts,
589 qw( --cpxlp /dev/stdin -o /dev/stdout));
590 if ($qa->{'debug'}) {
591 print "<h3>@opts</h3>\n<pre>\n";
593 $expected_total_profit= undef;
594 $_->{OptQty}= undef foreach @subflows;
595 my $found_section= 0;
602 print encode_entities($_) if $qa->{'debug'};
603 if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
604 die "$_ $found_section ?" if $found_section>0;
608 if ((m/^Integer optimization begins/ .. 0) &&
609 m/^\+ \s* \d+\: \s* mip \s* = \s* \d/) {
613 if (m/^TIME LIMIT EXCEEDED/) {
616 if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
617 $expected_total_profit= $1;
619 next unless $found_section==1;
620 if (!length $continuation) {
621 next if !$continuation && m/^[- ]+$/;
626 if (m/^ \s* \d+ \s+ \w+ $/x) {
631 $_= $continuation.$_;
633 my ($varname, $qty) = m/^
635 (\w+) \s+ (?: [A-Z*]+ \s+ )?
636 ([-+0-9]+)(?: [.e][-+e0-9.]* )? \s
637 /x or die "$cplex \n==\n $glpsol_out $_ ?";
638 if ($varname =~ m/^f(\d+)s(\d+)_/) {
639 my ($ix,$orgix) = ($1,$2);
640 my $flow= $flows[$ix] or die;
641 my @relsubflow= grep { $_->{Org} == $orgix }
642 @{ $flow->{Subflows} };
643 die "$ix $orgix @relsubflow" unless @relsubflow == 1;
644 my $sf= $relsubflow[0];
646 $sf->{OptProfit}= $qty * $flow->{'unitprofit'};
647 $sf->{OptCapital}= $qty * $flow->{'org_price'};
648 } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
649 my ($mv,$ix) = ($1,$2);
650 $sail_total[$ix]{$mv}= $qty;
653 print "</pre>\n" if $qa->{'debug'};
654 my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
655 pipethrough_run_finish($output,$prerr);
656 map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
657 defined $expected_total_profit or die "$prerr ?";
658 return $somemip || !$timelimit;
661 unless ($try_solve->(qw( --intopt --cuts --bfs )) or
662 $try_solve->(qw( --nomip ))) {
664 <h2>Optimisation failed</h2>
665 The linear/mixed-integer optimisation failed.
666 Please report this problem.
675 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
676 my ($flow,$col,$v,$spec) = @_;
677 if ($flow->{ExpectedUnitProfit} < 0) {
679 $spec->{String}= '(Small margin)';
680 $spec->{Align}= 'align=center';
685 $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
691 % } # ========== OPTIMISATION ==========
693 % if (!printable($m)) {
697 <li><a href="#plan">Voyage trading plan</a>
699 <li><a href="#summary">Summary statistics</a>
701 <input type=submit name=printable_pdf value="PDF">
702 <input type=submit name=printable_html value="HTML">
703 <input type=submit name=printable_ps value="PostScript">
704 <input type=submit name=printable_pdf2 value="PDF 2-up">
705 <input type=submit name=printable_ps2 value="PostScript 2-up">
708 <li><a href="#dataage">Data age summary</a>
709 <li><a href="#trades">Relevant trades</a>
712 % my @tl= gmtime $now or die $!;
714 Generated by YARRG at <strong><%
715 sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC",
716 $tl[5]+1900, @tl[4,3,2,1,0]
720 % if ($optimise) { # ========== TRADING PLAN ==========
722 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
723 % WHERE islandid = ?');
725 % my $total_total= 0;
728 <h2><a name="plan">Voyage trading plan</a></h2>
730 <table class="data" rules=groups <% printable($m) ? 'width=100%' : '' %> >
732 % if (!printable($m)) { return '<tbody>'; }
733 %# return "<tr><td colspan=7><hr>";
734 % my ($c)= qw(40 00)[$_[0]];
735 % return "<tr><td bgcolor=\"#${c}${c}${c}\" height=1 colspan=7>";
738 % foreach my $i (0..$#islandids) {
741 % $iquery->execute($islandids[$i]);
742 % my ($islandname) = $iquery->fetchrow_array();
745 <strong>Start at <% $islandname |h %></strong>
746 <td colspan=2><a href="docs#posinclass">[what are these codes?]</a>
749 % my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
750 % $total_dist += $this_dist;
754 foreach my $sf (@subflows) {
755 next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
757 $sf->{OptQty} * $sf->{Flow}{'dst_price'};
760 <strong>Sail to <% $islandname |h %></strong>
761 - <% $this_dist |h %> leagues,
762 <% $total_value %>poe at risk
768 #print "<tr><td colspan=7>" if $qa->{'debug'};
769 foreach my $od (qw(org dst)) {
770 #print " [[ i $i od $od " if $qa->{'debug'};
771 foreach my $sf (@subflows) {
773 next unless $sf->{ucfirst $od} == $i;
774 #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
776 next unless $sf->{OptQty};
777 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
778 die if $arbitrage and $sf->{Org} != $sf->{Dst};
779 my $price= $f->{"${od}_price"};
780 my $stallname= $f->{"${od}_stallname"};
781 my $todo= \$flowlists{$od}{
782 (sprintf "%010d", $f->{'ordval'}),
784 (sprintf "%07d", ($od eq 'dst' ?
785 9999999-$price : $price)),
793 $$todo->{'commodid'}= $f->{'commodid'};
794 $$todo->{'commodname'}= $f->{'commodname'};
795 $$todo->{'posinclass'}= '';
796 my $incl= $f->{'posinclass'};
798 my $findclass= $dbh->prepare(<<END);
799 SELECT commodclass, maxposinclass FROM commodclasses WHERE commodclassid = ?
801 $findclass->execute($f->{'commodclassid'});
802 my $classinfo= $findclass->fetchrow_hashref();
804 my $clname= $classinfo->{'commodclass'};
805 my $desc= encode_entities(sprintf "%s is under %s",
806 $f->{'commodname'}, $clname);
807 my $abbrev= substr($clname,0,1);
809 my $maxpic= $classinfo->{'maxposinclass'};
810 $desc.= (sprintf ", commodity %d of %d",
812 if ($classinfo->{'maxposinclass'} >= 8) {
813 my @tmbs= qw(0 1 2 3 4 5 6 7 8 9);
814 my $tmbi= ($incl+0.5)*$#tmbs/$maxpic;
815 $abbrev.= " ".$tmbs[$tmbi]." ";
818 $$todo->{'posinclass'}=
819 "<div class=mouseover title=\"$desc\">"
822 $$todo->{'stallname'}= $stallname;
823 $$todo->{Price}= $price;
824 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
825 $$todo->{Qty} += $sf->{OptQty};
826 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
827 $$todo->{Stalls}= $f->{"${od}Stalls"};
828 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
830 #print "]] " if $qa->{'debug'};
832 #print "</tr>" if $qa->{'debug'};
834 my ($total, $total_to_show);
836 my $show_total= sub {
837 my ($totaldesc, $sign) = @_;
838 if (defined $total) {
839 die if defined $total_to_show;
840 $total_total += $sign * $total;
841 $total_to_show= [ $totaldesc, $total ];
846 my $show_total_now= sub {
848 return unless defined $total_to_show;
849 my ($totaldesc,$totalwas) = @$total_to_show;
853 <td colspan=3><% $xinfo %>
854 <td colspan=2 align=right><% $totaldesc %>
855 <td align=right><% $totalwas |h %> total
857 $total_to_show= undef;
860 % my $show_flows= sub {
861 % my ($od,$arbitrage,$collectdeliver) = @_;
862 % my $todo= $flowlists{$od};
863 % return unless $todo;
864 % foreach my $tkey (sort keys %$todo) {
865 % my $t= $todo->{$tkey};
866 % next if $t->{"${od}Arbitrage"} != $arbitrage;
867 % $show_total_now->('');
868 % if (!$age_reported++) {
869 % my $age= $now - $t->{Timestamp};
870 % my $cellid= "da_${i}";
871 % $da_ages{$cellid}= $age;
873 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
874 % } elsif (!defined $total) {
878 % $total += $t->{Total};
879 % my $span= 0 + keys %{ $t->{Stalls} };
880 % my $td= "td rowspan=$span";
881 % my %linkqf= (%{ $qa->{'baseqf'} }, %{ $qa->{'queryqf'} });
882 % $linkqf{'query'}= 'commod';
883 % $linkqf{'commodstring'}= $t->{'commodname'};
884 % $linkqf{'commodid'}= $t->{'commodid'};
885 % tr_datarow($m,$dline);
886 <<% $td %>><% $collectdeliver %>
887 <<% $td %>><a href="<% $quri->(%linkqf) %>"><% $t->{'commodname'} |h %></a>
888 <<% $td %>><% $t->{'posinclass'} %>
890 % my @stalls= sort keys %{ $t->{Stalls} };
892 % my $name= $stalls[$_[0]];
897 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
898 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
899 <<% $td %> align=right><% $t->{Total} |h %> total
901 % foreach my $stallix (1..$#stalls) {
902 % tr_datarow($m,$dline);
903 % $pstall->($stallix);
911 $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
912 $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
913 $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
914 $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
916 if ($i < $#islandids) {
917 $totals .= "In hold $sail_total[$i]{mass}kg,".
918 " $sail_total[$i]{volume} l";
919 my $delim= '; spare ';
921 my ($max, $got, $units) = @_;
922 return unless defined $max;
924 $totals .= sprintf "%g %s", ($max-$got), $units;
927 $domv->($routeparams->{MaxMass}, $sail_total[$i]{mass}, 'kg');
928 $domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
931 $show_total_now->($totals);
933 </%perl><a name="summary"></a>
934 <% $tbody->(1) %><tr>
935 <td colspan=3>Total distance: <% $total_dist %> leagues.
936 <td colspan=3 align=right>Overall net cash flow
937 <td align=right><strong><%
938 $total_total < 0 ? -$total_total." loss" : $total_total." gain"
941 <& query_age:dataages, id2age => \%da_ages &>
942 Expected average profit:
943 approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
944 (considering expected losses, but ignoring rum consumed)
946 % } # ========== TRADING PLAN ==========
948 % if (!printable($m)) {
949 <h2><a name="dataage">Data age summary</a></h2>
951 my $sth_i= $dbh->prepare(<<END);
952 SELECT archipelago, islandid, islandname, timestamp
953 FROM uploads NATURAL JOIN islands
956 my $sth_a= $dbh->prepare(<<END);
957 SELECT archipelago, islandid, islandname, timestamp
958 FROM uploads NATURAL JOIN islands
959 WHERE archipelago = ?
968 my $row= $sth_current->fetchrow_hashref();
970 next if $idone{$row->{'islandid'}}++;
974 return undef if $ix < 0;
975 my $iid= $islandids[$ix];
977 $sth_i->execute($iid);
978 $sth_current= $sth_i;
980 my $arch= $archipelagoes[$ix];
981 die unless defined $arch && length $arch;
982 $sth_a->execute($arch);
983 $sth_current= $sth_a;
989 <&| query_age:agestable, now => $now, fetchrow => $fetchrow &>
990 Islands shown in reverse order of visits.<br>
994 % if (!printable($m)) {
997 % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
998 % my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
999 <h2><a name="trades">Relevant trades</a></h2>
1000 <table class="data" id="trades" rules=groups>
1003 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
1015 <th<% $cdspan %>>Collect
1016 <th<% $cdspan %>>Deliver
1018 <th colspan=2>Collect
1019 <th colspan=2>Deliver
1020 <th colspan=2>Profit
1025 <th colspan=3>Planned
1030 <th>Island <% $cdstall %>
1031 <th>Island <% $cdstall %>
1052 <tr id="trades_sort">
1053 % foreach my $col (@cols) {
1057 % foreach my $flowix (0..$#flows) {
1058 % my $flow= $flows[$flowix];
1059 % my $rowid= "id_row_$flow->{UidShort}";
1060 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
1061 <td><input type=hidden name=R<% $flow->{UidShort} %> value="">
1062 <input type=checkbox name=T<% $flow->{UidShort} %> value=""
1063 <% $flow->{Suppress} ? '' : 'checked' %> >
1065 % while ($ci < @cols) {
1066 % my $col= $cols[$ci];
1069 % Align => ($col->{Text} ? '' : 'align=right')
1071 % my $cn= $col->{Name};
1073 % if (!$col->{TotalSubflows}) {
1077 % $v += $_->{$cn} foreach @{ $flow->{Subflows} };
1079 % if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
1080 % $col->{Total} += $v
1081 % if defined $col->{Total} and not $flow->{Suppress};
1082 % $v='' if !$col->{Text} && !$v;
1083 % my $sortkey= $col->{SortColKey} ?
1084 % $flow->{$col->{SortColKey}} : $v;
1085 % $ts_sortkeys{$ci}{$rowid}= $sortkey;
1086 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
1087 %> <% $spec->{Align}
1088 %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
1089 % $ci += $spec->{Span};
1092 <tr id="trades_total">
1095 % foreach my $ci (3..$#cols) {
1096 % my $col= $cols[$ci];
1098 % if (defined $col->{Total}) {
1099 <% $col->{Total} |h %>
1104 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
1105 throw => 'trades_sort', tbrow => 'trades_total' &>
1106 ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
1109 <input type=submit name=update value="Update">