X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=9cd57122d66b8fd421fd040dc00ee45abbf66422;hb=43454422b2df5e0dcfe144fcb871a2b6f9c1a3d0;hp=68c727cdbd1aec41407534e2c1047e5b1d95b14b;hpb=4a64ff96caa3eddb15ed84e09b6b5c8b7d614fc8;p=ypp-sc-tools.web-test.git diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 68c727c..9cd5712 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -39,6 +39,7 @@ $dbh @archipelagoes $qa $routeparams +$reset_suppressions <& query_age:pageload &> @@ -48,6 +49,8 @@ my $loss_per_league= defined $routeparams->{LossPerLeaguePct} ? $routeparams->{LossPerLeaguePct}*0.01 : 1e-7; my $loss_per_delay_slot= 1e-8; +my $minprofit= $routeparams->{MinProfit} || 0; + my $now= time; my @flow_conds; @@ -140,6 +143,9 @@ my $stmt= " commods.commodid commodid, commods.unitmass unitmass, commods.unitvolume unitvolume, + commods.ordval ordval, + commods.posinclass posinclass, + commods.commodclassid commodclassid, dist dist, buy.price - sell.price unitprofit FROM commods @@ -261,15 +267,30 @@ foreach my $v (qw(MaxMass MaxVolume)) { <& dumptable:end, qa => $qa &> % } -<%perl> +% if (@islandids==1) { +% if (defined $islandids[0]) { +Searched for arbitrage trades only. +% } else { +Searched for arbitrage trades only, in <% $archipelagoes[0] |h %> +[?]. +% } +% } -my @sail_total; +<%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); +}; + foreach my $f (@flows) { $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'} @@ -283,22 +304,6 @@ 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%%", @@ -310,6 +315,8 @@ foreach my $f (@flows) { $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, @@ -372,12 +379,36 @@ foreach my $f (@flows) { $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}"}) { + $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; + } + } } @@ -399,11 +430,17 @@ Maximize totalprofit: "; +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 .= " @@ -412,13 +449,7 @@ Subject To my %avail_lims; foreach my $flow (@flows) { - if ($flow->{Suppress}) { - foreach my $sf (@{ $flow->{Subflows} }) { - $cplex .= " - $sf->{Var} = 0"; - } - next; - } + next if $flow->{Suppress}; foreach my $od (qw(org dst)) { my $limname= join '_', ( $od, @@ -483,6 +514,24 @@ foreach my $ci (0..($#islandids-1)) { $cplex.= "\n"; } +if ($qa->{ShowStalls}>=2) { + my $stallpoe= $dbh->prepare(< $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 " @@ -510,7 +559,7 @@ if ($qa->{'debug'}) { my $input= pipethrough_prep(); print $input $cplex or die $!; my $output= pipethrough_run_along($input, undef, 'glpsol', - qw(glpsol --tmlim 2 --memlim 5 --intopt --cuts --bfs + qw(glpsol --tmlim 5 --memlim 5 --intopt --cuts --bfs --cpxlp /dev/stdin -o /dev/stdout)); print "
\n" if $qa->{'debug'};
 	my $found_section= 0;
@@ -524,7 +573,7 @@ if ($qa->{'debug'}) {
 			$found_section= 1;
 			next;
 		}
-		if (m/^Objective:\s+totalprofit = (\d+\.\d*) /) {
+		if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
 			$expected_total_profit= $1;
 		}
 		next unless $found_section==1;
@@ -544,8 +593,8 @@ if ($qa->{'debug'}) {
 		my ($varname, $qty) = m/^
 			\s* \d+ \s+
 			(\w+) \s+ (?: [A-Z*]+ \s+ )?
-			([0-9.]+) \s
-			/x or die "$_ ?";
+			([+-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;
@@ -565,6 +614,7 @@ 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 $_->{Flow}{Ix}" } @subflows;
+	defined $expected_total_profit or die "$prerr ?";
 };
 
 $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
@@ -622,7 +672,7 @@ Generated by YARRG at <%
 %
 

Voyage trading plan

- > +
> % my $tbody= sub { % if (!printable($m)) { return ''; } %# return " % $iquery->execute($islandids[$i]); % my ($islandname) = $iquery->fetchrow_array(); % if (!$i) { + -' : '';

Relevant trades

-

"; @@ -632,14 +682,18 @@ Generated by YARRG at <% % % foreach my $i (0..$#islandids) { <% $tbody->(1) %> -
+
Start at <% $islandname |h %> +[what are these codes?] + % } else { % my $this_dist= $distance->($islandids[$i-1],$islandids[$i]); % $total_dist += $this_dist; + <%perl> my $total_value= 0; foreach my $sf (@subflows) { @@ -656,12 +710,11 @@ Generated by YARRG at <% <%perl> my $age_reported= 0; my %flowlists; - #print "
" if $qa->{'debug'}; + #print "
" 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 if $f->{Suppress}; next unless $sf->{ucfirst $od} == $i; #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} " # if $qa->{'debug'}; @@ -671,6 +724,7 @@ Generated by YARRG at <% 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)), @@ -682,6 +736,33 @@ Generated by YARRG at <% dstArbitrage => 0, } unless $$todo; $$todo->{'commodname'}= $f->{'commodname'}; + $$todo->{'posinclass'}= ''; + my $incl= $f->{'posinclass'}; + + my $findclass= $dbh->prepare(<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]." "; + } + } + $$todo->{'posinclass'}= + "
" + .$abbrev."
"; + } $$todo->{'stallname'}= $stallname; $$todo->{Price}= $price; $$todo->{Timestamp}= $f->{"${od}_timestamp"}; @@ -713,7 +794,7 @@ Generated by YARRG at <%
-<% $xinfo %> +<% $xinfo %> <% $totaldesc %> <% $totalwas |h %> total <%perl> @@ -744,6 +825,7 @@ Generated by YARRG at <% % tr_datarow($m,$dline); <<% $td %>><% $collectdeliver %> <<% $td %>><% $t->{'commodname'} |h %> +<<% $td %>><% $t->{'posinclass'} %> % % my @stalls= sort keys %{ $t->{Stalls} }; % my $pstall= sub { @@ -790,7 +872,7 @@ Generated by YARRG at <% } <% $tbody->(1) %>
Total distance: <% $total_dist %> leagues. +Total distance: <% $total_dist %> leagues. Overall net cash flow <% $total_total < 0 ? -$total_total." loss" : $total_total." gain" @@ -855,7 +937,7 @@ Islands shown in reverse order of visits.
% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; % my $cdstall= $qa->{ShowStalls} ? '
Stall
+
<% $qa->{ShowStalls} ? '' : '' %> @@ -963,7 +1045,7 @@ Islands shown in reverse order of visits.
throw => 'trades_sort', tbrow => 'trades_total' &> ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>; - +

% } # !printable