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=45e0f8168703597babb20b9b2c7c5e1b8e75fa10;hp=1924503b9ce706b888c2450de30403ba19f96a8b;hb=dc81ef86f78ca6bab4d64cd8ef5719edca24d256;hpb=327dd80f71ae99180d1895166307cdb2add3618a diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 1924503..45e0f81 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -55,18 +55,38 @@ my $sd_condition= sub { } }; +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 $islandids[$src_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(" @@ -78,30 +98,43 @@ my $stmt= " 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, +".($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 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 + 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, profit DESC, commodname, +")." + ORDER BY org_name, dst_name, commodname, unitprofit DESC, org_price, dst_price DESC "; @@ -109,6 +142,18 @@ 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); +} +my $ntextcolumns= @columns+1; +push @columns, qw(commodname + org_qty org_price dst_qty dst_price + Margin unitprofit + MaxQty MaxCapital MaxProfit); + % if ($qa->{'debug'}) { @@ -118,18 +163,118 @@ my @flows; % } +<& dumptable:start, qa => $qa, 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 &> +% 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 ($qa->{"R$f->{UidShort}"} && !$qa->{"T$f->{UidShort}"}) { + $f->{Suppress}= 1; + } + + push @flows, $f; + + +<& dumptable:row, qa => $qa, sth => $sth, row => $f &> % } -<& dumpqueryresults:end &> +<& 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= " @@ -137,20 +282,29 @@ Maximize totalprofit: ".(join " + - ", map { "$_->{profit} $_->{Var}" } @flows)." + ", 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 '_', + my $cstname= join '_', ( 'avail', $flow->{'commodid'}, $od, $flow->{"${od}_id"}, - $flow->{"${od}_price"}; + $flow->{"${od}_price"}, + $flow->{"${od}_stallid"}, + ); + push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var}; $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty"}; } @@ -170,13 +324,120 @@ Bounds End "; -# glpsol --cpxlp /dev/stdin {'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; +}; + +push @columns, qw(OptQty 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..$#columns) { +% my $col= $columns[$ci]; +% my $v= $flow->{$col}; +% my $isnum= $ci >= $ntextcolumns; +% $v='' if $isnum && !$v; +><% $v |h %> +% } +% } +
+ + <%init> use CommodsWeb; +use Commods;