X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=831a1b1a26a2d46f051ec4265f8089cb13fbf7da;hb=27941f861802c5de63b470bf87bd60c1a077bc3a;hp=6bc7277d341a69049358dbb40176700657674187;hpb=f41b94c1ec31bbff084b7429c1aec495aca2ab1e;p=ypp-sc-tools.db-test.git diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 6bc7277..831a1b1 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -38,11 +38,28 @@ $dbh @islandids @archipelagoes $qa +$max_mass +$max_volume +$lossperleaguepct %args> +<&| script &> + da_pageload= Date.now(); +&script> + +% if (defined $max_mass || defined $max_volume) { +WARNING - VESSEL CAPACITY LIMIT NOT YET IMPLEMENTED +
+% } + <%perl> +my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7; + +my $now= time; + my @flow_conds; my @query_params; +my %dists; my $sd_condition= sub { my ($bs, $ix) = @_; @@ -78,10 +95,12 @@ foreach my $src_i (0..$#islandids) { if ($specific && !$confusing && # With a circular route, do not carry goods round the loop - !($src_i==0 && $dst_i==$#islandids && + !(($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 ]; @@ -98,56 +117,82 @@ my $stmt= " SELECT sell_islands.islandname org_name, sell_islands.islandid org_id, sell.price org_price, + sell.qty org_qty_stall, + sell_stalls.stallname org_stallname, + sell.stallid org_stallid, + sell_uploads.timestamp org_timestamp, buy_islands.islandname dst_name, buy_islands.islandid dst_id, buy.price dst_price, -".($qa->{ShowStalls} ? " - sell.stallid org_stallid, - sell_stalls.stallname org_stallname, - sell.qty org_qty, - buy.stallid dst_stallid, + buy.qty dst_qty_stall, buy_stalls.stallname dst_stallname, - buy.qty dst_qty, + buy.stallid dst_stallid, + buy_uploads.timestamp dst_timestamp, +".($qa->{ShowStalls} ? " + sell.qty org_qty_agg, + buy.qty dst_qty_agg, " : " - sum(sell.qty) org_qty, - sum(buy.qty) dst_qty, + (SELECT sum(qty) FROM sell AS sell_agg + WHERE sell_agg.commodid = commods.commodid + AND sell_agg.islandid = sell.islandid + AND sell_agg.price = sell.price) org_qty_agg, + (SELECT sum(qty) FROM buy AS buy_agg + WHERE buy_agg.commodid = commods.commodid + AND buy_agg.islandid = buy.islandid + AND buy_agg.price = buy.price) dst_qty_agg, ")." commods.commodname commodname, commods.commodid commodid, commods.unitmass unitmass, commods.unitvolume unitvolume, + dist dist, buy.price - sell.price unitprofit FROM commods - JOIN buy on commods.commodid = buy.commodid - JOIN sell on commods.commodid = sell.commodid - JOIN islands as sell_islands on sell.islandid = sell_islands.islandid - JOIN islands as buy_islands on buy.islandid = buy_islands.islandid -".($qa->{ShowStalls} ? " - JOIN stalls as sell_stalls on sell.stallid = sell_stalls.stallid - JOIN stalls as buy_stalls on buy.stallid = buy_stalls.stallid -" : "")." + JOIN sell ON commods.commodid = sell.commodid + JOIN buy ON commods.commodid = buy.commodid + JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid + JOIN islands AS buy_islands ON buy.islandid = buy_islands.islandid + JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid + JOIN uploads AS buy_uploads ON buy.islandid = buy_uploads.islandid + JOIN stalls AS sell_stalls ON sell.stallid = sell_stalls.stallid + JOIN stalls AS buy_stalls ON buy.stallid = buy_stalls.stallid + JOIN dists ON aiid = sell.islandid AND biid = buy.islandid WHERE ( ".join(" OR ", @flow_conds)." ) AND buy.price > sell.price -".($qa->{ShowStalls} ? "" : " - GROUP BY commods.commodid, org_id, org_price, dst_id, dst_price -")." ORDER BY org_name, dst_name, commodname, unitprofit DESC, - org_price, dst_price DESC + org_price, dst_price DESC, + org_stallname, dst_stallname "; my $sth= $dbh->prepare($stmt); $sth->execute(@query_params); my @flows; -my @cols; +my $distquery= $dbh->prepare(" + SELECT dist FROM dists WHERE aiid = ? AND biid = ? + "); +my $distance= sub { + my ($from,$to)= @_; + my $d= $dists{$from}{$to}; + return $d if defined $d; + $distquery->execute($from,$to); + $d = $distquery->fetchrow_array(); + defined $d or die "$from $to ?"; + $dists{$from}{$to}= $d; + return $d; +}; + +my @cols= ({ NoSort => 1 }); my $addcols= sub { my $base= shift @_; foreach my $name (@_) { - push @cols, { Name => $name, %$base }; + my $col= { Name => $name, %$base }; + $col->{Numeric}=1 if !$col->{Text}; + push @cols, $col; } }; @@ -162,11 +207,19 @@ if ($qa->{ShowStalls}) { )); } $addcols->({ Text => 1 }, qw(commodname)); -$addcols->({}, - qw( org_qty org_price dst_qty dst_price - Margin unitprofit MaxQty - MaxCapital MaxProfit +$addcols->({ DoReverse => 1 }, + qw( org_price org_qty_agg dst_price dst_qty_agg + )); +$addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' }, + qw( Margin )); +$addcols->({ DoReverse => 1 }, + qw( unitprofit MaxQty MaxCapital MaxProfit dist + )); +foreach my $v (qw(MaxMass MaxVolume)) { + $addcols->({ + DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v); +} %perl> @@ -179,23 +232,71 @@ $addcols->({}, <& dumptable:start, qa => $qa, sth => $sth &> % { -% my $f; -% while ($f= $sth->fetchrow_hashref()) { +% my $got; +% while ($got= $sth->fetchrow_hashref()) { +<%perl> + + my $f= $flows[$#flows]; + if ( !$f || + $qa->{ShowStalls} || + grep { $f->{$_} ne $got->{$_} } + qw(org_id org_price dst_id dst_price commodid) + ) { + # Make a new flow rather than adding to the existing one + + $f= { + Ix => scalar(@flows), + Var => "f".@flows, + %$got + }; + $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all' + if !$qa->{ShowStalls}; + push @flows, $f; + } + foreach my $od (qw(org dst)) { + $f->{"${od}Stalls"}{ + $got->{"${od}_stallname"} + } = + $got->{"${od}_qty_stall"} + ; + } + +%perl> +<& dumptable:row, qa => $qa, sth => $sth, row => $f &> +% } +<& dumptable:end, qa => $qa &> +% } + <%perl> - $f->{Ix}= @flows; - $f->{Var}= "f$f->{Ix}"; +if (!@flows) { + print 'No profitable trading opportunities were found.'; + return; +} + +foreach my $f (@flows) { - $f->{MaxQty}= $f->{'org_qty'} < $f->{'dst_qty'} - ? $f->{'org_qty'} : $f->{'dst_qty'}; + $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'} + ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'}; $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'}; $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'}; + $f->{MaxMassSortKey}= $f->{MaxQty} * $f->{'unitmass'}; + $f->{MaxVolumeSortKey}= $f->{MaxQty} * $f->{'unitvolume'}; + foreach my $v (qw(Mass Volume)) { + $f->{"Max$v"}= sprintf "%.1f", $f->{"Max${v}SortKey"} * 1e-6; + } + + $f->{MarginSortKey}= sprintf "%d", + $f->{'dst_price'} * 10000 / $f->{'org_price'}; $f->{Margin}= sprintf "%3.1f%%", $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0; - $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all' - if !$qa->{ShowStalls}; + $f->{ExpectedUnitProfit}= + $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'} + - $f->{'org_price'}; + + $dists{'org_id'}{'dst_id'}= $f->{'dist'}; my @uid= $f->{commodid}; foreach my $od (qw(org dst)) { @@ -260,24 +361,20 @@ die "$cmpu $uue ?" if length $cmpu > 20; die "$f->{UidLong} = $f->{UidShort} = $recons_long ?"; } - if ($qa->{"R$f->{UidShort}"} && !$qa->{"T$f->{UidShort}"}) { + if (defined $qa->{"R$f->{UidShort}"} && + !defined $qa->{"T$f->{UidShort}"}) { $f->{Suppress}= 1; } - push @flows, $f; - +} %perl> -<& dumptable:row, qa => $qa, sth => $sth, row => $f &> -% } -<& dumptable:end, qa => $qa &> -% } % my $optimise= $specific && !$confusing && @islandids>1; % if (!$optimise) {
% if (@islandids<=1) { -Route is trivial. +Route contains only one location. % } % if (!$specific) { Route contains archipelago(es), not just specific islands. @@ -286,7 +383,7 @@ Route contains archipelago(es), not just specific islands. Route is complex - it visits the same island several times and isn't a simple loop. % } -Therefore, optimal trade pattern not calculated. +Therefore, optimal voyage trade plan not calculated. % } else { # ========== OPTMISATION ========== <%perl> @@ -295,8 +392,10 @@ my $cplex= " Maximize totalprofit: - ".(join " + - ", map { "$_->{unitprofit} $_->{Var}" } @flows)." + ".(join " + ", map { + sprintf "%+.20f %s", $_->{ExpectedUnitProfit}, $_->{Var} + } @flows)." Subject To "; @@ -320,7 +419,7 @@ foreach my $flow (@flows) { ); push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var}; - $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty"}; + $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"}; } } foreach my $cstname (sort keys %avail_csts) { @@ -354,7 +453,9 @@ if ($qa->{'debug'}) { qw(glpsol --cpxlp /dev/stdin -o /dev/stdout)); print "
\n" if $qa->{'debug'}; my $found_section= 0; + my $glpsol_out= ''; while (<$output>) { + $glpsol_out.= $_; print encode_entities($_) if $qa->{'debug'}; if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) { die if $found_section>0; @@ -375,14 +476,22 @@ if ($qa->{'debug'}) { $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'}; } print "\n" if $qa->{'debug'}; - pipethrough_run_finish($output, 'glpsol'); - die unless $found_section; + my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n "; + pipethrough_run_finish($output,$prerr); + die $prerr unless $found_section; }; -$addcols->({}, qw( +$addcols->({ DoReverse => 1, Special => sub { + my ($flow,$col,$v,$spec) = @_; + if ($flow->{ExpectedUnitProfit} < 0) { + $spec->{Span}= 3; + $spec->{String}= '(Small margin)'; + $spec->{Align}= 'align=center'; + } +} }, qw( OptQty )); -$addcols->({ Total => 0 }, qw( +$addcols->({ Total => 0, DoReverse => 1 }, qw( OptCapital OptProfit )); @@ -390,10 +499,11 @@ $addcols->({ Total => 0 }, qw( % } # ========== OPTIMISATION ========== +% my %ts_sortkeys; % { % my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : ''; % my $cdstall= $qa->{ShowStalls} ? '
>Collect | >Deliver @@ -414,8 +525,10 @@ $addcols->({ Total => 0 }, qw( | Deliver | Profit | Max + | + | Max % if ($optimise) { - | Suggested + | Planned % } | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Island <% $cdstall %> | Island <% $cdstall %> | Commodity - | Qty | Price | Qty | Price + | Qty | Margin | Unit | Qty | Capital | Profit + | Dist + | Mass + | Vol % if ($optimise) { | Qty | Capital @@ -439,23 +555,43 @@ $addcols->({ Total => 0 }, qw( % } % } -% foreach my $flow (@flows) { - | |
+% } + +% foreach my $flowix (0..$#flows) { +% my $flow= $flows[$flowix]; +% my $rowid= "id_row_$flow->{UidShort}"; + | ||||||||||||||||||
{UidShort} %> value=""> {UidShort} %> value="" <% $flow->{Suppress} ? '' : 'checked' %> > -% foreach my $ci (0..$#cols) { +% my $ci= 1; +% while ($ci < @cols) { % my $col= $cols[$ci]; +% my $spec= { +% Span => 1, +% Align => ($col->{Text} ? '' : 'align=right') +% }; % my $v= $flow->{$col->{Name}}; -% $col->{Total} += $v if defined $col->{Total}; +% if ($col->{Special}) { $col->{Special}($flow,$col,$v,$spec); } +% $col->{Total} += $v +% if defined $col->{Total} and not $flow->{Suppress}; % $v='' if !$col->{Text} && !$v; - | {Text} ? '' : 'align=right' %>><% $v |h %> +% my $sortkey= $col->{SortColKey} ? +% $flow->{$col->{SortColKey}} : $v; +% $ts_sortkeys{$ci}{$rowid}= $sortkey; + | {Span} ? "colspan=$spec->{Span}" : '' + %> <% $spec->{Align} + %>><% exists $spec->{String} ? $spec->{String} : $v |h %> +% $ci += $spec->{Span}; % } % } - | ||||||||||||||||
Total -% foreach my $ci (2..$#cols) { +% foreach my $ci (3..$#cols) { % my $col= $cols[$ci]; | % if (defined $col->{Total}) { @@ -464,40 +600,149 @@ $addcols->({ Total => 0 }, qw( % } |
+
+
% $iquery->execute($islandids[$i]);
% my ($islandname) = $iquery->fetchrow_array();
% if (!$i) {
-Start at <% $islandname |h %>
+Start at <% $islandname |h %>
% } else {
-Sail to <% $islandname |h %>
+% my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
+% $total_dist += $this_dist;
+Sail to <% $islandname |h %>
+- <% $this_dist |h %> leagues |
% }
-
-% foreach my $od (qw(dst org)) {
-% my $sign= $od eq 'dst' ? -1 : +1;
-% foreach my $f (sort {
-% $a->{'commodname'} cmp $b->{'commodname'}
-% or $sign * ($a->{"${od}_price"} <=> $b->{"${od}_price"})
-% or $a->{"${od}_stallname"} cmp $b->{"${od}_stallname"}
-% } @flows) {
-% next if $f->{Suppress};
-% next unless $f->{"${od}_id"} == $islandids[$i];
-% next unless $f->{OptQty};
-\
+(Data age: <% prettyprint_age($age) %>)
+% } elsif (!defined $total) {
+% $total= 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) {
+ |
+ | <% $totaldesc %>
+ | <% $total |h %> total
+% $total_total += $sign * $total;
+% }
+% $total= undef;
+% $dline= 0;
+<%perl>
+ };
+
+ $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
+ $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
+ $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
+ $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
+
+}
+%perl>
+ | Total distance: <% $total_dist %> leagues.
+ | Overall net cash flow
+ | <%
+ $total_total < 0 ? -$total_total." loss" : $total_total." gain"
+ %>
| |