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=ce319facae713bb9e32edddf86a1509d979b4772;hp=f9ebfeaf3f60fa783ce8c796090906d38c4eefc0;hb=eb4dd353926d8d5f38ea442ee172ce0b2bb5925e;hpb=ba117b2a7d73eae16ad76edf42ebf7e7c93f282a diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index f9ebfea..ce319fa 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -38,18 +38,14 @@ $dbh @islandids @archipelagoes $qa -$max_mass -$max_volume -$lossperleaguepct -$max_capital +$routeparams %args> -<&| script &> - da_pageload= Date.now(); -&script> +<& query_age:pageload &> <%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; @@ -265,6 +261,15 @@ foreach my $v (qw(MaxMass MaxVolume)) { <& dumptable:end, qa => $qa &> % } +% if (@islandids==1) { +% if (defined $islandids[0]) { +Searched for arbitrage trades only. +% } else { +Searched for arbitrage trades only, in <% $archipelagoes[0] |h %> +[?]. +% } +% } + <%perl> my @sail_total; @@ -287,22 +292,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%%", @@ -380,8 +369,23 @@ foreach my $f (@flows) { if (defined $qa->{"R$f->{UidShort}"} && !defined $qa->{"T$f->{UidShort}"}) { $f->{Suppress}= 1; + } else { + 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; + } } - } %perl> @@ -416,13 +420,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, @@ -468,7 +466,8 @@ foreach my $ci (0..($#islandids-1)) { } my $applylimit= sub { - my ($mv, $max, $f2val) = @_; + my ($mv, $f2val) = @_; + my $max= $routeparams->{"Max".ucfirst $mv}; $max= 1e9 unless defined $max; #print " DEFINED MAX $mv $max "; $cplex .= " @@ -480,9 +479,9 @@ foreach my $ci (0..($#islandids-1)) { " <= $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'} }); + $applylimit->('mass', sub { $_[0]{'unitmass'} *1e-3 }); + $applylimit->('volume', sub { $_[0]{'unitvolume'}*1e-3 }); + $applylimit->('capital', sub { $_[0]{'org_price'} }); $cplex.= "\n"; } @@ -527,7 +526,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; @@ -548,7 +547,7 @@ if ($qa->{'debug'}) { \s* \d+ \s+ (\w+) \s+ (?: [A-Z*]+ \s+ )? ([0-9.]+) \s - /x or die "$_ ?"; + /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; @@ -568,6 +567,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 { @@ -588,120 +588,32 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw( % } # ========== OPTIMISATION ========== -% my %ts_sortkeys; -% { -% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; -% my $cdstall= $qa->{ShowStalls} ? '
- | >Collect - | >Deliver - | - | Collect - | Deliver - | Profit - | Max - | - | Max -% if ($optimise) { - | Planned -% } - - | |||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
- | Island <% $cdstall %> - | Island <% $cdstall %> - | Commodity - | Price - | Qty - | Price - | Qty - | Margin - | Unit - | Qty - | Capital - | Profit - | Dist - | Mass - | Vol -% if ($optimise) { - | Qty - | Capital - | Profit
-% }
+% if (!printable($m)) {
+Contents+
|
"; +% my ($c)= qw(40 00)[$_[0]]; +% return " | |||||||||||||||||||||||||||||||||||||||||||||||||||
"; +% }; +% % foreach my $i (0..$#islandids) { - | |||||||||||||||||||||||||||||||||||||||||||||||||||
% $iquery->execute($islandids[$i]); % my ($islandname) = $iquery->fetchrow_array(); @@ -744,7 +664,6 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw( #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'}; @@ -819,12 +738,12 @@ $addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw( (Data age: <% prettyprint_age($age) %>) % } elsif (!defined $total) { % $total= 0; - | |||||||||||||||||||||||||||||||||||||||||||||||||||
Total distance: <% $total_dist %> leagues. | Overall net cash flow | <%
@@ -886,6 +805,171 @@ Expected average profit:
%
% } # ========== TRADING PLAN ==========
+% if (!printable($m)) {
+Data age summary+<%perl> + my $sth_i= $dbh->prepare(<+&> +% } + +% if (!printable($m)) { +% my %ts_sortkeys; +% { +% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; +% my $cdstall= $qa->{ShowStalls} ? ' Stall | ' : '';
+Relevant trades+
+ + +% } # !printable + <%init> use CommodsWeb; use Commods; |