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=f8e0f89145b11888878067f383a74f5e9c1872fd;hp=407cc8c5e39b48bb28ac3a6466106e0c0c11afa6;hb=641e98def7ea904b48b0f7dc22d868b40f3cff1b;hpb=0a273ee819a0c5807ed112051da10c19dfa09f70

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 407cc8c..f8e0f89 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("
@@ -75,18 +95,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				unitmass,
+		commods.unitvolume				unitvolume,
+		buy.price - sell.price				unitprofit,
+		min(sell.qty,buy.qty)				max_qty,
+		min(sell.qty,buy.qty) * (buy.price-sell.price)	max_profit
 	FROM commods
 	JOIN buy  on commods.commodid = buy.commodid
 	JOIN sell on commods.commodid = sell.commodid
@@ -97,14 +120,21 @@ 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, max_profit DESC, commodname,
+		 org_price, dst_price DESC
      ";
 
 my $sth= $dbh->prepare($stmt);
 $sth->execute(@query_params);
+my @flows;
+
+my @columns= qw(org_name dst_name commodname
+		org_price org_qty dst_price dst_qty
+		max_qty max_profit);
 
 </%perl>
+
 % if ($qa->{'debug'}) {
 <pre>
 <% $stmt |h %>
@@ -112,8 +142,124 @@ $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 &>
+% }
+
+% if (!$specific || $confusing || @islandids<=1) {
+
+<p>
+% 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'}) {
+</%perl>
+<pre>
+<% $cplex |h %>
+</pre>
+<%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 "<pre>\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->{Opt_qty}= $qty;
+		$flow->{Opt_profit}= $flow->{'unitprofit'} * $qty;
+	}
+	print "</pre>\n" if $qa->{'debug'};
+	pipethrough_run_finish($output, 'glpsol');
+	die unless $found_section;
+};
+
+print join ' ', map { $_->{Optimal} } @flows;
+
+push @columns, qw(Opt_qty Opt_profit);
+
+</%perl>
+<% join ' ', @columns %>
+
+% } # ========== OPTIMISATION ==========
 
 <%init>
 use CommodsWeb;
+use Commods;
 </%init>