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=ee1141a3965c73d2672c81ff9c93cd3f4bb0bb00;hp=73740ea346621e5b678a9641e2b9ef5911afc412;hb=cbb3ac3d1f9bf4bc1833c84be27f8f32c6779374;hpb=1a64a4e4703ade43ff0b26150f8128969be0ec8b

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 73740ea..ee1141a 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -50,10 +50,11 @@ $max_capital
 <%perl>
 
 my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
+my $loss_per_delay_slot= 1e-8;
 
 my $now= time;
 
-my @flow_conds;
+my %flow_conds;
 my @query_params;
 my %dists;
 
@@ -68,45 +69,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 @dst_conds;
-	foreach my $dst_i ($src_i..$#islandids) {
+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 ($org_i..$#islandids) {
 		my $dst_isle= $islandids[$dst_i];
+		# Don't ever consider sailing things round the houses:
+		next if grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
+		next if grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
 		my $dst_cond= $sd_condition->('buy',$dst_i);
-		if ($dst_i==$src_i and !defined $src_isle) {
+		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)";
 		}
-		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 ];
-			}
+		$dst_conds{$dst_cond}= 1;
+
+		if ($specific) {
+			push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
+				[ $org_i, $dst_i ];
 		}
 	}
-	push @flow_conds, "$src_cond AND (
+	$flow_conds{ "$org_cond AND (
 			".join("
-		     OR ",@dst_conds)."
-		)";
+		     OR ", sort keys %dst_conds)."
+		)" }= 1;
 }
 
 my $stmt= "		
@@ -155,7 +154,7 @@ my $stmt= "
 	JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 	WHERE	(
 		".join("
-	   OR	", @flow_conds)."
+	   OR	", sort keys %flow_conds)."
 	)
 	  AND	buy.price > sell.price
 	ORDER BY org_name, dst_name, commodname, unitprofit DESC,
@@ -242,7 +241,6 @@ foreach my $v (qw(MaxMass MaxVolume)) {
 
 		$f= {
 			Ix => scalar(@flows),
-			Var => "f".@flows,
 			%$got
 		};
 		$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
@@ -265,7 +263,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 +283,18 @@ 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", $f->{Ix}, $sfi->[0]
+		};
+		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 +324,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 +332,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 +377,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,24 +393,30 @@ 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 '_', (
+		my $limname= join '_', (
 			'avail',
 			$flow->{'commodid'},
 			$od,
@@ -415,63 +424,72 @@ foreach my $flow (@flows) {
 			$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, $max, $f2val) = @_;
 		$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',   $max_mass,   sub { $_[0]{'unitmass'}  *1e-3 });
+	$applylimit->('volume', $max_volume, sub { $_[0]{'unitvolume'}*1e-3 });
+	$applylimit->('capital',$max_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
 ";
@@ -520,29 +538,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;
@@ -552,7 +569,7 @@ $addcols->({ DoReverse => 1, Special => sub {
 } }, qw(
 		OptQty
 	));
-$addcols->({ Total => 0, DoReverse => 1 }, qw(
+$addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
 		OptCapital OptProfit
 	));
 
@@ -635,7 +652,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};
@@ -680,7 +704,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) {
@@ -688,22 +712,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}{
@@ -721,12 +757,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;
@@ -766,7 +804,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;
@@ -806,8 +844,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 .= 	"Hold: $sail_total[$i]{mass}kg,".
+			" $sail_total[$i]{volume} l";
 	my $delim= '; spare ';
 	my $domv= sub {
 		my ($max, $got, $units) = @_;
@@ -816,8 +854,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->($max_mass,   $sail_total[$i]{mass},   'kg');
+	$domv->($max_volume, $sail_total[$i]{volume}, 'l');
 	$totals .= ".\n";
      }
      $show_total_now->($totals);