X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=03ef3e1e8dc4ab99bfc8b29cfc8b69750268845c;hp=4d8cd9f9ae8b77881616d907aa130b2f90ca19b2;hb=27c23298aea5653ffba93b5a9c41bfa321b478d7;hpb=fee014e3b912b5bea3de99052b6e311d188d8620

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 4d8cd9f..03ef3e1 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -38,18 +38,27 @@ $dbh
 @islandids
 @archipelagoes
 $qa
+$routeparams
+$reset_suppressions
+$quri
 </%args>
-<&| script &>
-  da_pageload= Date.now();
-</&script>
+<& query_age:pageload &>
 
 <%perl>
 
+my $loss_per_league= defined $routeparams->{LossPerLeaguePct}
+	? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7;
+my $loss_per_delay_slot= 1e-8;
+my $max_gems= 24;
+
+my $minprofit= $routeparams->{MinProfit} || 0;
+
 my $now= time;
-my $loss_per_league= 1e-7;
 
 my @flow_conds;
 my @query_params;
+my %dists;
+my $expected_total_profit;
 
 my $sd_condition= sub {
 	my ($bs, $ix) = @_;
@@ -62,40 +71,43 @@ 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 %ipair2subflowinfs;
+# $ipair2subflowinfs{$orgi,$dsti}= [ [$orgix,$distix], ... ]
+
+my @subflows;
+# $subflows[0]{Flow} = { ... }
+# $subflows[0]{Org} = $orgix
+# $subflows[0]{Dst} = $dstix
+
+foreach my $org_i (0..$#islandids) {
+	my $org_isle= $islandids[$org_i];
+	my $org_cond= $sd_condition->('sell',$org_i);
 	my @dst_conds;
-	foreach my $dst_i ($src_i..$#islandids) {
+	foreach my $dst_i ($org_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) {
+		# Don't ever consider sailing things round the houses:
+		next if defined $dst_isle and
+			grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
+		next if defined $org_isle and
+			grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
+		my $dst_cond;
+		if ($dst_i==$org_i and !defined $org_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)";
+			$dst_cond= "sell.islandid = buy.islandid";
+		} else {
+			$dst_cond= $sd_condition->('buy',$dst_i);
 		}
 		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 ];
-			}
+		if ($specific) {
+			push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
+				[ $org_i, $dst_i ];
 		}
 	}
-	push @flow_conds, "$src_cond AND (
+	push @flow_conds, "$org_cond AND (
 			".join("
 		     OR ",@dst_conds)."
 		)";
@@ -133,6 +145,10 @@ my $stmt= "
 		commods.commodid				commodid,
 		commods.unitmass				unitmass,
 		commods.unitvolume				unitvolume,
+		commods.ordval					ordval,
+		commods.posinclass				posinclass,
+		commods.commodclassid				commodclassid,
+		commods.flags					flags,
 		dist						dist,
 		buy.price - sell.price				unitprofit
 	FROM commods
@@ -159,6 +175,20 @@ my $sth= $dbh->prepare($stmt);
 $sth->execute(@query_params);
 my @flows;
 
+my $distquery= $dbh->prepare("
+		SELECT dist FROM dists WHERE aiid = ? AND biid = ?
+		");
+my $distance= sub {
+	my ($from,$to)= @_;
+	my $d= $dists{$from}{$to};
+	return $d if defined $d;
+	$distquery->execute($from,$to);
+	$d = $distquery->fetchrow_array();
+	defined $d or die "$from $to ?";
+	$dists{$from}{$to}= $d;
+	return $d;
+};
+
 my @cols= ({ NoSort => 1 });
 
 my $addcols= sub {
@@ -188,9 +218,12 @@ $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
 	qw(	Margin
 	));
 $addcols->({ DoReverse => 1 },
-	qw(	unitprofit MaxQty
-		MaxCapital MaxProfit
+	qw(	unitprofit MaxQty MaxCapital MaxProfit dist
 	));
+foreach my $v (qw(MaxMass MaxVolume)) {
+   $addcols->({
+	DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
+}
 
 </%perl>
 
@@ -217,7 +250,6 @@ $addcols->({ DoReverse => 1 },
 
 		$f= {
 			Ix => scalar(@flows),
-			Var => "f".@flows,
 			%$got
 		};
 		$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
@@ -238,7 +270,32 @@ $addcols->({ DoReverse => 1 },
 <& dumptable:end, qa => $qa &>
 % }
 
+% if (@islandids==1) {
+% 	if (defined $islandids[0]) {
+Searched for arbitrage trades only.
+%	} else {
+Searched for arbitrage trades only, in <% $archipelagoes[0] |h %>
+<a href="docs#arbitrage">[?]</a>.
+%	}
+% }
+
 <%perl>
+
+if (!@flows) {
+	print 'No profitable trading opportunities were found.';
+	return;
+}
+
+my @sail_total;
+my %opportunity_value;
+
+my $oppo_key= sub {
+	my ($f) = @_;
+	return join '_', map { $f->{$_} } qw(org_id dst_id commodid);
+};
+
+my $any_previous_suppression= 0;
+
 foreach my $f (@flows) {
 
 	$f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
@@ -246,6 +303,12 @@ foreach my $f (@flows) {
 	$f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
 	$f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 
+	$f->{MaxMassSortKey}= $f->{MaxQty} * $f->{'unitmass'};
+	$f->{MaxVolumeSortKey}= $f->{MaxQty} * $f->{'unitvolume'};
+	foreach my $v (qw(Mass Volume)) {
+		$f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6;
+	}
+
 	$f->{MarginSortKey}= sprintf "%d",
 		$f->{'dst_price'} * 10000 / $f->{'org_price'};
 	$f->{Margin}= sprintf "%3.1f%%",
@@ -255,6 +318,10 @@ foreach my $f (@flows) {
 		$f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 		- $f->{'org_price'};
 
+	$dists{'org_id'}{'dst_id'}= $f->{'dist'};
+
+	$opportunity_value{ $oppo_key->($f) } += $f->{MaxProfit};
+
 	my @uid= $f->{commodid};
 	foreach my $od (qw(org dst)) {
 		push @uid,
@@ -273,7 +340,7 @@ foreach my $f (@flows) {
 		my $first= $base;
 		do {
 			my $this= $uue % $base;
-print STDERR "uue=$uue this=$this ";
+#print STDERR "uue=$uue this=$this ";
 			$uue -= $this;
 			$uue /= $base;
 			$this += $first;
@@ -281,8 +348,8 @@ print STDERR "uue=$uue this=$this ";
 			$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;
+#print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
+			die "$cmpu $uue ?" if length $cmpu > 20;
 		} while ($uue);
 		$cmpu;
 	} @uid;
@@ -317,30 +384,60 @@ die "$cmpu $uue ?" if length $cmpu > 20;
 		$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;
-	}
+foreach my $f (@flows) {
 
+	if ($reset_suppressions || !defined $qa->{"R$f->{UidShort}"}) {
+		if ($opportunity_value{ $oppo_key->($f) } < $minprofit) {
+			$f->{Suppress}= 1;
+		}
+	} else {
+		if (!defined $qa->{"T$f->{UidShort}"}) {
+			$any_previous_suppression= 1;
+			$f->{Suppress}= 1;
+		}
+	}
+	if (!$f->{Suppress}) {
+		my $sfis= $ipair2subflowinfs{$f->{'org_id'},$f->{'dst_id'}};
+		foreach my $sfi (@$sfis) {
+			my $subflow= {
+				Flow => $f,
+				Org => $sfi->[0],
+				Dst => $sfi->[1],
+				Var => sprintf "f%ss%s_c%d_p%d_%d_p%d_%d",
+					$f->{Ix}, $sfi->[0],
+					$f->{'commodid'},
+					$sfi->[0], $f->{'org_price'},
+					$sfi->[1], $f->{'dst_price'}
+			};
+			push @{ $f->{Subflows} }, $subflow;
+			push @subflows, $subflow;
+		}
+	}
 }
 </%perl>
 
-% my $optimise= $specific && !$confusing && @islandids>1;
-% if (!$optimise) {
+% my $optimise= 1;
+% my $opt_how;
 
-<p>
-% if (@islandids<=1) {
-Route is trivial.
-% }
 % if (!$specific) {
+%	$optimise= 0;
 Route contains archipelago(es), not just specific islands.
+% } elsif (!@subflows) {
+%	$optimise= 0;
+%	if ($any_previous_suppression) {
+All available trades deselected.
+%	} else {
+No available trades meet the specified minimum trade value, so
+all available trades deselected.
+%	}
 % }
-% if ($confusing) {
-Route is complex - it visits the same island several times
-and isn't a simple loop.
-% }
-Therefore, optimal trade pattern not calculated.
+
+% if (!$optimise) {
+
+<p>
+Therefore, optimal voyage trade plan not calculated.
 
 % } else { # ========== OPTMISATION ==========
 <%perl>
@@ -349,48 +446,129 @@ my $cplex= "
 Maximize
 
   totalprofit:
-                  ".(join " +
-                  ", map {
-			sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
-			} @flows)."
+";
+
+my %stall_poe_limits;
+
+foreach my $sf (@subflows) {
+	my $eup= $sf->{Flow}{ExpectedUnitProfit};
+	$eup *= (1.0-$loss_per_delay_slot) ** $sf->{Org};
+	$cplex .= sprintf "
+		%+.20f %s", $eup, $sf->{Var};
+	if ($qa->{ShowStalls}>=2) {
+		my $stall= $sf->{Flow}{'dst_stallid'};
+		push @{ $stall_poe_limits{$stall} }, $sf;
+	}
+}
+$cplex .= "
 
 Subject To
 ";
 
-my %avail_csts;
+my %avail_lims;
 foreach my $flow (@flows) {
-	if ($flow->{Suppress}) {
-		$cplex .= "
-   $flow->{Var} = 0
-";
-		next;
-	}
+	next if $flow->{Suppress};
 	foreach my $od (qw(org dst)) {
-		my $cstname= join '_', (
-			'avail',
-			$flow->{'commodid'},
+		my $limname= join '_', (
 			$od,
-			$flow->{"${od}_id"},
+			'i'.$flow->{"${od}_id"},
+			'c'.$flow->{'commodid'},
 			$flow->{"${od}_price"},
 			$flow->{"${od}_stallid"},
 		);
-			
-		push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
-		$avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
+
+		push @{ $avail_lims{$limname}{SubflowVars} },
+			map { $_->{Var} } @{ $flow->{Subflows} };
+		$avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
+	}
+}
+foreach my $limname (sort keys %avail_lims) {
+	my $c= $avail_lims{$limname};
+	$cplex .=
+		sprintf("    %-30s","$limname:")." ".
+			join("+", @{ $c->{SubflowVars} }).
+			" <= ".$c->{Qty}."\n";
+}
+
+foreach my $ci (0..($#islandids-1)) {
+	my @rel_subflows;
+
+	foreach my $f (@flows) {
+		next if $f->{Suppress};
+		my @relsubflow= grep {
+			$_->{Org} <= $ci &&
+			$_->{Dst} > $ci;
+		} @{ $f->{Subflows} };
+		next unless @relsubflow;
+		die unless @relsubflow == 1;
+		push @rel_subflows, @relsubflow;
+#print " RELEVANT $ci $relsubflow[0]->{Var} ";
+	}
+#print " RELEVANT $ci COUNT ".scalar(@rel_subflows)."  ";
+	if (!@rel_subflows) {
+		foreach my $mv (qw(mass volume capital)) {
+			$sail_total[$ci]{$mv}= 0;
+		}
+		next;
+	}
+
+	my $applylimit= sub {
+		my ($mv, $f2val) = @_;
+		my $max= $routeparams->{"Max".ucfirst $mv};
+		$max= 1e9 unless defined $max;
+#print " DEFINED MAX $mv $max ";
+		$cplex .= "
+   ". sprintf("%-10s","${mv}_$ci:")." ".
+		join(" + ", map {
+#print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
+			$f2val->($_->{Flow}) .' '. $_->{Var};
+		} @rel_subflows).
+		" <= $max";
+	};
+
+	$applylimit->('mass',    sub { $_[0]{'unitmass'}  *1e-3 });
+	$applylimit->('volume',  sub { $_[0]{'unitvolume'}*1e-3 });
+	$applylimit->('capital', sub { $_[0]{'org_price'}       });
+
+	my @gem_subflows= grep { $_->{Flow}{flags} =~ m/g/ } @rel_subflows;
+	if (@gem_subflows) {
+		$cplex .= "
+   ". sprintf("%-10s","gems_$ci:")." ".
+		join(" + ", map { $_->{Var} } @gem_subflows). " <= $max_gems";
 	}
+
+	$cplex.= "\n";
 }
-foreach my $cstname (sort keys %avail_csts) {
-	my $c= $avail_csts{$cstname};
-	$cplex .= "
-   ".	sprintf("%-30s","$cstname:")." ".
-	join("+", @{ $c->{Flows} }).
-	" <= ".$c->{Qty}."\n";
+
+if ($qa->{ShowStalls}>=2) {
+	my $stallpoe= $dbh->prepare(<<END);
+SELECT max(qty*price) FROM buy WHERE stallid=?
+END
+	foreach my $stallid (sort { $a <=> $b } keys %stall_poe_limits) {
+		$stallpoe->execute($stallid);
+		my ($lim)= $stallpoe->fetchrow_array();
+		$stallpoe->finish();
+		$cplex.= "
+    ". sprintf("%-15s","poe_$stallid:")." ".
+		join(" + ", map {
+			sprintf "%d %s", $_->{Flow}{'dst_price'}, $_->{Var};
+		} @{ $stall_poe_limits{$stallid} }).
+		" <= $lim";
+	}
+	$cplex.= "\n";
 }
 
 $cplex.= "
 Bounds
         ".(join "
-        ", map { "$_->{Var} >= 0" } @flows)."
+        ", map { "$_->{Var} >= 0" } @subflows)."
+
+";
+
+$cplex.= "
+Integer
+	".(join "
+	", map { $_->{Var} } @subflows)."
 
 End
 ";
@@ -403,45 +581,114 @@ if ($qa->{'debug'}) {
 <%perl>
 }
 
-{
+my $try_solve= sub {
+	my ($how, @opts) = @_;
 	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'};
+		qw(glpsol --tmlim 5 --memlim 20), @opts,
+		qw( --cpxlp /dev/stdin -o /dev/stdout));
+	if ($qa->{'debug'}) {
+		print "<h3>@opts</h3>\n<pre>\n";
+	}
+	$expected_total_profit= undef;
+	$_->{OptQty}= undef foreach @subflows;
 	my $found_section= 0;
 	my $glpsol_out= '';
+	my $continuation='';
+	my $timelimit= 0;
+	my $somemip= 0;
 	while (<$output>) {
 		$glpsol_out.= $_;
 		print encode_entities($_) if $qa->{'debug'};
-		if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
-			die if $found_section>0;
+		if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
+			die "$_ $found_section ?" if $found_section>0;
 			$found_section= 1;
 			next;
 		}
-		next unless $found_section==1;
-		next if m/^[- ]+$/;
-		if (!/\S/) {
-			$found_section= 2;
+		if ((m/^Integer optimization begins/ .. 0) &&
+		    m/^\+ \s* \d+\: \s* mip \s* = \s* \d/) {
+			$somemip= 1;
 			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'};
+		if (m/^TIME LIMIT EXCEEDED/) {
+			$timelimit= 1;
+		}
+		if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
+			$expected_total_profit= $1;
+		}
+		next unless $found_section==1;
+		if (!length $continuation) {
+			next if !$continuation &&  m/^[- ]+$/;
+			if (!/\S/) {
+				$found_section= 0;
+				next;
+			}
+			if (m/^ \s* \d+ \s+ \w+ $/x) {
+				$continuation= $&;
+				next;
+			}
+		}
+		$_= $continuation.$_;
+		$continuation= '';
+		my ($varname, $qty) = m/^
+			\s* \d+ \s+
+			(\w+) \s+ (?: [A-Z*]+ \s+ )?
+			([-+0-9]+)(?: [.e][-+e0-9.]* )? \s
+			/x or die "$cplex \n==\n $glpsol_out $_ ?";
+		if ($varname =~ m/^f(\d+)s(\d+)_/) {
+			my ($ix,$orgix) = ($1,$2);
+			my $flow= $flows[$ix] or die;
+			my @relsubflow= grep { $_->{Org} == $orgix }
+				@{ $flow->{Subflows} };
+			die "$ix $orgix @relsubflow" unless @relsubflow == 1;
+			my $sf= $relsubflow[0];
+			$sf->{OptQty}= $qty;
+			$sf->{OptProfit}= $qty * $flow->{'unitprofit'};
+			$sf->{OptCapital}= $qty * $flow->{'org_price'};
+		} elsif ($varname =~ m/^(mass|volume|capital)_(\d+)$/) {
+			my ($mv,$ix) = ($1,$2);
+			$sail_total[$ix]{$mv}= $qty;
+		}
 	}
 	print "</pre>\n" if $qa->{'debug'};
 	my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 	pipethrough_run_finish($output,$prerr);
-	die $prerr unless $found_section;
+	map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
+	defined $expected_total_profit or die "$prerr ?";
+	return 0 unless $somemip || !$timelimit;
+	$opt_how= $how;
+	return 1;
 };
 
-$addcols->({ DoReverse => 1 }, qw(
+unless ($try_solve->('Optimisation successful',
+		     qw( --intopt --cuts --bfs )) or
+	$try_solve->('<strong>Complex problem, downgraded</strong>'.
+		     ' to rounded-down LP.',
+		     qw( --nomip ))) {
+</%perl>
+<h2>Optimisation failed</h2>
+The linear/mixed-integer optimisation failed.
+Please report this problem.
+
+<pre>
+<% $cplex |h %>
+</pre>
+<%perl>
+	return;
+}
+
+$addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
+	my ($flow,$col,$v,$spec) = @_;
+	if ($flow->{ExpectedUnitProfit} < 0) {
+		$spec->{Span}= 3;
+		$spec->{String}= '(Small margin)';
+		$spec->{Align}= 'align=center';
+	}
+} }, qw(
 		OptQty
 	));
-$addcols->({ Total => 0, DoReverse => 1 }, qw(
+$addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
 		OptCapital OptProfit
 	));
 
@@ -449,11 +696,368 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 
 % } # ========== OPTIMISATION ==========
 
-% my %ts_sortkeys;
-% {
+% if (!printable($m)) {
+<h2>Contents</h2>
+<ul>
+% if ($optimise) {
+ <li><a href="#summary">Summary</a>
+ <li><a href="#plan">Voyage trading plan</a>
+  <ul>
+   <li>Printable:
+         <input type=submit name=printable_pdf value="PDF">
+         <input type=submit name=printable_html value="HTML">
+         <input type=submit name=printable_ps value="PostScript">
+         <input type=submit name=printable_pdf2 value="PDF 2-up">
+         <input type=submit name=printable_ps2 value="PostScript 2-up">
+  </ul>
+% }
+ <li><a href="#dataage">Relevant data ages</a>
+ <li><a href="#trades">Relevant trades</a>
+</ul>
+% } else {
+%	my @tl= gmtime $now or die $!;
+<p>
+Generated by YARRG at <strong><%
+	sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC",
+		$tl[5]+1900, @tl[4,3,2,1,0]
+			|h %></strong>.
+% }
+
+% if ($optimise) { # ========== TRADING PLAN ==========
+<%perl>
+my $iquery= $dbh->prepare('SELECT islandname FROM islands
+				WHERE islandid = ?');
+my %da_ages;
+my $total_total= 0;
+my $total_dist= 0;
+my @oldest= (-1, 'nowhere');
+my $plan_html= '';
+
+my $plan_table_info= printable($m) ? 'width=100%' : '';
+$plan_html .= <<END;
+<table class="data" rules=groups $plan_table_info >
+END
+
+my $tbody= sub {
+	if (!printable($m)) { return '<tbody>'; }
+	my ($c)= qw(40 00)[$_[0]];
+	return "<tr><td bgcolor=\"#${c}${c}${c}\" height=1 colspan=7>";
+};
+
+foreach my $i (0..$#islandids) {
+     $plan_html .= $tbody->(1);
+     $plan_html .= "<tr>\n";
+     $iquery->execute($islandids[$i]);
+     my ($islandnamepr)= encode_entities( $iquery->fetchrow_array() );
+	
+     if (!$i) {
+		$plan_html .= <<END;
+<td colspan=2>
+<strong>Start at $islandnamepr</strong>
+<td colspan=2><a href="docs#posinclass">[what are these codes?]</a>
+<td>
+END
+     } else {
+		my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
+		$total_dist += $this_dist;
+		$plan_html .= <<END;
+<td colspan=5>
+END
+		my $total_value= 0;
+		foreach my $sf (@subflows) {
+			next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
+			$total_value +=
+				$sf->{OptQty} * $sf->{Flow}{'dst_price'};
+		}
+		$plan_html .= <<END;
+<strong>Sail to $islandnamepr</strong>
+- $this_dist leagues, $total_value poe at risk
+ </td>
+END
+     }
+     my $age_reported= 0;
+     my %flowlists;
+     #print "<tr><td colspan=7>" if $qa->{'debug'};
+     foreach my $od (qw(org dst)) {
+	#print " [[ i $i od $od " if $qa->{'debug'};
+	foreach my $sf (@subflows) {
+		my $f= $sf->{Flow};
+		next unless $sf->{ucfirst $od} == $i;
+		#print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
+		#	if $qa->{'debug'};
+		next unless $sf->{OptQty};
+		my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
+		die if $arbitrage and $sf->{Org} != $sf->{Dst};
+		my $price= $f->{"${od}_price"};
+		my $stallname= $f->{"${od}_stallname"};
+		my $todo= \$flowlists{$od}{
+				(sprintf "%010d", $f->{'ordval'}),
+				$f->{'commodname'},
+				(sprintf "%07d", ($od eq 'dst' ?
+						9999999-$price : $price)),
+				$stallname
+			};
+		$$todo= {
+			Qty => 0,
+			orgArbitrage => 0,
+			dstArbitrage => 0,
+		} unless $$todo;
+		$$todo->{'commodid'}= $f->{'commodid'};
+		$$todo->{'commodname'}= $f->{'commodname'};
+		$$todo->{'posinclass'}= '';
+		my $incl= $f->{'posinclass'};
+
+		my $findclass= $dbh->prepare(<<END);
+SELECT commodclass, maxposinclass FROM commodclasses WHERE commodclassid = ?
+END
+		$findclass->execute($f->{'commodclassid'});
+		my $classinfo= $findclass->fetchrow_hashref();
+		if ($classinfo) {
+			my $clname= $classinfo->{'commodclass'};
+			my $desc= encode_entities(sprintf "%s is under %s",
+					$f->{'commodname'}, $clname);
+			my $abbrev= substr($clname,0,1);
+			if ($incl) {
+				my $maxpic= $classinfo->{'maxposinclass'};
+				$desc.= (sprintf ", commodity %d of %d",
+					$incl, $maxpic);
+				if ($classinfo->{'maxposinclass'} >= 8) {
+					my @tmbs= qw(0 1 2 3 4 5 6 7 8 9);
+					my $tmbi= ($incl+0.5)*$#tmbs/$maxpic;
+					$abbrev.= " ".$tmbs[$tmbi]."&nbsp;";
+				}
+			}
+			$$todo->{'posinclass'}=
+				"<div class=mouseover title=\"$desc\">"
+				.$abbrev."</div>";
+		}
+		$$todo->{'stallname'}= $stallname;
+		$$todo->{Price}= $price;
+		$$todo->{Timestamp}= $f->{"${od}_timestamp"};
+		$$todo->{Qty} += $sf->{OptQty};
+		$$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
+		$$todo->{Stalls}= $f->{"${od}Stalls"};
+		$$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
+	}
+	#print "]] " if $qa->{'debug'};
+     }
+     #print "</tr>" if $qa->{'debug'};
+
+     my ($total, $total_to_show);
+     my $dline= 0;
+     my $show_total= sub {
+	my ($totaldesc, $sign) = @_;
+	if (defined $total) {
+		die if defined $total_to_show;
+		$total_total += $sign * $total;
+		$total_to_show= [ $totaldesc, $total ];
+		$total= undef;
+	}
+	$dline= 0;
+     };
+     my $show_total_now= sub {
+	my ($xinfo) = @_;
+	return unless defined $total_to_show;
+	my ($totaldesc,$totalwas) = @$total_to_show;
+	$plan_html .= <<END;
+<tr>
+<td colspan=1>
+<td colspan=3>$xinfo
+<td colspan=2 align=right>$totaldesc
+<td align=right>$totalwas total
+END
+	$total_to_show= undef;
+     };
+     my $show_flows= sub {
+	my ($od,$arbitrage,$collectdeliver) = @_;
+	my $todo= $flowlists{$od};
+	return unless $todo;
+	foreach my $tkey (sort keys %$todo) {
+		my $t= $todo->{$tkey};
+		next if $t->{"${od}Arbitrage"} != $arbitrage;
+		$show_total_now->('');
+		if (!$age_reported++) {
+			my $age= $now - $t->{Timestamp};
+			@oldest= ($age,$islandnamepr) if $oldest[0] < $age;
+			my $cellid= "da_${i}";
+			my $agepr= prettyprint_age($age);
+			$da_ages{$cellid}= $age;
+			$plan_html .= <<END
+<td colspan=2>(Data age: <span id="$cellid">$agepr</span>)
+END
+		} elsif (!defined $total) {
+			$total= 0;
+			$plan_html .= $tbody->(0);
+		}
+		$total += $t->{Total};
+		my $span= 0 + keys %{ $t->{Stalls} };
+		my $td= "td rowspan=$span";
+		my %linkqf= (%{ $qa->{'baseqf'} }, %{ $qa->{'queryqf'} });
+		$linkqf{'query'}= 'commod';
+		$linkqf{'commodstring'}= $t->{'commodname'};
+		$linkqf{'commodid'}= $t->{'commodid'};
+		my $linkqfpr= encode_entities( $quri->(%linkqf) );
+		my $commodnamepr= encode_entities($t->{'commodname'});
+		$plan_html .= tr_datarow_s($m,$dline) . <<END;
+<$td>$collectdeliver
+<$td><a href="$linkqfpr">$commodnamepr</a>
+<$td>$t->{'posinclass'}
+END
+		my @stalls= sort keys %{ $t->{Stalls} };
+		my $pstall= sub {
+			my $namepr= encode_entities( $stalls[$_[0]] );
+			$plan_html .= <<END;
+<td>$namepr
+END
+		};
+
+		$pstall->(0);
+		$plan_html .= <<END;
+<$td align=right>$t->{Price} poe ea.
+<$td align=right>$t->{Qty} unit(s)
+<$td align=right>$t->{Total} total
+END
+		foreach my $stallix (1..$#stalls) {
+			$plan_html .= tr_datarow_s($m,$dline);
+			$pstall->($stallix);
+		}
+
+		$dline ^= 1;
+	}
+     };
+
+     $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
+     $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
+     $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
+     $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
+     my $totals= '';
+     if ($i < $#islandids) {
+	$totals .= 	"In hold $sail_total[$i]{mass}kg,".
+			" $sail_total[$i]{volume} l";
+	my $delim= '; spare ';
+	my $domv= sub {
+		my ($max, $got, $units) = @_;
+		return unless defined $max;
+		$totals .= $delim;
+		$totals .= sprintf "%g %s", ($max-$got), $units;
+		$delim= ', ';
+	};
+	$domv->($routeparams->{MaxMass},   $sail_total[$i]{mass},   'kg');
+	$domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
+	$totals .= ".\n";
+     }
+     $show_total_now->($totals);
+}
+
+my $cashflowpr= $total_total < 0
+		? -$total_total." loss"
+		: $total_total." gain";
+
+my $max_capital= 0;
+foreach my $cap (map { $_->{capital} } @sail_total) {
+	$max_capital= $cap if $cap > $max_capital;
+}
+
+$da_ages{'oldest'}= $oldest[0];
+
+$plan_html .= $tbody->(1) . <<END;
+<tr>
+<td colspan=3>Total distance: $total_dist leagues.
+<td colspan=3 align=right>Overall net cash flow
+<td align=right><strong>$cashflowpr</strong>
+</table>
+END
+
+</%perl>
+% if (!printable($m)) {
+<h2><a name="summary">Summary</a></h2>
+% }
+
+<table>
+<tr>
+ <td>Distance:
+ <td><strong><% $total_dist %></strong> leagues,
+     <strong><% scalar(@islandids) %></strong> island(s)
+<tr>
+ <td>Planned net cash flow:
+ <td><strong><% $cashflowpr %></strong>
+<tr>
+ <td>Expected profit on average: approx.
+ <td>
+  <strong><% sprintf "%d", $expected_total_profit %></strong> poe
+  (considering expected losses, but ignoring rum consumed)
+<tr>
+ <td>Capital required:
+ <td>
+  <strong><% $max_capital %></strong> poe or less
+<tr>
+ <td>Oldest market data used:
+ <td><strong id="oldest"><% prettyprint_age($oldest[0]) %></strong>
+     (<% $oldest[1] %>)
+<tr>
+ <td colspan=2><% $opt_how %>
+</table>
+<p>
+
+<h2><a name="plan">Voyage trading plan</a></h2>
+<% $plan_html %>
+<& query_age:dataages, id2age => \%da_ages &>
+%
+% } # ========== TRADING PLAN ==========
+
+% if (!printable($m)) {
+<h2><a name="dataage">Relevant data ages</a></h2>
+<%perl>
+	my $sth_i= $dbh->prepare(<<END);
+		SELECT archipelago, islandid, islandname, timestamp
+			FROM uploads NATURAL JOIN islands
+			WHERE islandid = ?
+END
+	my $sth_a= $dbh->prepare(<<END);
+		SELECT archipelago, islandid, islandname, timestamp
+			FROM uploads NATURAL JOIN islands
+			WHERE archipelago = ?
+			ORDER BY islandname
+END
+	my $ix=$#islandids;
+	my $sth_current;
+	my %idone;
+	my $fetchrow= sub {
+		for (;;) {
+			if ($sth_current) {
+				my $row= $sth_current->fetchrow_hashref();
+				if ($row) {
+					next if $idone{$row->{'islandid'}}++;
+					return $row;
+				}
+			}
+			return undef if $ix < 0;
+			my $iid= $islandids[$ix];
+			if (defined $iid) {
+				$sth_i->execute($iid);
+				$sth_current= $sth_i;
+			} else {
+				my $arch= $archipelagoes[$ix];
+				die unless defined $arch && length $arch;
+				$sth_a->execute($arch);
+				$sth_current= $sth_a;
+			}
+			$ix--;
+		}
+	};
+</%perl>
+<&| query_age:agestable, now => $now, fetchrow => $fetchrow &>
+Islands shown in reverse order of visits.<br>
+</&>
+% }
+
+% if (!printable($m)) {
+%   my %ts_sortkeys;
+%   {
 %	my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 %	my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
-<table id="trades" rules=groups>
+<h2><a name="trades">Relevant trades</a></h2>
+<table class="data" id="trades" rules=groups>
 <colgroup span=1>
 <colgroup span=2>
 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
@@ -462,10 +1066,11 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 <colgroup span=2>
 <colgroup span=2>
 <colgroup span=3>
+<colgroup span=3>
 %	if ($optimise) {
 <colgroup span=3>
 %	}
-<tr class="spong">
+<tr>
 <th>
 <th<% $cdspan %>>Collect
 <th<% $cdspan %>>Deliver
@@ -474,6 +1079,8 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 <th colspan=2>Deliver
 <th colspan=2>Profit
 <th colspan=3>Max
+<th colspan=1>
+<th colspan=2>Max
 %	if ($optimise) {
 <th colspan=3>Planned
 %	}
@@ -492,192 +1099,76 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 <th>Qty
 <th>Capital
 <th>Profit
+<th>Dist
+<th>Mass
+<th>Vol
 %	if ($optimise) {
 <th>Qty
 <th>Capital
 <th>Profit
 %	}
-% }
+%   }
 
 <tr id="trades_sort">
-% foreach my $col (@cols) {
+%   foreach my $col (@cols) {
 <th>
-% }
+%   }
 
-% foreach my $flowix (0..$#flows) {
+%   foreach my $flowix (0..$#flows) {
 %	my $flow= $flows[$flowix];
 %	my $rowid= "id_row_$flow->{UidShort}";
 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
        <% $flow->{Suppress} ? '' : 'checked' %> >
-%	foreach my $ci (1..$#cols) {
+%	my $ci= 1;
+%	while ($ci < @cols) {
 %		my $col= $cols[$ci];
-%		my $v= $flow->{$col->{Name}};
-%		$col->{Total} += $v if defined $col->{Total};
+%		my $spec= {
+%			Span => 1,
+%			Align => ($col->{Text} ? '' : 'align=right')
+%		};
+%		my $cn= $col->{Name};
+%		my $v;
+%		if (!$col->{TotalSubflows}) {
+%			$v= $flow->{$cn};
+%		} else {
+%			$v= 0;
+%			$v += $_->{$cn} foreach @{ $flow->{Subflows} };
+%		}
+%		if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); }
+%		$col->{Total} += $v
+%			if defined $col->{Total} and not $flow->{Suppress};
 %		$v='' if !$col->{Text} && !$v;
 %		my $sortkey= $col->{SortColKey} ?
 %			$flow->{$col->{SortColKey}} : $v;
 %		$ts_sortkeys{$ci}{$rowid}= $sortkey;
-<td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
+<td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
+ %> <% $spec->{Align}
+ %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
+%		$ci += $spec->{Span};
 %	}
-% }
+%   }
 <tr id="trades_total">
 <th>
 <th colspan=2>Total
-% foreach my $ci (3..$#cols) {
+%   foreach my $ci (3..$#cols) {
 %	my $col= $cols[$ci];
 <td align=right>
 %	if (defined $col->{Total}) {
 <% $col->{Total} |h %>
 %	}
-% }
+%   }
 </table>
 
-<& tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
+<&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 	throw => 'trades_sort', tbrow => 'trades_total' &>
-<&| script &>
   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
-  function all_onload() {
-    ts_onload__trades();
-  }
-  window.onload= all_onload;
-</&script>
-
+</&tabsort>
+<p>
 <input type=submit name=update value="Update">
 
-% if ($optimise) { # ========== TRADING PLAN ==========
-%
-% my $iquery= $dbh->prepare('SELECT islandname FROM islands
-%				WHERE islandid = ?');
-% my %da_ages;
-% my $total_total= 0;
-%
-<h1>Voyage trading plan</h1>
-<table rules=groups>
-% foreach my $i (0..$#islandids) {
-<tbody>
-<tr><td colspan=3><strong>
-%	$iquery->execute($islandids[$i]);
-%	my ($islandname) = $iquery->fetchrow_array();
-%	if (!$i) {
-Start at <% $islandname |h %>
-%	} else {
-Sail to <% $islandname |h %>
-%	}
-</strong>
-<%perl>
-     my $age_reported= 0;
-     my %flowlists;
-     foreach my $od (qw(org dst)) {
-	foreach my $f (@flows) {
-		next if $f->{Suppress};
-		next unless $f->{"${od}_id"} == $islandids[$i];
-		next unless $f->{OptQty};
-		my $price= $f->{"${od}_price"};
-		my $stallname= $f->{"${od}_stallname"};
-		my $todo= \$flowlists{$od}{
-				$f->{'commodname'},
-				(sprintf "%07d", ($od eq 'dst' ?
-						9999999-$price : $price)),
-				$stallname
-			};
-		$$todo= {
-			Qty => 0,
-			orgArbitrage => 0,
-			dstArbitrage => 0,
-		} unless $$todo;
-		$$todo->{'commodname'}= $f->{'commodname'};
-		$$todo->{'stallname'}= $stallname;
-		$$todo->{Price}= $price;
-		$$todo->{Timestamp}= $f->{"${od}_timestamp"};
-		$$todo->{Qty} += $f->{OptQty};
-		$$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
-		$$todo->{Stalls}= $f->{"${od}Stalls"};
-		if ($f->{'org_id'} == $f->{'dst_id'}) {
-			$$todo->{"${od}Arbitrage"}= 1;
-		}
-	}
-     }
-
-     my $total;
-     my $dline= 0;
-     my $show_flows= sub {
-	my ($od,$arbitrage,$collectdeliver) = @_;
-</%perl>
-%
-%	my $todo= $flowlists{$od};
-%	return unless $todo;
-%	foreach my $tkey (sort keys %$todo) {
-%		my $t= $todo->{$tkey};
-%		next if $t->{"${od}Arbitrage"} != $arbitrage;
-%		if (!$age_reported++) {
-%			my $age= $now - $t->{Timestamp};
-%			my $cellid= "da_${i}";
-%			$da_ages{$cellid}= $age;
-<td colspan=3>\
-(Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
-%		} elsif (!defined $total) {
-%			$total= 0;
-<tbody>
-%		}
-%		$total += $t->{Total};
-%		my $span= 0 + keys %{ $t->{Stalls} };
-%		my $td= "td rowspan=$span";
-<tr class="datarow<% $dline %>">
-<<% $td %>><% $collectdeliver %>
-<<% $td %>><% $t->{'commodname'} |h %>
-%
-%		my @stalls= sort keys %{ $t->{Stalls} };
-%		my $pstall= sub {
-%			my $name= $stalls[$_[0]];
-<td><% $name |h %>
-%		};
-%
-%		$pstall->(0);
-<<% $td %> align=right><% $t->{Price} |h %> poe ea.
-<<% $td %> align=right><% $t->{Qty} |h %> unit(s)
-<<% $td %> align=right><% $t->{Total} |h %> total
-%
-%		foreach my $stallix (1..$#stalls) {
-<tr class="datarow<% $dline %>">
-%			$pstall->($stallix);
-%		}
-%
-%		$dline ^= 1;
-%	}
-%    };
-%    my $show_total= sub {
-%	my ($totaldesc, $sign)= @_;
-%	if (defined $total) {
-<tr>
-<td colspan=3>
-<td colspan=2 align=right><% $totaldesc %>
-<td align=right><% $total |h %> total
-%		$total_total += $sign * $total;
-%	}
-%	$total= undef;
-%	$dline= 0;
-<%perl>
-     };
-
-     $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
-     $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
-     $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
-     $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
-
-}
-</%perl>
-<tbody><tr>
-<td colspan=2>
-<td colspan=3 align=right>Overall net cash flow
-<td align=right><strong><%
-  $total_total < 0 ? -$total_total." loss" : $total_total." gain"
- %></strong>
-</table>
-<& query_age:dataages, id2age => \%da_ages &>
-%
-% } # ========== TRADING PLAN ==========
+% } # !printable
 
 <%init>
 use CommodsWeb;