X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=59b02674f1034bb82c983f803afa44e54600075b;hb=54f130dd25e32cfeb3e52b11b50fffc2f93d18ad;hp=ce319facae713bb9e32edddf86a1509d979b4772;hpb=05a607330cc73832ccc778cd10f69cbac8e6dba3;p=ypp-sc-tools.db-live.git diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index ce319fa..59b0267 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -39,6 +39,8 @@ $dbh @archipelagoes $qa $routeparams +$reset_suppressions +$quri %args> <& query_age:pageload &> @@ -47,6 +49,9 @@ $routeparams 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; @@ -140,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 @@ -272,13 +281,21 @@ Searched for arbitrage trades only, in <% $archipelagoes[0] |h %> <%perl> -my @sail_total; - 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'} @@ -303,6 +320,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, @@ -365,11 +384,21 @@ 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}"}) { + $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= { @@ -389,13 +418,24 @@ foreach my $f (@flows) { } %perl> -% my $optimise= $specific; -% if (!$optimise) { +% my $optimise= 1; -
% 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 ==========
@@ -407,11 +447,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 .= "
@@ -482,6 +528,32 @@ 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";
+}
+
+if ($qa->{ShowStalls}>=2) {
+ my $stallpoe= $dbh->prepare(<\n" if $qa->{'debug'};
my $found_section= 0;
@@ -546,7 +618,7 @@ if ($qa->{'debug'}) {
my ($varname, $qty) = m/^
\s* \d+ \s+
(\w+) \s+ (?: [A-Z*]+ \s+ )?
- ([0-9.]+) \s
+ ([+-e0-9.]+) \s
/x or die "$cplex \n==\n $glpsol_out $_ ?";
if ($varname =~ m/^f(\d+)s(\d+)_/) {
my ($ix,$orgix) = ($1,$2);
@@ -635,14 +707,18 @@ Generated by YARRG at <%
%
% foreach my $i (0..$#islandids) {
<% $tbody->(1) %>
-
+
% $iquery->execute($islandids[$i]);
% my ($islandname) = $iquery->fetchrow_array();
% if (!$i) {
+
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) {
@@ -659,7 +735,7 @@ 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) {
@@ -673,6 +749,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)),
@@ -683,7 +760,35 @@ Generated by YARRG at <%
orgArbitrage => 0,
dstArbitrage => 0,
} unless $$todo;
+ $$todo->{'commodid'}= $f->{'commodid'};
$$todo->{'commodname'}= $f->{'commodname'};
+ $$todo->{'posinclass'}= '';
+ my $incl= $f->{'posinclass'};
+
+ my $findclass= $dbh->prepare(<
- <% $xinfo %>
+ <% $xinfo %>
<% $totaldesc %>
<% $totalwas |h %> total
<%perl>
@@ -743,9 +848,14 @@ Generated by YARRG at <%
% $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'};
% tr_datarow($m,$dline);
<<% $td %>><% $collectdeliver %>
-<<% $td %>><% $t->{'commodname'} |h %>
+<<% $td %>><% $t->{'commodname'} |h %>
+<<% $td %>><% $t->{'posinclass'} %>
%
% my @stalls= sort keys %{ $t->{Stalls} };
% my $pstall= sub {
@@ -792,7 +902,7 @@ Generated by YARRG at <%
}
%perl>
<% $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"