UPLOADER
--------
+ sometimes fails to work on Sage - sunshine widget resets or something
+
detect all unexpected mouse movements
more flexible installation arrangements
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict (qw(vars));
+
+use CommodsDatabase;
+
+my $ocean= shift @ARGV;
+
+db_setocean($ocean);
+db_connect();
+my $islands= $dbh->selectall_arrayref('
+ SELECT islandid,islandname FROM islands;
+');
+my $routes= $dbh->selectall_arrayref('
+ SELECT aiid, biid, dist FROM routes;
+');
+$dbh->disconnect();
+
+#use Data::Dumper;
+#print Dumper($results);
+
+print "strict graph $ocean {\n";
+#print " nodesep=10;\n";
+
+foreach my $row (@$islands) {
+ my ($id,$str) = @$row;
+ $str =~ s/[\"\\]/\\$&/g;
+ print " n$id [ label=\"$str\" ];\n";
+}
+foreach my $row (@$routes) {
+ my ($ia,$ib,$dist) = @$row;
+ print " n$ia -- n$ib [ len=2, label=$dist ];\n";
+ #len=$dist, minlen=$dist, weight=".(1.0/$dist).", len=".($dist*0.25+1).",
+ #w=".(1.0/$dist).",
+}
+
+print "}\n";
ocean Hunter
Eagle
Ix Chel
+ Manu Island
ocean Malachite
Draco
--- /dev/null
+<%doc>
+
+ This is part of the YARRG website. YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+ YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+ The YARRG website is covered by the GNU Affero GPL v3 or later, which
+ basically means that every installation of the website will let you
+ download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission. This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component simply defines how to interpret capacities.
+
+</%doc>
+
+<%attr>
+</%attr>
+
+<%method preparse>
+<%args>
+$h
+</%args>
+<%perl>
+
+my $def= sub {
+ my ($what,$val) = @_;
+ if (defined $h->{$what}) {
+ $h->{Emsg}= "Multiple definitions of maximum $what.";
+ }
+ print STDERR "SET $what $val\n";
+ $h->{$what}= $val;
+};
+
+foreach $_ (split /\s+/, ${ $h->{String} }) {
+ print STDERR "ITEM \`$_'\n";
+ next unless length;
+ if (m/^([1-9]\d{0,8})l$/) {
+ $def->('volume', $1);
+ } elsif (m/^([1-9]\d{0,8})kg$/) {
+ $def->('mass', $1);
+ } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) {
+ $def->('volume', $1 * 1000);
+ } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) {
+ $def->('mass', $1 * 1000);
+ } else {
+ ${ $h->{Emsg} }= "Cannot understand capacity \`$_'.";
+ last;
+ }
+}
+</%perl>
+</%method>
+
+<%method postquery>
+<%args>
+$h
+</%args>
+<%perl>
+
+if (defined $h->{'mass'} or defined $h->{'volume'}) {
+ @{ $h->{Results} } = [ $h->{'mass'}, $h->{'volume'} ];
+
+ ${ $h->{Canon} }=
+ 'mass limit: '.(defined $h->{'mass'} ? $h->{'mass'} .'kg' : 'none').'; '.
+ 'volume limit: '.(defined $h->{'volume'} ? $h->{'volume'} .'l' : 'none').'.';
+}
+
+</%perl>
+</%method>
--- /dev/null
+<%doc>
+
+ This is part of the YARRG website. YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+ YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+ The YARRG website is covered by the GNU Affero GPL v3 or later, which
+ basically means that every installation of the website will let you
+ download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission. This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component simply defines how to interpret capacities.
+
+</%doc>
+
+<%attr>
+</%attr>
+
+<%method preparse>
+<%args>
+$h
+</%args>
+<%perl>
+
+$_= ${ $h->{String} };
+s/^\s+//; s/\s+$//;
+
+my $res= sub {
+ my ($pct,$str) = @_;
+ push @{ $h->{Results} }, [ $pct ];
+ ${ $h->{Canon} }= "$str per league";
+};
+
+if (!m/\S/) {
+} elsif (m/^(\d{1,2}(?:\.\d{0,5})?)\%$/) {
+ $res->( $1 * 1.0, sprintf("%g%%", $1) );
+} elsif (m/^1\s*\/\s*([1-9]\d{0,4})/) {
+ $res->( 100.0/$1, sprintf("1/%d", $1) );
+} else {
+ ${ $h->{Emsg} }= "Cannot understand loss per league \`$_'.";
+ return;
+}
+
+</%perl>
+</%method>
</%doc>
-<html><head><title>YARRG (Yet Another Revenue Research Gatherer)</title>
+<html><head><title>Website documentation - YARRG</title>
</head><body>
-<h1>Introduction to YARRG</h1>
+<a href="lookup">YARRG</a> -
+ Yet Another Revenue Research Gatherer
+|
+<a href="intro">introduction</a>
+|
+<b>documentation</b>
+
+<h1>Looking up data in YARRG</h1>
YARRG (Yet Another Revenue Research Gatherer) is a third-party tool
for helping find profitable trades and trade routes in Yohoho Puzzle
-Pirates. It was inspired by
-<a href="http://pctb.crabdance.com/">PCTB</a>.
+Pirates. See the <a href="intro">Introduction</a> for more details.
<p>
-The system has two main parts: this website which maintains a
-searchable database of commodity prices, and an upload client, which
-screenscrapes the commodity data from the Puzzle Pirates game client
-and uploads it to the database.
+The <a href="lookup">Market prices database</a> is the main output
+from YARRG. It offers a variety of enquiry options.
-<h2><a href="lookup">Market prices database</a></h2>
+<p>
-The <a href="lookup">lookup page</a> gives access to the uploaded data.
+This website documentation page contains information about the
+database website which you may not be able to divine from the online
+user interface.
-<h2>Uploading from Linux</h2>
+<h2>Bookmarkable URLs</h2>
-The YARRG upload client uploads both to YARRG and to the
-<a href="pctb.ilk.org">PCTB testing server</a>.
+Mostly, you can bookmark the specific pages and queries. Select the
+ocean, query page, and other combinations of options, as you wish, and
+perhaps fill in the actual data fields too, and bookmark the resulting
+URL.
<p>
-The current official version of YARRG for use as an upload
-client can browsed here:
- <a href="/~ijackson/ypp-sc-tools/master/">http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/</a>
-See particularly the
-<a href="/~ijackson/ypp-sc-tools/master/yarrg/README">YARRG README</a>.
+(An exception to this is if you select the `Update' option from the
+`Trades for route' lookup; the list of (de)selected stalls is too long
+to fit in a URL.)
+
+<h2>Dynamic confirmation of meaning of text entry boxes</h2>
+
+If you have Javascript enabled, the various text entry boxes will be
+annotated with a brief explanation of the system's interpretation of
+your current entry string. To get the actual results updated, you
+must still hit `Go' or `Update'.
+
+<h2>Trades for route</h2>
+
+Given a list of islands (or archipelagoes), provides a list of
+potentially profitable trades. If the route is suitable for the trade
+route optimiser, it will generate a complete voyage plan, telling you
+which goods to buy and sell where at which stalls and prices.
<p>
-To install the client, install the `git' version control system
-and the other dependencies listed in the `Installation requirements'
-section of the README and then run:
-<pre>
-git-clone http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/.git ypp-sc-tools
-cd ypp-sc-tools
-cd yarrg
-make
-</pre>
-this will download the code into the directory <code>ypp-sc-tools</code>,
-and build the software.
+
+If you specify only one island or one archipelago, the site shows only
+arbitrage trades. If you want single-hop trades within an
+archipelago, you must enter the archipelago name twice.
<p>
-When new versions of the upload client are released, you can:
-<pre>
-cd .../ypp-sc-tools
-git-pull
-cd yarrg
-make
-</pre>
-to fetch the new version.
+After getting the results, you can untick various trades individually,
+and select `Update' to get a new plan. The unticked trades will be
+excluded from the voyage plan (if any) and also from the totals.
-<h2>Uploading from Windows</h2>
+<h3>Vessel capacity</h3>
-There is not currently an upload client for Windows which feeds data
-into YARRG. It would probably be straightforward to modify the
-Windows PCTB v5 upload client to upload to YARRG as well. The
-mechanism and format for uploading is documented in
-<a href="/~ijackson/ypp-sc-tools/master/yarrg/README.devel">README.devel</a>.
+If you don't specify a vessel or a vessel capacity, the trading plan
+will not take into account the fact that your voyage will be on a ship
+with a limited size. This will probably result in a plan
+which trades excessively cumbersome goods (eg. hemp, wood, iron).
-<h1>YARRG development, contribution and troubleshooting</h1>
+<p>
-<h2>Free Software (aka Open Source)</h2>
+So you should specify your vessel capacity. Currently you must
+specify the actual mass and volume, as two numbers each with units.
+The system understands the units t (tonnes), kg, l and kl
+(kilolitres). There should be a space between the two limits, and no
+space before the unit.
-YARRG is Free Software - you may share and modify it. See the
-licences for details.
+<h3>Expected losses</h3>
+
+In theory if you were guaranteed to have a trouble-free voyage it
+would be worth trading goods at very low margins. However, in
+practice problems can arise: you may be attacked and lose your stock,
+or market conditions may change between your collection and delivery
+of the goods.
<p>
-Not only the client but also the webserver code is Free. The website
-code can be found in the same tree as above, in the <code>web</code>
-directory.
+We model this by pretending that you expect to lose a fixed proportion
+of your stock each league you sail. This expected loss does not
+appear in the trade tables (although the distance does), but it does
+affect the way the voyage trading plan optimiser chooses which trades
+to do.
<p>
-But in case we have made changes but not yet pushed them
-(perhaps because we haven't done a release), and to make it easy for
-anyone else who runs a copy of the website to provide everyone with
-the source for their version, the website code itself lets you download
-an up-to-date <a href="source.tar.gz">tarball</a> of its
-actually-running source code.
+Trades whose margin is less than the expected loss are never selected.
+For example, if you select 1% loss per league, and plan a voyage of 5
+leagues, then any trade with a margin of less than 5.15% would be
+completely excluded (5.15% not 5% because the loss works like compound
+interest). Theoretically very profitable trades which are close to
+the expected break-even point because of the distance can also be
+rejected by the optimiser in favour of shorter distance trades with
+theoretically smaller margins.
<p>
-If you would like to run a (perhaps modified) copy of the YARRG
-website it would be very easy for us to make our system send you
-copies of updates submitted by users of the official YARRG client, in
-the format expected by the code you'll be running. Please just ask
-us.
+As a guide: you may expect to lose between 0.1% and 1% per league.
+0.1% would correspond, for example, to losing one fight to brigands
+every ten 10-league voyages.
-<h2>Contacting the YARRG developers</h2>
+<p>
-Email Ian Jackson ijackson (at) chiark.greenend.org.uk. Or talk to
-any Fleet Officer or above of the crew Special Circumstances on the
-Midnight Ocean.
+You can enter the value in the box either as a percentage, or as a
+fraction 1/<em>divisor</em>, eg 1/200 is the same as 0.5%; in each
+case it is taken as the loss for each league of the voyage.
-<& footer, isdocs => 1 &>
+<& footer &>
website, according to the terms of the GNU General Public Licence and
the GNU Affero General Public Licence respectively (v3 or later).
% if (!$isdocs) {
-Please see the <a href="docs">YARRG documentation webpage</a> for
+Please see the <a href="intro">YARRG introduction webpage</a> for
details of how to obtain the client and server code and full details
of the licences.
% }
--- /dev/null
+<%doc>
+
+ This is part of the YARRG website. YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+ YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+ The YARRG website is covered by the GNU Affero GPL v3 or later, which
+ basically means that every installation of the website will let you
+ download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission. This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the introduction.
+
+
+</%doc>
+<html><head><title>YARRG (Yet Another Revenue Research Gatherer)</title>
+</head><body>
+
+<a href="lookup">YARRG</a> -
+ Yet Another Revenue Research Gatherer
+|
+<b>introduction</b>
+|
+<a href="docs">documentation</a>
+
+<h1>Introduction to YARRG</h1>
+
+YARRG (Yet Another Revenue Research Gatherer) is a third-party tool
+for helping find profitable trades and trade routes in Yohoho Puzzle
+Pirates. It was inspired by
+<a href="http://pctb.crabdance.com/">PCTB</a>.
+
+<p>
+
+The system has two main parts: this website which maintains a
+searchable database of commodity prices, and an upload client, which
+screenscrapes the commodity data from the Puzzle Pirates game client
+and uploads it to the database.
+
+<h2><a href="lookup">Market prices database</a></h2>
+
+The <a href="lookup">lookup page</a> gives access to the uploaded data;
+there is also <a href="docs">documentation</a> to help with using that
+website.
+
+<h2>Uploading from Linux</h2>
+
+The YARRG upload client uploads both to YARRG and to the
+<a href="pctb.ilk.org">PCTB testing server</a>.
+
+<p>
+
+The current official version of YARRG for use as an upload
+client can browsed here:
+ <a href="/~ijackson/ypp-sc-tools/master/">http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/</a>
+See particularly the
+<a href="/~ijackson/ypp-sc-tools/master/yarrg/README">YARRG README</a>.
+
+<p>
+To install the client, install the `git' version control system
+and the other dependencies listed in the `Installation requirements'
+section of the README and then run:
+<pre>
+git-clone http://www.chiark.greenend.org.uk/~ijackson/ypp-sc-tools/master/.git ypp-sc-tools
+cd ypp-sc-tools
+cd yarrg
+make
+</pre>
+this will download the code into the directory <code>ypp-sc-tools</code>,
+and build the software.
+
+<p>
+
+When new versions of the upload client are released, you can:
+<pre>
+cd .../ypp-sc-tools
+git-pull
+cd yarrg
+make
+</pre>
+to fetch the new version.
+
+<h2>Uploading from Windows</h2>
+
+There is not currently an upload client for Windows which feeds data
+into YARRG. It would probably be straightforward to modify the
+Windows PCTB v5 upload client to upload to YARRG as well. The
+mechanism and format for uploading is documented in
+<a href="/~ijackson/ypp-sc-tools/master/yarrg/README.devel">README.devel</a>.
+
+<h1>YARRG development, contribution and troubleshooting</h1>
+
+<h2>Free Software (aka Open Source)</h2>
+
+YARRG is Free Software - you may share and modify it. See the
+licences for details.
+
+<p>
+
+Not only the client but also the webserver code is Free. The website
+code can be found in the same tree as above, in the <code>web</code>
+directory.
+
+<p>
+
+But in case we have made changes but not yet pushed them
+(perhaps because we haven't done a release), and to make it easy for
+anyone else who runs a copy of the website to provide everyone with
+the source for their version, the website code itself lets you download
+an up-to-date <a href="source.tar.gz">tarball</a> of its
+actually-running source code.
+
+<p>
+
+If you would like to run a (perhaps modified) copy of the YARRG
+website it would be very easy for us to make our system send you
+copies of updates submitted by users of the official YARRG client, in
+the format expected by the code you'll be running. Please just ask
+us.
+
+<h2>Contacting the YARRG developers</h2>
+
+Email Ian Jackson ijackson (at) chiark.greenend.org.uk. Or talk to
+any Fleet Officer or above of the crew Special Circumstances on the
+Midnight Ocean.
+
+<& footer, isdocs => 1 &>
color: #000000;
background: #ffffff;
}
-tr.datarow0 { background: #ffffff; }
-tr.datarow1 { background: #e3e3e3; }
+tr.datarow0 { background: #e3e3e3; }
+tr.datarow1 { background: #ffffff; }
</style>
<&| script &>
function register_onload(f) {
<a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
Yet Another Revenue Research Gatherer
|
+<a href="intro">introduction</a>
+|
<a href="docs">documentation</a>
<p>
<%perl>
foreach my $var (keys %ARGS) {
next unless $var =~
- m/^(?: (?:route|commod)string |
+ m/^(?: (?:route|commod|capacity)string |
+ lossperleague |
commodid |
islandid \d |
archipelago \d |
$thingstring
$emsgstore
$perresult
+$prefix => 'ts';
</%args>
<%perl>
my $stringval= $qa->{$thingstring};
$stringval='' if !defined $stringval;
+
+my $p= $prefix.'_';
</%perl>
<&| script &>
-ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml"
+<%$p%>uri= "qtextstringcheck?format=application/json&ctype=text/xml"
+ "&what=<% $thingstring %>"
+ "&ocean=<% uri_escape($qa->{Ocean}) %>";
-ts_timeout=false;
-ts_request=false;
-ts_done='';
-ts_needed='';
-function ts_Later(){
- window.clearTimeout(ts_timeout);
- ts_timeout = window.setTimeout(ts_Needed, 500);
+<%$p%>timeout=false;
+<%$p%>request=false;
+<%$p%>done='';
+<%$p%>needed='';
+function <%$p%>Later(){
+ window.clearTimeout(<%$p%>timeout);
+ <%$p%>timeout = window.setTimeout(<%$p%>Needed, 500);
}
-function ts_Needed(){
- window.clearTimeout(ts_timeout);
- ts_element= document.getElementById('<% $thingstring %>');
- ts_needed= ts_element.value;
- ts_Request();
+function <%$p%>Needed(){
+ window.clearTimeout(<%$p%>timeout);
+ <%$p%>element= document.getElementById('<% $thingstring %>');
+ <%$p%>needed= <%$p%>element.value;
+ <%$p%>Request();
}
-function ts_Request(){
- if (ts_request || ts_needed==ts_done) return;
- ts_done= ts_needed;
- ts_request= new XMLHttpRequest();
- uri= ts_uri+'&string='+encodeURIComponent(ts_needed);
- ts_request.open('GET', uri);
- ts_request.onreadystatechange= ts_Ready;
- ts_request.send(null);
+function <%$p%>Request(){
+ if (<%$p%>request || <%$p%>needed==<%$p%>done) return;
+ <%$p%>done= <%$p%>needed;
+ <%$p%>request= new XMLHttpRequest();
+ uri= <%$p%>uri+'&string='+encodeURIComponent(<%$p%>needed);
+ <%$p%>request.open('GET', uri);
+ <%$p%>request.onreadystatechange= <%$p%>Ready;
+ <%$p%>request.send(null);
}
-function ts_Ready() {
- if (ts_request.readyState != 4) return;
- if (ts_request.status == 200) {
- response= ts_request.responseText;
- debug('got '+response);
+function <%$p%>Ready() {
+ if (<%$p%>request.readyState != 4) return;
+ if (<%$p%>request.status == 200) {
+ response= <%$p%>request.responseText;
+ debug('<%$p%> got '+response);
eval('results='+response);
- toedit= document.getElementById('ts_results');
+ toedit= document.getElementById('<%$p%>results');
toedit.innerHTML= results.show;
}
- ts_request= false;
- ts_Request();
+ <%$p%>request= false;
+ <%$p%>Request();
}
-register_onload(ts_Needed);
+register_onload(<%$p%>Needed);
</&script>
<input type="text" <% $m->content %>
id="<% $thingstring %>" name="<% $thingstring %>"
- onchange="ts_Needed();" onkeyup="ts_Later();"
+ onchange="<%$p%>Needed();" onkeyup="<%$p%>Later();"
value="<% $stringval |h %>"
>
<br>
-<div id="ts_results"> </div><br>
+<div id="<%$p%>results"> </div><br>
<%perl>
if (length $thingstring) {
string => $stringval,
format => 'return'
);
- $$emsgstore= $emsg;
+ if (defined $emsg and length $emsg) {
+ $$emsgstore='' unless defined $$emsgstore;
+ $$emsgstore .= $emsg. ' ';
+ }
foreach my $entry (@$results) {
+#print STDERR "qts entry perresult \`@$entry'\n";
$perresult->(@$entry);
}
}
my $mydbh;
$dbh ||= ($mydbh= dbw_connect($ocean));
-my $sqlstmt= $chk->scall_method("sqlstmt");
-my $sth= $dbh->prepare($sqlstmt);
-my @sqlstmt_qs= $sqlstmt =~ m/\?/g;
+#print STDERR "qtsc string=\`$string'\n";
-#die "$sqlstmt @sqlstmt_qs";
+my ($sth, @sqlstmt_qs);
+if ($chk->method_exists('sqlstmt')) {
+ my $sqlstmt= $chk->scall_method("sqlstmt");
+ $sth= $dbh->prepare($sqlstmt);
+ @sqlstmt_qs= $sqlstmt =~ m/\?/g;
+}
my $emsg= '';
my @results;
-
-my @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string);
+my @specs;
+my $canontext;
+my $hooks = { Emsg => \$emsg, String => \$string,
+ Results => \@results, Specs => \@specs,
+ Canon => \$canontext
+ };
+
+if ($chk->method_exists('preparse')) {
+ $chk->call_method('preparse', h => $hooks);
+} else {
+ @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string);
+}
no warnings qw(exiting);
push @results, $results->[0];
};
+if (!defined $canontext) {
+ $canontext= join ' | ', map { $_->[0] } @results;
+}
+if ($chk->method_exists('postquery')) {
+ $chk->call_method('postquery', h => $hooks);
+}
+
$emsg='' if !defined $emsg;
-my $canontext= join ' | ', map { $_->[0] } @results;
+@results=() if length $emsg;
+
+#print STDERR "qtsc emsg=\`$emsg' results=\`@results'\n";
if ($format =~ /json/) {
$r->content_type($ctype or $format);
$dbh
$prselector
$routestring => '';
+$capacitystring => '';
+$lossperleague => '';
$someresults
$emsgokorprint
</%args>
my @archipelagoes;
my @islandids;
my %islandid2;
+my ($max_volume, $max_mass);
+my $lossperleaguepct;
my $qa= \%ARGS;
size=80
</&>
+<strong>Advanced options - you may leave these blank:</strong>
+<p>
+<table>
+<tr>
+<td>
+
+Vessel or capacity:
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
+ thingstring => 'capacitystring', emsgstore => \$emsg,
+ perresult => sub {
+ ($max_volume,$max_mass) = @_;
+ }
+ &>
+ size=30
+</&>
+
+<td>
+
+
+
+<td>
+Expected losses:
+
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll',
+ thingstring => 'lossperleague', emsgstore => \$emsg,
+ perresult => sub { ($lossperleaguepct)= @_; }
+ &>
+ size=10
+</&>
+
+</table>
+
% } else { #---------- dropdowns, user selects from menus ----------
% $startform->(grep {
% } #---------- end of dropdowns, now common middle of page code ----------
<input type=submit name=submit value="<% $goupdate->() %>">
-% my $ours= sub { $_[0] =~ m/^island|^archipelago|^routestring|^[RT]/; };
+% my $ours= sub { $_[0] =~
+% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^[RT]/;
+% };
<& "lookup:formhidden", ours => $ours &>
<%perl>
dbh => $dbh,
islandids => \@islandids,
archipelagoes => \@archipelagoes,
- qa => $qa
+ qa => $qa,
+ max_mass => $max_mass,
+ max_volume => $max_volume,
+ lossperleaguepct => $lossperleaguepct
&>
</form>
% }
@islandids
@archipelagoes
$qa
+$max_mass
+$max_volume
+$lossperleaguepct
</%args>
<&| script &>
da_pageload= Date.now();
<%perl>
+my $loss_per_league= defined $lossperleaguepct ? $lossperleaguepct*0.01 : 1e-7;
+
my $now= time;
-my $loss_per_league= 1e-7;
my @flow_conds;
my @query_params;
qw( Margin
));
$addcols->({ DoReverse => 1 },
- qw( unitprofit dist MaxQty
- MaxCapital MaxProfit
+ qw( unitprofit MaxQty MaxCapital MaxProfit dist
));
+foreach my $v (qw(MaxMass MaxVolume)) {
+ $addcols->({
+ DoReverse => 1, Total => 0, SortColKey => "${v}SortKey" }, $v);
+}
</%perl>
$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%%",
<p>
% if (@islandids<=1) {
-Route is trivial.
+Route contains only one location.
% }
% if (!$specific) {
Route contains archipelago(es), not just specific islands.
Maximize
totalprofit:
- ".(join " +
+ ".(join "
", map {
- sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
+ sprintf "%+.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
} @flows)."
Subject To
foreach my $cstname (sort keys %avail_csts) {
my $c= $avail_csts{$cstname};
$cplex .= "
- ". sprintf("%-30s","$cstname:")." ".
+ ". sprintf("%-30s","$cstname:")." ".
join("+", @{ $c->{Flows} }).
" <= ".$c->{Qty}."\n";
}
+foreach my $ci (0..($#islandids-1)) {
+ my @rel_flows;
+ foreach my $f (@flows) {
+ next if $f->{Suppress};
+ next if $f->{'org_id'} == $f->{'dst_id'};
+ next unless grep { $f->{'org_id'} == $_ }
+ @islandids[0..$ci];
+ next unless grep { $f->{'dst_id'} == $_ }
+ @islandids[$ci+1..@islandids-1];
+ push @rel_flows, $f;
+#print " RELEVANT $ci $f->{Ix} ";
+ }
+#print " RELEVANT $ci COUNT ".scalar(@rel_flows)." ";
+ next unless @rel_flows;
+ foreach my $mv (qw(mass volume)) {
+ my $max_vn= "max_$mv";
+ my $max= $mv eq 'mass' ? $max_mass : $max_volume;
+ next unless defined $max;
+#print " DEFINED MAX $mv $max ";
+ $cplex .= "
+ ". sprintf("%-10s","${mv}_$ci:")." ".
+ join(" + ", map { ($_->{"unit$mv"}*1e-3).' f'.$_->{Ix} } @rel_flows).
+ " <= $max";
+ }
+ $cplex.= "\n";
+}
+
$cplex.= "
Bounds
".(join "
", map { "$_->{Var} >= 0" } @flows)."
+";
+
+$cplex.= "
+Integer
+ ".(join "
+ ", map { "f$_" } (0..$#flows))."
+
End
";
while (<$output>) {
$glpsol_out.= $_;
print encode_entities($_) if $qa->{'debug'};
- if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
+ if (m/^\s*No\.\s+Column name\s+(?:St\s+)?Activity\s/) {
die if $found_section>0;
$found_section= 1;
next;
die $prerr unless $found_section;
};
-$addcols->({ DoReverse => 1 }, 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, DoReverse => 1 }, qw(
<colgroup span=2>
<colgroup span=2>
<colgroup span=2>
-<colgroup span=1>
+<colgroup span=3>
<colgroup span=3>
% if ($optimise) {
<colgroup span=3>
<th colspan=2>Collect
<th colspan=2>Deliver
<th colspan=2>Profit
-<th colspan=1>
<th colspan=3>Max
+<th colspan=1>
+<th colspan=2>Max
% if ($optimise) {
<th colspan=3>Planned
% }
<th>Qty
<th>Margin
<th>Unit
-<th>Dist
<th>Qty
<th>Capital
<th>Profit
+<th>Dist
+<th>Mass
+<th>Vol
% if ($optimise) {
<th>Qty
<th>Capital
<td><input type=hidden name=R<% $flow->{UidShort} %> value="">
<input type=checkbox name=T<% $flow->{UidShort} %> value=""
<% $flow->{Suppress} ? '' : 'checked' %> >
-% foreach my $ci (1..$#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;
% my $sortkey= $col->{SortColKey} ?
% $flow->{$col->{SortColKey}} : $v;
% $ts_sortkeys{$ci}{$rowid}= $sortkey;
-<td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
+<td <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
+ %> <% $spec->{Align}
+ %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
+% $ci += $spec->{Span};
% }
% }
<tr id="trades_total">
<tr><td colspan=3>
% $iquery->execute($islandids[$i]);
% my ($islandname) = $iquery->fetchrow_array();
-% my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
-% $total_dist += $this_dist;
% if (!$i) {
<strong>Start at <% $islandname |h %></strong>
% } else {
+% my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
+% $total_dist += $this_dist;
<strong>Sail to <% $islandname |h %></strong>
- <% $this_dist |h %> leagues </td>
% }
~yarrgweb / ypp-sc-tools.db-live.git / commitdiff