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.
46 da_pageload= Date.now();
49 % if (defined $max_mass || defined $max_volume) {
50 <strong>WARNING - VESSEL CAPACITY LIMIT NOT YET IMPLEMENTED</strong>
56 my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
64 my $sd_condition= sub {
66 my $islandid= $islandids[$ix];
67 if (defined $islandid) {
68 return "${bs}.islandid = $islandid";
70 push @query_params, $archipelagoes[$ix];
71 return "${bs}_islands.archipelago = ?";
76 # $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
78 my $specific= !grep { !defined $_ } @islandids;
81 foreach my $src_i (0..$#islandids) {
82 my $src_isle= $islandids[$src_i];
83 my $src_cond= $sd_condition->('sell',$src_i);
85 foreach my $dst_i ($src_i..$#islandids) {
86 my $dst_isle= $islandids[$dst_i];
87 my $dst_cond= $sd_condition->('buy',$dst_i);
88 if ($dst_i==$src_i and !defined $src_isle) {
89 # we always want arbitrage, but mentioning an arch
90 # once shouldn't produce intra-arch trades
92 "($dst_cond AND sell.islandid = buy.islandid)";
94 push @dst_conds, $dst_cond;
96 if ($specific && !$confusing &&
97 # With a circular route, do not carry goods round the loop
98 !(($src_i==0 || $src_i==$#islandids) &&
99 $dst_i==$#islandids &&
100 $src_isle == $islandids[$dst_i])) {
101 if ($islandpair{$src_isle,$dst_isle}) {
103 print "confusing $src_i $src_isle $dst_i $dst_isle\n";
105 $islandpair{$src_isle,$dst_isle}=
110 push @flow_conds, "$src_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,
149 buy.price - sell.price unitprofit
151 JOIN sell ON commods.commodid = sell.commodid
152 JOIN buy ON commods.commodid = buy.commodid
153 JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
154 JOIN islands AS buy_islands ON buy.islandid = buy_islands.islandid
155 JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
156 JOIN uploads AS buy_uploads ON buy.islandid = buy_uploads.islandid
157 JOIN stalls AS sell_stalls ON sell.stallid = sell_stalls.stallid
158 JOIN stalls AS buy_stalls ON buy.stallid = buy_stalls.stallid
159 JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
164 AND buy.price > sell.price
165 ORDER BY org_name, dst_name, commodname, unitprofit DESC,
166 org_price, dst_price DESC,
167 org_stallname, dst_stallname
170 my $sth= $dbh->prepare($stmt);
171 $sth->execute(@query_params);
174 my $distquery= $dbh->prepare("
175 SELECT dist FROM dists WHERE aiid = ? AND biid = ?
179 my $d= $dists{$from}{$to};
180 return $d if defined $d;
181 $distquery->execute($from,$to);
182 $d = $distquery->fetchrow_array();
183 defined $d or die "$from $to ?";
184 $dists{$from}{$to}= $d;
188 my @cols= ({ NoSort => 1 });
192 foreach my $name (@_) {
193 my $col= { Name => $name, %$base };
194 $col->{Numeric}=1 if !$col->{Text};
199 if ($qa->{ShowStalls}) {
200 $addcols->({ Text => 1 }, qw(
201 org_name org_stallname
202 dst_name dst_stallname
205 $addcols->({Text => 1 }, qw(
209 $addcols->({ Text => 1 }, qw(commodname));
210 $addcols->({ DoReverse => 1 },
211 qw( org_price org_qty_agg dst_price dst_qty_agg
213 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
216 $addcols->({ DoReverse => 1 },
217 qw( unitprofit MaxQty MaxCapital MaxProfit dist
219 foreach my $v (qw(MaxMass MaxVolume)) {
221 DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
226 % if ($qa->{'debug'}) {
229 <% join(' | ',@query_params) |h %>
233 <& dumptable:start, qa => $qa, sth => $sth &>
236 % while ($got= $sth->fetchrow_hashref()) {
239 my $f= $flows[$#flows];
242 grep { $f->{$_} ne $got->{$_} }
243 qw(org_id org_price dst_id dst_price commodid)
245 # Make a new flow rather than adding to the existing one
248 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 &>
273 print 'No profitable trading opportunities were found.';
277 foreach my $f (@flows) {
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'};
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;
290 $f->{MarginSortKey}= sprintf "%d",
291 $f->{'dst_price'} * 10000 / $f->{'org_price'};
292 $f->{Margin}= sprintf "%3.1f%%",
293 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
295 $f->{ExpectedUnitProfit}=
296 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
299 $dists{'org_id'}{'dst_id'}= $f->{'dist'};
301 my @uid= $f->{commodid};
302 foreach my $od (qw(org dst)) {
307 $f->{"${od}_stallid"}
308 if $qa->{ShowStalls};
310 $f->{UidLong}= join '_', @uid;
318 my $this= $uue % $base;
319 print STDERR "uue=$uue this=$this ";
324 $cmpu .= chr($this + ($this < 26 ? ord('a') :
325 $this < 52 ? ord('A')-26
327 print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
328 die "$cmpu $uue ?" if length $cmpu > 20;
332 $f->{UidShort}= $cmpu;
334 if ($qa->{'debug'}) {
339 my $v= m/^[a-z]/ ? ord($&)-ord('a') :
340 m/^[A-Z]/ ? ord($&)-ord('A')+26 :
341 m/^[0-9]/ ? ord($&)-ord('0')+52 :
347 #print STDERR "(next)\n";
349 die "$f->{UidShort} $_ ?" unless defined $mul;
350 $outuid[$#outuid] += $v * $mul;
352 #print STDERR "$f->{UidShort} $_ $& v=$v mul=$mul ord()=".ord($&).
353 # "[vs.".ord('a').",".ord('A').",".ord('0')."]".
354 # " outuid=@outuid\n";
359 my $recons_long= join '_', @outuid;
360 $f->{UidLong} eq $recons_long or
361 die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
364 if (defined $qa->{"R$f->{UidShort}"} &&
365 !defined $qa->{"T$f->{UidShort}"}) {
372 % my $optimise= $specific && !$confusing && @islandids>1;
376 % if (@islandids<=1) {
377 Route contains only one location.
380 Route contains archipelago(es), not just specific islands.
383 Route is complex - it visits the same island several times
384 and isn't a simple loop.
386 Therefore, optimal voyage trade plan not calculated.
388 % } else { # ========== OPTMISATION ==========
397 sprintf "%+.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
404 foreach my $flow (@flows) {
405 if ($flow->{Suppress}) {
411 foreach my $od (qw(org dst)) {
412 my $cstname= join '_', (
417 $flow->{"${od}_price"},
418 $flow->{"${od}_stallid"},
421 push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
422 $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
425 foreach my $cstname (sort keys %avail_csts) {
426 my $c= $avail_csts{$cstname};
428 ". sprintf("%-30s","$cstname:")." ".
429 join("+", @{ $c->{Flows} }).
430 " <= ".$c->{Qty}."\n";
436 ", map { "$_->{Var} >= 0" } @flows)."
441 if ($qa->{'debug'}) {
450 my $input= pipethrough_prep();
451 print $input $cplex or die $!;
452 my $output= pipethrough_run_along($input, undef, 'glpsol',
453 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
454 print "<pre>\n" if $qa->{'debug'};
455 my $found_section= 0;
459 print encode_entities($_) if $qa->{'debug'};
460 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
461 die if $found_section>0;
465 next unless $found_section==1;
472 m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
473 my $flow= $flows[$ix] or die;
474 $flow->{OptQty}= $qty;
475 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
476 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
478 print "</pre>\n" if $qa->{'debug'};
479 my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
480 pipethrough_run_finish($output,$prerr);
481 die $prerr unless $found_section;
484 $addcols->({ DoReverse => 1, Special => sub {
485 my ($flow,$col,$v,$spec) = @_;
486 if ($flow->{ExpectedUnitProfit} < 0) {
488 $spec->{String}= '(Small margin)';
489 $spec->{Align}= 'align=center';
494 $addcols->({ Total => 0, DoReverse => 1 }, qw(
500 % } # ========== OPTIMISATION ==========
504 % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
505 % my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
506 <table id="trades" rules=groups>
509 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
521 <th<% $cdspan %>>Collect
522 <th<% $cdspan %>>Deliver
524 <th colspan=2>Collect
525 <th colspan=2>Deliver
531 <th colspan=3>Planned
536 <th>Island <% $cdstall %>
537 <th>Island <% $cdstall %>
558 <tr id="trades_sort">
559 % foreach my $col (@cols) {
563 % foreach my $flowix (0..$#flows) {
564 % my $flow= $flows[$flowix];
565 % my $rowid= "id_row_$flow->{UidShort}";
566 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
567 <td><input type=hidden name=R<% $flow->{UidShort} %> value="">
568 <input type=checkbox name=T<% $flow->{UidShort} %> value=""
569 <% $flow->{Suppress} ? '' : 'checked' %> >
571 % while ($ci < @cols) {
572 % my $col= $cols[$ci];
575 % Align => ($col->{Text} ? '' : 'align=right')
577 % my $v= $flow->{$col->{Name}};
578 % if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
579 % $col->{Total} += $v
580 % if defined $col->{Total} and not $flow->{Suppress};
581 % $v='' if !$col->{Text} && !$v;
582 % my $sortkey= $col->{SortColKey} ?
583 % $flow->{$col->{SortColKey}} : $v;
584 % $ts_sortkeys{$ci}{$rowid}= $sortkey;
585 <td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
587 %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
588 % $ci += $spec->{Span};
591 <tr id="trades_total">
594 % foreach my $ci (3..$#cols) {
595 % my $col= $cols[$ci];
597 % if (defined $col->{Total}) {
598 <% $col->{Total} |h %>
603 <&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
604 throw => 'trades_sort', tbrow => 'trades_total' &>
605 ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
608 <input type=submit name=update value="Update">
610 % if ($optimise) { # ========== TRADING PLAN ==========
612 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
613 % WHERE islandid = ?');
615 % my $total_total= 0;
618 <h1>Voyage trading plan</h1>
620 % foreach my $i (0..$#islandids) {
623 % $iquery->execute($islandids[$i]);
624 % my ($islandname) = $iquery->fetchrow_array();
626 <strong>Start at <% $islandname |h %></strong>
628 % my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
629 % $total_dist += $this_dist;
630 <strong>Sail to <% $islandname |h %></strong>
631 - <% $this_dist |h %> leagues </td>
636 foreach my $od (qw(org dst)) {
637 foreach my $f (@flows) {
638 next if $f->{Suppress};
639 next unless $f->{"${od}_id"} == $islandids[$i];
640 next unless $f->{OptQty};
641 my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
642 my $loop= $islandids[0] == $islandids[-1] &&
643 ($i==0 || $i==$#islandids);
644 next if $loop and ($arbitrage ? $i :
645 !!$i == !!($od eq 'org'));
646 my $price= $f->{"${od}_price"};
647 my $stallname= $f->{"${od}_stallname"};
648 my $todo= \$flowlists{$od}{
650 (sprintf "%07d", ($od eq 'dst' ?
651 9999999-$price : $price)),
659 $$todo->{'commodname'}= $f->{'commodname'};
660 $$todo->{'stallname'}= $stallname;
661 $$todo->{Price}= $price;
662 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
663 $$todo->{Qty} += $f->{OptQty};
664 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
665 $$todo->{Stalls}= $f->{"${od}Stalls"};
666 $$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
672 my $show_flows= sub {
673 my ($od,$arbitrage,$collectdeliver) = @_;
676 % my $todo= $flowlists{$od};
677 % return unless $todo;
678 % foreach my $tkey (sort keys %$todo) {
679 % my $t= $todo->{$tkey};
680 % next if $t->{"${od}Arbitrage"} != $arbitrage;
681 % if (!$age_reported++) {
682 % my $age= $now - $t->{Timestamp};
683 % my $cellid= "da_${i}";
684 % $da_ages{$cellid}= $age;
686 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
687 % } elsif (!defined $total) {
691 % $total += $t->{Total};
692 % my $span= 0 + keys %{ $t->{Stalls} };
693 % my $td= "td rowspan=$span";
694 <tr class="datarow<% $dline %>">
695 <<% $td %>><% $collectdeliver %>
696 <<% $td %>><% $t->{'commodname'} |h %>
698 % my @stalls= sort keys %{ $t->{Stalls} };
700 % my $name= $stalls[$_[0]];
705 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
706 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
707 <<% $td %> align=right><% $t->{Total} |h %> total
709 % foreach my $stallix (1..$#stalls) {
710 <tr class="datarow<% $dline %>">
711 % $pstall->($stallix);
717 % my $show_total= sub {
718 % my ($totaldesc, $sign)= @_;
719 % if (defined $total) {
722 <td colspan=2 align=right><% $totaldesc %>
723 <td align=right><% $total |h %> total
724 % $total_total += $sign * $total;
731 $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
732 $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
733 $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
734 $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
739 <td colspan=2>Total distance: <% $total_dist %> leagues.
740 <td colspan=3 align=right>Overall net cash flow
741 <td align=right><strong><%
742 $total_total < 0 ? -$total_total." loss" : $total_total." gain"
745 <& query_age:dataages, id2age => \%da_ages &>
747 % } # ========== TRADING PLAN ==========