X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=03ef3e1e8dc4ab99bfc8b29cfc8b69750268845c;hb=85bb4e4331aa1d2b1c2fd0120fd8c0ad08d6ed4a;hp=9cd57122d66b8fd421fd040dc00ee45abbf66422;hpb=43454422b2df5e0dcfe144fcb871a2b6f9c1a3d0;p=ypp-sc-tools.db-live.git diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 9cd5712..03ef3e1 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -40,6 +40,7 @@ $dbh $qa $routeparams $reset_suppressions +$quri %args> <& query_age:pageload &> @@ -48,6 +49,7 @@ $reset_suppressions 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; @@ -146,6 +148,7 @@ my $stmt= " commods.ordval ordval, commods.posinclass posinclass, commods.commodclassid commodclassid, + commods.flags flags, dist dist, buy.price - sell.price unitprofit FROM commods @@ -291,6 +294,8 @@ my $oppo_key= sub { 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'} @@ -389,6 +394,7 @@ foreach my $f (@flows) { } } else { if (!defined $qa->{"T$f->{UidShort}"}) { + $any_previous_suppression= 1; $f->{Suppress}= 1; } } @@ -412,13 +418,25 @@ foreach my $f (@flows) { } %perl> -% my $optimise= $specific; -% if (!$optimise) { +% my $optimise= 1; +% my $opt_how; -
% 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 (!$optimise) { + +
Therefore, optimal voyage trade plan not calculated. % } else { # ========== OPTMISATION ========== @@ -488,7 +506,7 @@ foreach my $ci (0..($#islandids-1)) { } #print " RELEVANT $ci COUNT ".scalar(@rel_subflows)." "; if (!@rel_subflows) { - foreach my $mv (qw(mass volume)) { + foreach my $mv (qw(mass volume capital)) { $sail_total[$ci]{$mv}= 0; } next; @@ -511,6 +529,14 @@ foreach my $ci (0..($#islandids-1)) { $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"; } @@ -555,16 +581,23 @@ 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 --tmlim 5 --memlim 5 --intopt --cuts --bfs - --cpxlp /dev/stdin -o /dev/stdout)); - print "
\n" if $qa->{'debug'}; + qw(glpsol --tmlim 5 --memlim 20), @opts, + qw( --cpxlp /dev/stdin -o /dev/stdout)); + if ($qa->{'debug'}) { + print "@opts
\n\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'}; @@ -573,6 +606,14 @@ if ($qa->{'debug'}) { $found_section= 1; next; } + if ((m/^Integer optimization begins/ .. 0) && + m/^\+ \s* \d+\: \s* mip \s* = \s* \d/) { + $somemip= 1; + next; + } + if (m/^TIME LIMIT EXCEEDED/) { + $timelimit= 1; + } if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) { $expected_total_profit= $1; } @@ -593,7 +634,7 @@ if ($qa->{'debug'}) { my ($varname, $qty) = m/^ \s* \d+ \s+ (\w+) \s+ (?: [A-Z*]+ \s+ )? - ([+-e0-9.]+) \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); @@ -605,7 +646,7 @@ if ($qa->{'debug'}) { $sf->{OptQty}= $qty; $sf->{OptProfit}= $qty * $flow->{'unitprofit'}; $sf->{OptCapital}= $qty * $flow->{'org_price'}; - } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) { + } elsif ($varname =~ m/^(mass|volume|capital)_(\d+)$/) { my ($mv,$ix) = ($1,$2); $sail_total[$ix]{$mv}= $qty; } @@ -615,8 +656,28 @@ if ($qa->{'debug'}) { pipethrough_run_finish($output,$prerr); 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; }; +unless ($try_solve->('Optimisation successful', + qw( --intopt --cuts --bfs )) or + $try_solve->('Complex problem, downgraded'. + ' to rounded-down LP.', + qw( --nomip ))) { +%perl> +Optimisation failed
+The linear/mixed-integer optimisation failed. +Please report this problem. + ++<% $cplex |h %> ++<%perl> + return; +} + $addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub { my ($flow,$col,$v,$spec) = @_; if ($flow->{ExpectedUnitProfit} < 0) { @@ -639,9 +700,9 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(Contents
"; -% my ($c)= qw(40 00)[$_[0]]; -% return " | ||||||||||||||||||||||||||||||||||||
"; -% }; -% -% foreach my $i (0..$#islandids) { -<% $tbody->(1) %> - | ||||||||||||||||||||||||||||||||||||
"; +}; + +foreach my $i (0..$#islandids) { + $plan_html .= $tbody->(1); + $plan_html .= " | ||||||||||||||||||||||||||||||||||||
[what are these codes?] |
-% } else {
-% my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
-% $total_dist += $this_dist;
+END
+ } else {
+ my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
+ $total_dist += $this_dist;
+ $plan_html .= < |
-% }
-<%perl>
+END
+ }
my $age_reported= 0;
my %flowlists;
#print "|||||||||||||||||||||||||||||||||||
" if $qa->{'debug'};
@@ -735,6 +802,7 @@ Generated by YARRG at <%
orgArbitrage => 0,
dstArbitrage => 0,
} unless $$todo;
+ $$todo->{'commodid'}= $f->{'commodid'};
$$todo->{'commodname'}= $f->{'commodname'};
$$todo->{'posinclass'}= '';
my $incl= $f->{'posinclass'};
@@ -791,62 +859,72 @@ END
my ($xinfo) = @_;
return unless defined $total_to_show;
my ($totaldesc,$totalwas) = @$total_to_show;
-%perl>
+ $plan_html .= <
- | <% $xinfo %>
- | <% $totaldesc %>
- | <% $totalwas |h %> total
-<%perl>
+ | $xinfo
+ | $totaldesc
+ | $totalwas total
+END
$total_to_show= undef;
};
-%perl>
-% 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};
-% my $cellid= "da_${i}";
-% $da_ages{$cellid}= $age;
- | \
-(Data age: <% prettyprint_age($age) %>)
-% } elsif (!defined $total) {
-% $total= 0;
-<% $tbody->(0) %>
-% }
-% $total += $t->{Total};
-% my $span= 0 + keys %{ $t->{Stalls} };
-% my $td= "td rowspan=$span";
-% tr_datarow($m,$dline);
-<<% $td %>><% $collectdeliver %>
-<<% $td %>><% $t->{'commodname'} |h %>
-<<% $td %>><% $t->{'posinclass'} %>
-%
-% my @stalls= sort keys %{ $t->{Stalls} };
-% my $pstall= sub {
-% my $name= $stalls[$_[0]];
- | <% $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_datarow($m,$dline);
-% $pstall->($stallix);
-% }
-%
-% $dline ^= 1;
-% }
-% };
-<%perl>
+ 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 .= < | Total distance: <% $total_dist %> leagues.
+
+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) . < | Total distance: $total_dist leagues.
| Overall net cash flow
- | <%
- $total_total < 0 ? -$total_total." loss" : $total_total." gain"
- %>
+ | $cashflowpr
+ | |
Distance: + | <% $total_dist %> leagues, + <% scalar(@islandids) %> island(s) + |
Planned net cash flow: + | <% $cashflowpr %> + |
Expected profit on average: approx. + | + <% sprintf "%d", $expected_total_profit %> poe + (considering expected losses, but ignoring rum consumed) + |
Capital required: + | + <% $max_capital %> poe or less + |
Oldest market data used: + | <% prettyprint_age($oldest[0]) %> + (<% $oldest[1] %>) + |
<% $opt_how %> |
+ +