From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sun, 22 Nov 2009 13:13:45 +0000 (+0000)
Subject: Minimum trade value feature
X-Git-Tag: 6.2~9
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-test.git;a=commitdiff_plain;h=43454422b2df5e0dcfe144fcb871a2b6f9c1a3d0

Minimum trade value feature
---

diff --git a/yarrg/TODO b/yarrg/TODO
index e8edb94..3dd23be 100644
--- a/yarrg/TODO
+++ b/yarrg/TODO
@@ -13,8 +13,6 @@ support Opal and Jade (currently there are some unicode problems)
 WEBSITE
 -------
 
-allow unticking based on minimum margin or minimum profit
-
 initial/final stocks feature
 
 query_routesearch should show capital for each voyage
diff --git a/yarrg/web/check_capitalstring b/yarrg/web/check_poe
similarity index 85%
rename from yarrg/web/check_capitalstring
rename to yarrg/web/check_poe
index 24617d7..46f23d1 100644
--- a/yarrg/web/check_capitalstring
+++ b/yarrg/web/check_poe
@@ -29,7 +29,7 @@
  sponsored by Three Rings.
 
 
- This Mason component simply defines how to interpret capital.
+ This Mason component simply defines how to interpret amounts of poe.
 
 </%doc>
 
@@ -44,19 +44,19 @@ $debugf
 $_= $string;
 s/^\s+//; s/\s+$//;
 
-my $capital;
+my $poe;
 my $canon;
 
 if (!m/\S/) {
 	$canon= '';
-} elsif (m/^([1-9]\d*)( PoE)?$/i) {
-	$capital= $1;
-	$canon= "$capital PoE";
+} elsif (m/^([1-9]\d*|0)( PoE)?$/i) {
+	$poe= $1;
+	$canon= "$poe PoE";
 } else {
-	expected_error("Cannot understand capital ".escerrq($_).".");
+	expected_error("Cannot understand poe amount ".escerrq($_).".");
 }
 
-return ($canon,$capital);
+return ($canon,$poe);
 
 </%perl>
 </%method>
diff --git a/yarrg/web/docs b/yarrg/web/docs
index 2be018e..10caaee 100755
--- a/yarrg/web/docs
+++ b/yarrg/web/docs
@@ -178,6 +178,37 @@ You can enter the value in the box either as a percentage, or as a
 fraction 1/<em>divisor</em>, eg 1/2000 is the same as 0.05%; in each
 case it is taken as the loss for each league of the voyage.
 
+<h3><a name="minprofit">Minimum trade value</a></h3>
+
+Often there are many low-volume, low-value trades.  It can be rather
+labour-intensive to buy and sell a dozen different commodities, half
+of which are only making a few poe each.
+
+<p>
+
+The "minimum trade value" specifies a minimum profit that you would
+like to get from each (commodity, collect island, deliver island)
+triplet.  Trades which don't meet this minimum will start out unticked in
+the "Relevant trades" table and will not be included in the voyage
+trading plan.
+
+<p>
+
+If you want to change your threshold, you have to select "Apply",
+which will automatically tick and untick all of the tickboxes for in
+"Relevant trades", as appropriate.  This will undo any customisation
+of the set of trades you have already done by manually ticking and
+unticking individual trades.
+
+<p>
+
+The value is an absolute poe amount, typically 5 or 10, representing
+the minimum profit to make it worthwhile (from a time and effort point
+of view) clicking in the YPP client to collect and deliver a
+commodity.  Setting a higher threshold will make each island visit
+faster, by excluding trivial transactions, and so reduce the chance
+that market conditions change adversely during your voyage.
+
 <h3><a name="poelimit">Caution about stalls' poe reserves</a></h3>
 
 If you select <b>Also be cautious about stalls' poe reserves</b>,
diff --git a/yarrg/web/enter_advrouteopts b/yarrg/web/enter_advrouteopts
index 95a7143..a4bdf2f 100644
--- a/yarrg/web/enter_advrouteopts
+++ b/yarrg/web/enter_advrouteopts
@@ -40,6 +40,7 @@
 	$routeparams->{MaxMass}
 	$routeparams->{MaxVolume}
 	$routeparams->{MaxCapital}
+	$routeparams->{MinProfit}
 
 
 </%doc>
@@ -47,6 +48,7 @@
 $qa
 $dbh
 $routeparams
+$minprofit_needs_apply => 0
 </%args>
 
 <%method advanced>
@@ -61,14 +63,29 @@ $routeparams
 <table><tr><td>
 
 Vessel or capacity:
-<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
+<& qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
     thingstring => 'capacitystring', emsgstore => $routeparams->{EmsgRef},
-    helpref => 'capacity',
+    helpref => 'capacity', boxopts => 'size=30',
     onresults => sub {
 	($routeparams->{MaxMass}, $routeparams->{MaxVolume}) = @_;
     }
  &>
- size=40
+
+<td>
+&nbsp;
+&nbsp;
+
+<td>Minimum trade value:
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'mt', checkkind => 'poe',
+    thingstring => 'minprofitstring', emsgstore => $routeparams->{EmsgRef},
+    helpref => 'minprofit', boxopts => 'size=9',
+    onresults => sub {
+	($routeparams->{MinProfit}) = @_;
+    }
+ &>
+% if ($minprofit_needs_apply) {
+<input type=submit name="apply_minprofit" value="Apply">
+% }
 </&>
 
 </table>
@@ -79,13 +96,11 @@ Vessel or capacity:
 
 <td>Available capital:
 
-<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ac',
+<& qtextstring, qa => $qa, dbh => $dbh, prefix => 'ac', checkkind => 'poe',
     thingstring => 'capitalstring', emsgstore => $routeparams->{EmsgRef},
-    helpref => 'capital',
+    helpref => 'capital', boxopts => 'size=9',
     onresults => sub { ($routeparams->{MaxCapital})= @_; }
  &>
- size=9
-</&>
 
 <td>
 &nbsp;
@@ -94,13 +109,11 @@ Vessel or capacity:
 <td>
 Expected losses:
 
-<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll',
+<& qtextstring, qa => $qa, dbh => $dbh, prefix => 'll',
     thingstring => 'lossperleague', emsgstore => $routeparams->{EmsgRef},
-    helpref => 'losses',
+    helpref => 'losses', boxopts => 'size=9',
     onresults => sub { ($routeparams->{LossPerLeaguePct})= @_; }
  &>
- size=9
-</&>
 
 <% $m->content %>
 
diff --git a/yarrg/web/enter_commod b/yarrg/web/enter_commod
index c3f5553..70310bc 100644
--- a/yarrg/web/enter_commod
+++ b/yarrg/web/enter_commod
@@ -47,12 +47,10 @@ $cmid_r
 
 Enter commodity (abbreviations are OK):<br>
 
-<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
-    thingstring => 'commodstring', prefix => 'cm',
+<& qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
+    thingstring => 'commodstring', prefix => 'cm', boxopts => 'size=80',
     onresults => sub { ($$commodname_r,$$cmid_r)= @{ $_[0] } if @_ }
  &>
- size=80
-</&>
 
 % } else { #---------- dropdowns, user selects from menus ----------
 
diff --git a/yarrg/web/enter_route b/yarrg/web/enter_route
index fbdf2dc..6d2c9fd 100644
--- a/yarrg/web/enter_route
+++ b/yarrg/web/enter_route
@@ -56,9 +56,9 @@ $archipelagoes_r
 % }
 separated by |s or commas; abbreviations are OK):<br>
 
-<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
+<& qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
     thingstring => defined($archipelagoes_r) ? 'routestring' : 'islandstring',
-    prefix => 'rl',
+    prefix => 'rl', boxopts => 'size=80',
     onresults => sub {
 	foreach (@_) {
 	my ($canonname, $island, $arch) = @$_;
@@ -68,8 +68,6 @@ separated by |s or commas; abbreviations are OK):<br>
 	}
     }
  &>
- size=80
-</&>
 
 % } else { #---------- dropdowns, user selects from menus ----------
 
diff --git a/yarrg/web/lookup b/yarrg/web/lookup
index fd66f1a..b99cf0a 100755
--- a/yarrg/web/lookup
+++ b/yarrg/web/lookup
@@ -165,7 +165,8 @@ foreach my $var (@vars) {
 
 foreach my $var (keys %ARGS) {
 	next unless $var =~
-		m/^(?: (?:route|commod|capacity|capital|island)string |
+		m/^(?: (?:route|commod|capacity|capital|minprofit
+			 |island)string |
 			lossperleague | distance |
 			commodid |
 			islandid \d |
diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring
index e046c56..ebf344d 100644
--- a/yarrg/web/qtextstring
+++ b/yarrg/web/qtextstring
@@ -39,24 +39,27 @@
 $qa => $m->caller_args(1)->{'qa'}
 $dbh
 $thingstring
+$checkkind => undef
 $emsgstore
 $onresults
-$prefix => 'ts';
-$helpref => undef;
+$boxopts => 'size=10'
+$prefix => 'ts'
+$helpref => undef
 </%args>
 <%perl>
 my $stringval= $qa->{$thingstring};
 $stringval='' if !defined $stringval;
+$checkkind= $thingstring if !defined $checkkind;
 
 my $p= $prefix.'_';
-my $checker= $m->fetch_comp("check_${thingstring}");
+my $checker= $m->fetch_comp("check_${checkkind}");
 my $significant_nonempty= $checker->attr_exists('significant_nonempty');
 
 </%perl>
 
 <&| script &>
 <%$p%>uri= "qtextstringcheck?format=application/json&ctype=text/xml"
-		+ "&what=<% $thingstring %>"
+		+ "&what=<% $checkkind %>"
 		+ "&ocean=<% uri_escape($qa->{Ocean}) %>";
 
 <%$p%>timeout=false;
@@ -98,11 +101,12 @@ register_onload(<%$p%>Needed);
 </&script>
 
 % if (!printable($m)) {
-<input type="text" <% $m->content %>
+<input type="text" <% $boxopts %>
  id="<% $thingstring %>" name="<% $thingstring %>"
  onchange="<%$p%>Needed();" onkeyup="<%$p%>Later();"
  value="<% $stringval |h %>"
- ><% defined($helpref) ? "<a href=\"docs#$helpref\">[?]</a>" : '' %>
+ ><% defined($helpref) ? "<a href=\"docs#$helpref\">[?]</a>" : '' %><%
+     $m->content %>
 <br>
 <div id="<%$p%>results">&nbsp;</div><br>
 % } else {
@@ -114,7 +118,7 @@ register_onload(<%$p%>Needed);
 <%perl>
 if ($significant_nonempty || length $thingstring) {
 	my ($emsg,$canonstring,@results)= $m->comp('qtextstringcheck',
-		what => $thingstring,
+		what => $checkkind,
 		ocean => $qa->{Ocean},
 		string => $stringval,
 		format => 'return'
diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck
index 0a75f8e..539abce 100755
--- a/yarrg/web/qtextstringcheck
+++ b/yarrg/web/qtextstringcheck
@@ -60,6 +60,7 @@ use Scalar::Util qw(blessed);
 
 die if $what =~ m/[^a-z]/;
 my $chk= $m->fetch_comp("check_${what}");
+die "check_$what" unless $chk;
 
 my $mydbh;
 $dbh ||= ($mydbh= dbw_connect($ocean));
diff --git a/yarrg/web/query_route b/yarrg/web/query_route
index a4e9a06..3c769a9 100644
--- a/yarrg/web/query_route
+++ b/yarrg/web/query_route
@@ -41,8 +41,10 @@ $routestring => '';
 $capacitystring => '';
 $lossperleague => '';
 $capitalstring => '';
+$minprofitstring => '';
 $someresults
 $emsgokorprint
+$allargs
 </%args>
 
 <%perl>
@@ -92,13 +94,17 @@ my $goupdate= sub { $be_post ? 'Update' : 'Go' };
 % my $routeparams= { EmsgRef => \$emsg };
 % if (!$qa->{Dropdowns}) {
 
-<& enter_advrouteopts, qa=>$qa, dbh=>$dbh, routeparams=>$routeparams &>
+<input type=submit name=submit value="<% $goupdate->() %>">
+<p>
+
+<& enter_advrouteopts, qa=>$qa, dbh=>$dbh,
+   minprofit_needs_apply => $be_post,
+   routeparams=>$routeparams &>
 
 % } #---------- end of dropdowns, now common middle of page code ----------
 
-<input type=submit name=submit value="<% $goupdate->() %>">
 % my $ours= sub { $_[0] =~
-%  m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^capitalstring|^[RT]/;
+%  m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^capitalstring|^minprofitstring|^[RT]/;
 % };
 <& "lookup:formhidden", ours => $ours &>
 
@@ -123,7 +129,8 @@ foreach my $warningf (@warningfs) {
    islandids => \@islandids,
    archipelagoes => \@archipelagoes,
    qa => $qa,
-   routeparams => $routeparams
+   routeparams => $routeparams,
+   reset_suppressions => !!$allargs->{'apply_minprofit'}
  &>
 % }
 </div>
diff --git a/yarrg/web/query_routesearch b/yarrg/web/query_routesearch
index 357ba94..3f65fc3 100644
--- a/yarrg/web/query_routesearch
+++ b/yarrg/web/query_routesearch
@@ -42,6 +42,7 @@ $islandstring => '';
 $capacitystring => '';
 $lossperleague => '';
 $capitalstring => '';
+$minprofitstring => '';
 $distance => '';
 $prselector
 $someresults
@@ -89,15 +90,14 @@ This feature is not available from the "drop down menus" interface.
 &nbsp;
 <td>
  Maximum distance:
- <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
-    thingstring => 'distance', emsgstore => \$emsg,
-    onresults => sub { ($maxdist)= @_; } &>
-   size=10
- </&>
+ <& qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
+    thingstring => 'distance', emsgstore => \$emsg, boxopts => 'size=10',
+    onresults => sub { ($maxdist)= @_; }
+   &>
 </&>
 
 <input type=submit name=submit value="Search">
-% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^capitalstring|^capacitystring|^distance/; };
+% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^capitalstring|^capacitystring|^minprofitstring|^distance/; };
 <& "lookup:formhidden", ours => $ours &>
 
 % }
@@ -147,7 +147,7 @@ foreach my $k (qw(MaxMass MaxVolume MaxCapital)) {
 }
 push @rsargs, defined $routeparams->{LossPerLeaguePct}
 	? $routeparams->{LossPerLeaguePct}*0.01 : 1e-9;
-push @rsargs, '0';
+push @rsargs, 0; #$routeparams->{MinProfit};
 push @rsargs, 'search',$maxdist, $maxcountea,$maxcountea;
 push @rsargs, $ARGS{RouteSearchType} ? 'circ' : 'any';
 push @rsargs, @islandids;
diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 9660094..9cd5712 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -39,6 +39,7 @@ $dbh
 @archipelagoes
 $qa
 $routeparams
+$reset_suppressions
 </%args>
 <& 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;
@@ -275,13 +278,19 @@ 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);
+};
+
 foreach my $f (@flows) {
 
 	$f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
@@ -306,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,
@@ -368,11 +379,20 @@ foreach my $f (@flows) {
 		$f->{UidLong} eq $recons_long or
 			die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 	}
+}
+
+foreach my $f (@flows) {
 
-	if (defined $qa->{"R$f->{UidShort}"} &&
-	    !defined $qa->{"T$f->{UidShort}"}) {
-		$f->{Suppress}= 1;
+	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= {