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=d66e8b1772c8bb8a4b8db0dceedac4e244dff740;hp=199101728344aa9329b343d1d7c5b6599e0f5fdf;hb=b003b70daab49984677a1cfadced9da9ee9be19a;hpb=1d5eaaa6191b09cbf54822dfdba1cd497991b26b

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 1991017..d66e8b1 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -38,10 +38,7 @@ $dbh
 @islandids
 @archipelagoes
 $qa
-$max_mass
-$max_volume
-$lossperleaguepct
-$max_capital
+$routeparams
 </%args>
 <&| script &>
   da_pageload= Date.now();
@@ -49,13 +46,16 @@ $max_capital
 
 <%perl>
 
-my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
+my $loss_per_league= defined $routeparams->{LossPerLeaguePct}
+	? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7;
+my $loss_per_delay_slot= 1e-8;
 
 my $now= time;
 
 my @flow_conds;
 my @query_params;
 my %dists;
+my $expected_total_profit;
 
 my $sd_condition= sub {
 	my ($bs, $ix) = @_;
@@ -68,42 +68,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 || $src_i==$#islandids) &&
-		      $dst_i==$#islandids &&
-		      $src_isle == $islandids[$dst_i])) {
-			if ($islandpair{$src_isle,$dst_isle}) {
-				$confusing= 1;
-print "confusing $src_i $src_isle  $dst_i $dst_isle\n";
-			} 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)."
 		)";
@@ -242,7 +243,6 @@ foreach my $v (qw(MaxMass MaxVolume)) {
 
 		$f= {
 			Ix => scalar(@flows),
-			Var => "f".@flows,
 			%$got
 		};
 		$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
@@ -265,7 +265,7 @@ foreach my $v (qw(MaxMass MaxVolume)) {
 
 <%perl>
 
-my @total_massvol;
+my @sail_total;
 
 if (!@flows) {
 	print 'No profitable trading opportunities were found.';
@@ -285,6 +285,22 @@ foreach my $f (@flows) {
 		$f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6;
 	}
 
+	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;
+	}
+
 	$f->{MarginSortKey}= sprintf "%d",
 		$f->{'dst_price'} * 10000 / $f->{'org_price'};
 	$f->{Margin}= sprintf "%3.1f%%",
@@ -314,7 +330,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;
@@ -322,8 +338,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;
@@ -367,20 +383,13 @@ die "$cmpu $uue ?" if length $cmpu > 20;
 }
 </%perl>
 
-% my $optimise= $specific && !$confusing && @islandids>1;
+% my $optimise= $specific;
 % if (!$optimise) {
 
 <p>
-% if (@islandids<=1) {
-Route contains only one location.
-% }
 % 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 voyage trade plan not calculated.
 
 % } else { # ========== OPTMISATION ==========
@@ -390,88 +399,103 @@ my $cplex= "
 Maximize
 
   totalprofit:
-                  ".(join "
-                  ", map {
-			sprintf "%+.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
-			} @flows)."
+";
+
+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};
+}
+$cplex .= "
 
 Subject To
 ";
 
-my %avail_csts;
+my %avail_lims;
 foreach my $flow (@flows) {
 	if ($flow->{Suppress}) {
-		$cplex .= "
-   $flow->{Var} = 0
-";
+		foreach my $sf (@{ $flow->{Subflows} }) {
+			$cplex .= "
+   $sf->{Var} = 0";
+		}
 		next;
 	}
 	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 $cstname (sort keys %avail_csts) {
-	my $c= $avail_csts{$cstname};
-	$cplex .= "
-   ". sprintf("%-30s","$cstname:")." ".
-	join("+", @{ $c->{Flows} }).
-	" <= ".$c->{Qty}."\n";
+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_flows;
+	my @rel_subflows;
+
 	foreach my $f (@flows) {
 		next if $f->{Suppress};
-		next if $f->{'org_id'} == $f->{'dst_id'};
-		next unless grep { $f->{'org_id'} == $_ }
-			@islandids[0..$ci];
-		next unless grep { $f->{'dst_id'} == $_ }
-			@islandids[$ci+1..@islandids-1];
-		push @rel_flows, $f;
-#print " RELEVANT $ci $f->{Ix}  ";
+		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)) {
+			$sail_total[$ci]{$mv}= 0;
+		}
+		next;
 	}
-#print " RELEVANT $ci COUNT ".scalar(@rel_flows)."  ";
-	next unless @rel_flows;
-	foreach my $mv (qw(mass volume)) {
-		my $max_vn= "max_$mv";
-		my $max= $mv eq 'mass' ? $max_mass : $max_volume;
+
+	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 { ($_->{"unit$mv"}*1e-3).' f'.$_->{Ix} } @rel_flows).
-	" <= $max";
-	}
-	if (defined $max_capital) {
-	   $cplex .= "
-   ". sprintf("%-10s","capital_$ci:")." ".
-	join(" + ", map { ($_->{"org_price"}).' f'.$_->{Ix} } @rel_flows).
-        " <= $max_capital";
-        }
+		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'}       });
 	$cplex.= "\n";
 }
 
 $cplex.= "
 Bounds
         ".(join "
-        ", map { "$_->{Var} >= 0" } @flows)."
+        ", map { "$_->{Var} >= 0" } @subflows)."
 
 ";
 
 $cplex.= "
 Integer
 	".(join "
-	", map { "f$_" } (0..$#flows))."
+	", map { $_->{Var} } @subflows)."
 
 End
 ";
@@ -502,6 +526,9 @@ if ($qa->{'debug'}) {
 			$found_section= 1;
 			next;
 		}
+		if (m/^Objective:\s+totalprofit = (\d+\.\d*) /) {
+			$expected_total_profit= $1;
+		}
 		next unless $found_section==1;
 		if (!length $continuation) {
 			next if !$continuation &&  m/^[- ]+$/;
@@ -521,29 +548,28 @@ if ($qa->{'debug'}) {
 			(\w+) \s+ (?: [A-Z*]+ \s+ )?
 			([0-9.]+) \s
 			/x or die "$_ ?";
-		if ($varname =~ m/^f(\d+)$/) {
-			my ($ix) = $1;
+		if ($varname =~ m/^f(\d+)s(\d+)_/) {
+			my ($ix,$orgix) = ($1,$2);
 			my $flow= $flows[$ix] or die;
-			$flow->{OptQty}= $qty;
-			$flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
-			$flow->{OptCapital}= $flow->{OptQty} *
-				$flow->{'org_price'};
+			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)_(\d+)$/) {
 			my ($mv,$ix) = ($1,$2);
-			$total_massvol[$ix]{$mv}= $qty;
+			$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);
-	map { defined $_->{OptQty} or die "$prerr $_->{Ix}" } @flows;
-#	map { defined 
-#	die $prerr if grep { ! } @flows;
-#	map { die 
-#	die $prerr if map { 
+	map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
 };
 
-$addcols->({ DoReverse => 1, Special => sub {
+$addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
 	my ($flow,$col,$v,$spec) = @_;
 	if ($flow->{ExpectedUnitProfit} < 0) {
 		$spec->{Span}= 3;
@@ -553,7 +579,7 @@ $addcols->({ DoReverse => 1, Special => sub {
 } }, qw(
 		OptQty
 	));
-$addcols->({ Total => 0, DoReverse => 1 }, qw(
+$addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
 		OptCapital OptProfit
 	));
 
@@ -636,7 +662,14 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 %			Span => 1,
 %			Align => ($col->{Text} ? '' : 'align=right')
 %		};
-%		my $v= $flow->{$col->{Name}};
+%		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};
@@ -681,7 +714,7 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 <table rules=groups>
 % foreach my $i (0..$#islandids) {
 <tbody>
-<tr><td colspan=3>
+<tr><td colspan=4>
 %	$iquery->execute($islandids[$i]);
 %	my ($islandname) = $iquery->fetchrow_array();
 %	if (!$i) {
@@ -689,22 +722,34 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 %	} else {
 %		my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
 %		$total_dist += $this_dist;
+<%perl>
+		my $total_value= 0;
+		foreach my $sf (@subflows) {
+			next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
+			$total_value +=
+				$sf->{OptQty} * $sf->{Flow}{'dst_price'};
+		}
+</%perl>
 <strong>Sail to <% $islandname |h %></strong>
-- <% $this_dist |h %> leagues </td>
+- <% $this_dist |h %> leagues,
+ <% $total_value %>poe at risk
+ </td>
 %	}
 <%perl>
      my $age_reported= 0;
      my %flowlists;
+     #print "<tr><td colspan=6>" if $qa->{'debug'};
      foreach my $od (qw(org dst)) {
-	foreach my $f (@flows) {
+	#print " [[ i $i od $od " if $qa->{'debug'};
+	foreach my $sf (@subflows) {
+		my $f= $sf->{Flow};
 		next if $f->{Suppress};
-		next unless $f->{"${od}_id"} == $islandids[$i];
-		next unless $f->{OptQty};
+		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'};
-		my $loop= $islandids[0] == $islandids[-1] &&
-			  ($i==0 || $i==$#islandids);
-		next if $loop and ($arbitrage ? $i :
-			!!$i == !!($od eq 'org'));
+		die if $arbitrage and $sf->{Org} != $sf->{Dst};
 		my $price= $f->{"${od}_price"};
 		my $stallname= $f->{"${od}_stallname"};
 		my $todo= \$flowlists{$od}{
@@ -722,12 +767,14 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 		$$todo->{'stallname'}= $stallname;
 		$$todo->{Price}= $price;
 		$$todo->{Timestamp}= $f->{"${od}_timestamp"};
-		$$todo->{Qty} += $f->{OptQty};
+		$$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;
@@ -767,7 +814,7 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 %			my $age= $now - $t->{Timestamp};
 %			my $cellid= "da_${i}";
 %			$da_ages{$cellid}= $age;
-<td colspan=3>\
+<td colspan=2>\
 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 %		} elsif (!defined $total) {
 %			$total= 0;
@@ -807,8 +854,8 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
      my $totals= '';
      if ($i < $#islandids) {
-	$totals .= 	"In hold $total_massvol[$i]{mass} kg,".
-			" $total_massvol[$i]{volume} l";
+	$totals .= 	"In hold $sail_total[$i]{mass}kg,".
+			" $sail_total[$i]{volume} l";
 	my $delim= '; spare ';
 	my $domv= sub {
 		my ($max, $got, $units) = @_;
@@ -817,8 +864,8 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
 		$totals .= sprintf "%g %s", ($max-$got), $units;
 		$delim= ', ';
 	};
-	$domv->($max_mass,   $total_massvol[$i]{mass},   'kg');
-	$domv->($max_volume, $total_massvol[$i]{volume}, 'l');
+	$domv->($routeparams->{MaxMass},   $sail_total[$i]{mass},   'kg');
+	$domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
 	$totals .= ".\n";
      }
      $show_total_now->($totals);
@@ -832,6 +879,9 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw(
  %></strong>
 </table>
 <& query_age:dataages, id2age => \%da_ages &>
+Expected average profit:
+ approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
+ (considering expected losses, but ignoring rum consumed)
 %
 % } # ========== TRADING PLAN ==========