X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=0edcca539afa87cc072e9abc6ab4dd6c86fedfc5;hp=1c5a3e49db2b184ac019b4a8177cb8838df59040;hb=c2c600fb1b0bbe2627ac95e4dfe5e502780d986f;hpb=608bc9e07b5c8a961325fd1b8d5b92f65418b949 diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 1c5a3e4..0edcca5 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -1,26 +1,337 @@ +<%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 + 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 . + + 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. + + + <%args> $dbh @islandids @archipelagoes +$qa +<%perl> + +my @flow_conds; +my @query_params; -%# So, add code to do right thing here: +my $sd_condition= sub { + my ($bs, $ix) = @_; + my $islandid= $islandids[$ix]; + if (defined $islandid) { + return "${bs}.islandid = $islandid"; + } else { + push @query_params, $archipelagoes[$ix]; + return "${bs}_islands.archipelago = ?"; + } +}; +my %islandpair; +# $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ] + +my $specific= !grep { !defined $_ } @islandids; +my $confusing= 0; + +foreach my $src_i (0..$#islandids) { + my $src_isle= $islandids[$src_i]; + my $src_cond= $sd_condition->('sell',$src_i); + my @dst_conds; + foreach my $dst_i ($src_i..$#islandids) { + my $dst_isle= $islandids[$dst_i]; + my $dst_cond= $sd_condition->('buy',$dst_i); + if ($dst_i==$src_i and !defined $src_isle) { + # we always want arbitrage, but mentioning an arch + # once shouldn't produce intra-arch trades + $dst_cond= + "($dst_cond AND sell.islandid = buy.islandid)"; + } + push @dst_conds, $dst_cond; + + if ($specific && !$confusing && + # With a circular route, do not carry goods round the loop + !($src_i==0 && $dst_i==$#islandids && + $src_isle == $islandids[$dst_i])) { + if ($islandpair{$src_isle,$dst_isle}) { + $confusing= 1; + } else { + $islandpair{$src_isle,$dst_isle}= + [ $src_i, $dst_i ]; + } + } + } + push @flow_conds, "$src_cond AND ( + ".join(" + OR ",@dst_conds)." + )"; +} + +my $stmt= " + SELECT sell_islands.islandname org_name, + sell_islands.islandid org_id, + sell.price org_price, + buy_islands.islandname dst_name, + buy_islands.islandid dst_id, + buy.price dst_price, +".($qa->{ShowStalls} ? " + sell.stallid org_stallid, + sell_stalls.stallname org_stallname, + sell.qty org_qty, + buy.stallid dst_stallid, + buy_stalls.stallname dst_stallname, + buy.qty dst_qty, +" : " + sum(sell.qty) org_qty, + sum(buy.qty) dst_qty, +")." + commods.commodname commodname, + commods.commodid commodid, + commods.unitmass unitmass, + commods.unitvolume unitvolume, + buy.price - sell.price unitprofit + FROM commods + JOIN buy on commods.commodid = buy.commodid + JOIN sell on commods.commodid = sell.commodid + JOIN islands as sell_islands on sell.islandid = sell_islands.islandid + JOIN islands as buy_islands on buy.islandid = buy_islands.islandid +".($qa->{ShowStalls} ? " + JOIN stalls as sell_stalls on sell.stallid = sell_stalls.stallid + JOIN stalls as buy_stalls on buy.stallid = buy_stalls.stallid +" : "")." + WHERE ( + ".join(" + OR ", @flow_conds)." + ) + AND buy.price > sell.price +".($qa->{ShowStalls} ? "" : " + GROUP BY commods.commodid, org_id, org_price, dst_id, dst_price +")." + ORDER BY org_name, dst_name, commodname, unitprofit DESC, + org_price, dst_price DESC + "; + +my $sth= $dbh->prepare($stmt); +$sth->execute(@query_params); +my @flows; + +my @columns; +if ($qa->{ShowStalls}) { + push @columns, qw(org_name org_stallname dst_name dst_stallname); +} else { + push @columns, qw(org_name dst_name); +} +push @columns, qw(commodname + org_price org_qty dst_price dst_qty + unitprofit PctProfit + MaxQty MaxCapital MaxProfit); + + + +% if ($qa->{'debug'}) { 
-Route is as follows:
-
-% foreach my $i (0..$#islandids) {
-%   my $islandid= $islandids[$i];
-%   my $archipelago= $archipelagoes[$i];
-%   $islandid= '' unless defined $islandid;
-%   $archipelago= '' unless defined $archipelago;
-%
-  islandid=<% $islandid |h %>  archipelago=<% $archipelago |h %>
-%
+<% $stmt |h %>
+<% join(' | ',@query_params) |h %>
+
+% } + +% { +<& dumptable:start, qa => $qa, sth => $sth &> +% my $flow; +% while ($flow= $sth->fetchrow_hashref()) { +% $flow->{Ix}= @flows; +% $flow->{Var}= "f$flow->{Ix}"; +% push @flows, $flow; +<& dumptable:row, qa => $qa, sth => $sth, row => $flow &> +% } +<& dumptable:end, qa => $qa &> % } +% my $optimise= $specific && !$confusing && @islandids>1; +% if (!$optimise) { + +

+% if (@islandids<=1) { +Route is trivial. +% } +% if (!$specific) { +Route contains archipelago(es), not just specific islands. +% } +% if ($confusing) { +Route is complex - it visits the same island several times +and isn't a simple loop. +% } +Therefore, optimal trade pattern not calculated. + +% } else { # ========== OPTMISATION ========== +<%perl> + +my $cplex= " +Maximize + + totalprofit: + ".(join " + + ", map { "$_->{unit_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 +"; + +if ($qa->{'debug'}) { + +

+<% $cplex |h %>
+<%perl> +} + +{ + my $input= pipethrough_prep(); + print $input $cplex or die $!; + my $output= pipethrough_run_along($input, undef, 'glpsol', + qw(glpsol --cpxlp /dev/stdin -o /dev/stdout)); + print "
\n" if $qa->{'debug'};
+	my $found_section= 0;
+	while (<$output>) {
+		print encode_entities($_) if $qa->{'debug'};
+		if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
+			die if $found_section>0;
+			$found_section= 1;
+			next;
+		}
+		next unless $found_section==1;
+		next if m/^[- ]+$/;
+		if (!/\S/) {
+			$found_section= 2;
+			next;
+		}
+		my ($ix, $qty) =
+			m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
+		my $flow= $flows[$ix] or die;
+		$flow->{OptQty}= $qty;
+		$flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
+		$flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
+	}
+	print "
\n" if $qa->{'debug'}; + pipethrough_run_finish($output, 'glpsol'); + die unless $found_section; +}; + +print join ' ', map { $_->{Optimal} } @flows; + +push @columns, qw(OptQty OptCapital OptProfit); + + + +% } # ========== OPTIMISATION ========== + +% { +% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; +% my $cdstall= $qa->{ShowStalls} ? 'Stall' : ''; + + +>Collect +>Deliver + + +% foreach my $col (@columns) { +% $flow->{MaxQty}= $flow->{'org_qty'} < $flow->{'dst_qty'} +% ? $flow->{'org_qty'} : $flow->{'dst_qty'}; +% $flow->{MaxProfit}= $flow->{MaxQty} * $flow->{'unitprofit'}; +% $flow->{PctProfit}= sprintf "%3.1f%%", +% $flow->{'dst_price'} * 100.0 / $flow->{'org_price'} +% - 100.0; +% $flow->{MaxCapital}= $flow->{MaxQty} * $flow->{'org_price'}; +
+Collect +Deliver +Profit +Max +% if ($optimise) { +Suggested +% } + +
Island <% $cdstall %> +Island <% $cdstall %> +Commodity +Price +Qty +Price +Qty +Unit +Margin +Qty +Capital +Profit +% if ($optimise) { +Qty +Capital +Profit +% } +% } + +% foreach my $flow (@flows) { +
<% $flow->{$col} |h %> +% } +% } +
<%init> use CommodsWeb; +use Commods;