chiark / gitweb /
prepare cplex input file for glpsol
[ypp-sc-tools.main.git] / yarrg / web / routetrade
index e154f2c6c2c683d434ae182fd33b390051f6aa87..1924503b9ce706b888c2450de30403ba19f96a8b 100644 (file)
@@ -1,3 +1,38 @@
+<%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
@@ -40,18 +75,21 @@ foreach my $src_i (0..$#islandids) {
 }
 
 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
@@ -62,14 +100,17 @@ my $stmt= "
           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 %>
@@ -77,7 +118,64 @@ $sth->execute(@query_params);
 </pre>
 % }
 
-<& dumpqueryresults, sth =>$sth &>
+% {
+<& 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 &>
+% }
+
+<%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;