<%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. ========== TODO ========== 16:36 alpha,byrne,papaya,turtle,jorvik,luthien is my example 16:37 if tehre are 2 rows which take the same object and sell it for the same profit at two other islands, choose the shortest route as the preferred one 16:37 coconut buy 10 sell 16, at luthien or jorvik, in that example 16:38 Do you see what I mean? 16:38 I don't know how hard this is, but can you show only the suggested trades to start ith and have a button to show all? 16:39 Also, maybe colour to highlight the suggested trades? 16:40 columns should be sortable with the small arrows as before 16:51 YPP interfaces have price then qty. You have qty then price. This is confusing! 16:51 the max column ordering is OK 16:51 (alo profit and suggested are OK) 16:52 Err, you want qty on the left in those two but on the right in collect and deliver ? 16:53 Yes (price and capital are not the same thing) 16:53 OK 16:53 for max the order in which you want to think about it is 'I need to buy ten of them and that will cost me $total price) 16:54 s/)/'/ 16:46 Also trading plan not functional but I guess you know that :-) Also: - potential cost of losses - max volume/mass - use POST for update. Hrrm. ========== TODO ========== <%args> $dbh @islandids @archipelagoes $qa <%perl> my @flow_conds; my @query_params; 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 @cols; my $addcols= sub { my $base= shift @_; foreach my $name (@_) { push @cols, { Name => $name, %$base }; } }; if ($qa->{ShowStalls}) { $addcols->({ Text => 1 }, qw( org_name org_stallname dst_name dst_stallname )); } else { $addcols->({Text => 1 }, qw( org_name dst_name )); } $addcols->({ Text => 1 }, qw(commodname)); $addcols->({}, qw( org_qty org_price dst_qty dst_price Margin unitprofit MaxQty MaxCapital MaxProfit )); % if ($qa->{'debug'}) {

<% $stmt |h %>
<% join(' | ',@query_params) |h %>

% } <& dumptable:start, qa => $qa, sth => $sth &> % { % my $f; % while ($f= $sth->fetchrow_hashref()) { <%perl> $f->{Ix}= @flows; $f->{Var}= "f$f->{Ix}"; $f->{MaxQty}= $f->{'org_qty'} < $f->{'dst_qty'} ? $f->{'org_qty'} : $f->{'dst_qty'}; $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'}; $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'}; $f->{Margin}= sprintf "%3.1f%%", $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0; $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all' if !$qa->{ShowStalls}; my @uid= $f->{commodid}; foreach my $od (qw(org dst)) { push @uid, $f->{"${od}_id"}, $f->{"${od}_price"}; push @uid, $f->{"${od}_stallid"} if $qa->{ShowStalls}; } $f->{UidLong}= join '_', @uid; my $base= 31; my $cmpu= ''; map { my $uue= $_; my $first= $base; do { my $this= $uue % $base; print STDERR "uue=$uue this=$this "; $uue -= $this; $uue /= $base; $this += $first; $first= 0; $cmpu .= chr($this + ($this < 26 ? ord('a') : $this < 52 ? ord('A')-26 : ord('0')-52)); print STDERR " uue=$uue this=$this cmpu=$cmpu\n"; die "$cmpu $uue ?" if length $cmpu > 20; } while ($uue); $cmpu; } @uid; $f->{UidShort}= $cmpu; if ($qa->{'debug'}) { my @outuid; $_= $f->{UidShort}; my $mul; while (m/./) { my $v= m/^[a-z]/ ? ord($&)-ord('a') : m/^[A-Z]/ ? ord($&)-ord('A')+26 : m/^[0-9]/ ? ord($&)-ord('0')+52 : die "$_ ?"; if ($v >= $base) { push @outuid, 0; $v -= $base; $mul= 1; #print STDERR "(next)\n"; } die "$f->{UidShort} $_ ?" unless defined $mul; $outuid[$#outuid] += $v * $mul; #print STDERR "$f->{UidShort} $_ $& v=$v mul=$mul ord()=".ord($&). # "[vs.".ord('a').",".ord('A').",".ord('0')."]". # " outuid=@outuid\n"; $mul *= $base; s/^.//; } my $recons_long= join '_', @outuid; $f->{UidLong} eq $recons_long or die "$f->{UidLong} = $f->{UidShort} = $recons_long ?"; } if (defined $qa->{"R$f->{UidShort}"} && !defined $qa->{"T$f->{UidShort}"}) { $f->{Suppress}= 1; } push @flows, $f; <& dumptable:row, qa => $qa, sth => $sth, row => $f &> % } <& 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 { "$_->{unitprofit} $_->{Var}" } @flows)." Subject To "; my %avail_csts; foreach my $flow (@flows) { if ($flow->{Suppress}) { $cplex .= " $flow->{Var} = 0 "; next; } foreach my $od (qw(org dst)) { my $cstname= join '_', ( 'avail', $flow->{'commodid'}, $od, $flow->{"${od}_id"}, $flow->{"${od}_price"}, $flow->{"${od}_stallid"}, ); 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; }; $addcols->({}, qw( OptQty )); $addcols->({ Total => 0 }, qw( OptCapital OptProfit )); % } # ========== OPTIMISATION ========== % { % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; % my $cdstall= $qa->{ShowStalls} ? 'Stall' : ''; <% $qa->{ShowStalls} ? '' : '' %> % if ($optimise) { % }

>Collect >Deliver		Collect		Deliver		Profit		Max % if ($optimise) {			Suggested % }
	Island <% $cdstall %>	Island <% $cdstall %>	Commodity	Qty	Price	Qty	Price	Margin	Unit	Qty	Capital	Profit % if ($optimise) {	Qty	Capital	Profit % } % } % foreach my $flow (@flows) {
{UidShort} %> value=""> {UidShort} %> value="" <% $flow->{Suppress} ? '' : 'checked' %> > % foreach my $ci (0..$#cols) { % my $col= $cols[$ci]; % my $v= $flow->{$col->{Name}}; % $col->{Total} += $v if defined $col->{Total}; % $v='' if !$col->{Text} && !$v;	{Text} ? '' : 'align=right' %>><% $v \|h %> % } % }
	Total % foreach my $ci (2..$#cols) { % my $col= $cols[$ci];		% if (defined $col->{Total}) { <% $col->{Total} \|h %> % } % }

% if ($optimise) { # ========== TRADING PLAN ========== % % my $iquery= $dbh->prepare('SELECT islandname FROM islands % WHERE islandid = ?'); %

Voyage trading plan

% foreach my $i (0..$#islandids) { Buy or sell flow % } % } % }

% $iquery->execute($islandids[$i]); % my ($islandname) = $iquery->fetchrow_array(); % if (!$i) { Start at <% $islandname |h %> % } else { Sail to <% $islandname |h %> % } % foreach my $od (qw(dst org)) { % my $sign= $od eq 'dst' ? -1 : +1; % foreach my $f (sort { % $a->{'commodname'} cmp $b->{'commodname'} % or $sign * ($a->{"${od}_price"} <=> $b->{"${od}_price"}) % or $a->{"${od}_stallname"} cmp $b->{"${od}_stallname"} % } @flows) { % next if $f->{Suppress}; % next unless $f->{"${od}_id"} == $islandids[$i]; % next unless $f->{OptQty};

% % } # ========== TRADING PLAN ========== <%init> use CommodsWeb; use Commods;