+<%doc>
+
+ This is part of the YARRG website. YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+ YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+ The YARRG website is covered by the GNU Affero GPL v3 or later, which
+ basically means that every installation of the website will let you
+ download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission. This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component is the core trade planner for a specific route.
+
+
+</%doc>
<%args>
$dbh
@islandids
@archipelagoes
+$qa
</%args>
<%perl>
}
my $stmt= "
- SELECT commods.commodname commodname,
- commods.commodid commodid,
- commods.unitmass mass,
- commods.unitvolume volume,
- sell_islands.islandid org_id,
- sell_islands.islandname org_name,
- sell.price org_price,
- sum(sell.qty) org_qty,
- buy_islands.islandid dst_id,
- buy_islands.islandname dst_name,
- buy.price dst_price,
- sum(buy.qty) dst_qty
+ SELECT sell_islands.islandname org_name,
+ sell_islands.islandid org_id,
+ sell.price org_price,
+ sum(sell.qty) org_qty,
+ buy_islands.islandname dst_name,
+ buy_islands.islandid dst_id,
+ buy.price dst_price,
+ sum(buy.qty) dst_qty,
+ commods.commodname commodname,
+ commods.commodid commodid,
+ commods.unitmass mass,
+ commods.unitvolume volume,
+ buy.price - sell.price unitprofit,
+ min(sell.qty,buy.qty) tqty,
+ min(sell.qty,buy.qty) * (buy.price-sell.price) profit
FROM commods
JOIN buy on commods.commodid = buy.commodid
JOIN sell on commods.commodid = sell.commodid
OR ", @flow_conds)."
)
AND buy.price > sell.price
- GROUP BY commodname, commods.commodid,
- org_id, org_price, dst_id, dst_price
+ GROUP BY commods.commodid, org_id, org_price, dst_id, dst_price
+ ORDER BY org_name, dst_name, profit DESC, commodname,
+ org_price, dst_price DESC
";
my $sth= $dbh->prepare($stmt);
$sth->execute(@query_params);
+my @flows;
</%perl>
+
+% if ($qa->{'debug'}) {
<pre>
<% $stmt |h %>
<% join(' | ',@query_params) |h %>
</pre>
+% }
+
+% {
+<& dumpqueryresults:start, sth => $sth &>
+% my $flow;
+% while ($flow= $sth->fetchrow_hashref()) {
+% $flow->{Ix}= @flows;
+% $flow->{Var}= "f$flow->{Ix}";
+% push @flows, $flow;
+<& dumpqueryresults:row, sth => $sth, row => $flow &>
+% }
+<& dumpqueryresults:end &>
+% }
-<& dumpqueryresults, sth =>$sth &>
+<%perl>
+
+my $cplex= "
+Maximize
+
+ totalprofit:
+ ".(join " +
+ ", map { "$_->{profit} $_->{Var}" } @flows)."
+
+Subject To
+";
+
+my %avail_csts;
+foreach my $flow (@flows) {
+ foreach my $od (qw(org dst)) {
+ my $cstname= join '_',
+ 'avail',
+ $flow->{'commodid'},
+ $od,
+ $flow->{"${od}_id"},
+ $flow->{"${od}_price"};
+ push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
+ $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty"};
+ }
+}
+foreach my $cstname (sort keys %avail_csts) {
+ my $c= $avail_csts{$cstname};
+ $cplex .= "
+ ". sprintf("%-30s","$cstname:")." ".
+ join("+", @{ $c->{Flows} }).
+ " <= ".$c->{Qty}."\n";
+}
+
+$cplex.= "
+Bounds
+ ".(join "
+ ", map { "$_->{Var} >= 0" } @flows)."
+
+End
+";
+# glpsol --cpxlp /dev/stdin <t.cplex -o /dev/stdout
+
+</%perl>
+<pre>
+<% $cplex |h %>
+</pre>
<%init>
use CommodsWeb;