yarrg/u.*
yarrg/yarrg
+yarrg/routesearch
yarrg/_*.*
yarrg/OCEAN-*.db
@ISA = qw(Exporter);
@EXPORT = qw(&parse_info_clientside &fetch_with_rsync
&parse_info_serverside &parse_info_serverside_ocean
- %oceans %commods %clients %routes %route_mysteries
+ %oceans %commods %clients
+ %vessels %shotname2damage
&parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
&get_our_version &check_tsv_line
&pipethrough_prep &pipethrough_run
our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources;
our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ];
-our %routes; # eg $routes{'Midnight'}{'Orca'}{'Tinga'}= $sources NB abbrevs!
-our %route_mysteries; # eg $route_mysteries{'Midnight'}{'Norse'}= 3
+our %vessels; # eg $vessels{'War Brig'}{Shot}='medium'
+ # $vessels{'War Brig'}{Volume}= 81000
+ # $vessels{'War Brig'}{Mass}= 54000
+our %shotname2damage; # eg $shotname2damage{'medium'}= 3;
# $sources = 's[l]b';
# 's' = Special Circumstances; 'l' = local ; B = with Bleach
$oceans{$ocean}{$arch}{$_} .= $src;
};
});
- } elsif (m/^routes (\w+)$/) {
- my $ocean= $1;
+ } elsif (m/^vessels$/) {
+ @ctx= (sub {
+ return if m/^[-+|]+$/;
+ m/^ \| \s* ([A-Z][a-z\ ]+[a-z]) \s*
+ \| \s* (small|medium|large) \s*
+ \| \s* ([1-9][0-9,]+) \s*
+ \| \s* ([1-9][0-9,]+) \s*
+ \| $/x
+ or die;
+ my $name= $1;
+ my $v= { Shot => $2, Volume => $3, Mass => $4 };
+ foreach my $vm (qw(Volume Mass)) { $v->{$vm} =~ s/,//g; }
+ $vessels{$name}= $v;
+ });
+ } elsif (m/^shot$/) {
@ctx= (sub {
- m/^(\S[^\t]*\S),\s*(\S[^\t]*\S),\s*([1-9][0-9]{0,2})$/ or die;
- $routes{$ocean}{$1}{$2}= $3;
+ m/^ ([a-z]+) \s+ (\d+) $/x or die;
+ $shotname2damage{$1}= $2;
});
} elsif (m/^client (\S+.*\S)$/) {
my $client= $1;
}
};
foreach (@rawcm) { &$ca($_,$src); }
-
- foreach my $on (keys %routes) {
- my $routes= $routes{$on};
- my $ocean= $oceans{$on};
- die unless defined $ocean;
-
- my @allislands;
- foreach my $an (sort keys %$ocean) {
- my $arch= $ocean->{$an};
- push @allislands, sort keys %$arch;
- }
- parse_info_maproutes($on, \@allislands, $routes);
- foreach my $route (values %$routes) {
- parse_info_maproutes($on, \@allislands, $route);
- }
- }
}
sub parse_info_clientside () {
return $local;
}
-sub parse_info_maproutes ($$$) {
- my ($on, $allislands, $routemap) = @_;;
- foreach my $k (sort keys %$routemap) {
- my @ok= grep { index($_,$k) >= 0 } @$allislands;
- die "ambiguous $k" if @ok>1;
- if (!@ok) {
- $route_mysteries{$on}{$k}++;
- delete $routemap->{$k};
- } elsif ($ok[0] ne $k) {
- $routemap->{$ok[0]}= $routemap->{$k};
- delete $routemap->{$k};
- }
- }
-}
-
sub parse_info_serverside () {
parse_info1('source-info.txt','s',0);
}
@ISA = qw(Exporter);
@EXPORT = qw(&db_setocean &db_writer &db_connect $dbh
&db_filename &db_doall &db_onconflict
- &dbr_filename &dbr_connect);
+ &dbr_filename &dbr_connect &db_connect_core);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw();
}
sub dbr_connect ($$) {
my ($datadir,$ocean) = @_;
- return connect_core(dbr_filename($datadir,$ocean));
+ return db_connect_core(dbr_filename($datadir,$ocean));
}
-sub connect_core ($) {
+sub db_connect_core ($) {
my ($fn)= @_;
my $h= DBI->connect("dbi:SQLite:$fn",'','',
{ AutoCommit=>0,
}
sub db_connect () {
- $dbh= connect_core($dbfn);
+ $dbh= db_connect_core($dbfn);
}
sub db_doall ($) {
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
- @EXPORT = qw(&dbw_connect &ocean_list &sourcebasedir
+ @EXPORT = qw(&dbw_connect &dbw_filename &ocean_list &sourcebasedir
&to_json_shim &to_json_protecttags
- &set_ctype_utf8
+ &set_ctype_utf8 &webdatadir
+ &expected_error &dbw_lookup_string
+ &printable &tr_datarow
&prettyprint_age &meta_prettyprint_age);
%EXPORT_TAGS = ( );
return dotperllibdir().'/..';
}
-sub datadir () {
- my $edir= $ENV{'YARRG_DATA_DIR'};
+sub some_datadir ($) {
+ my ($what) = @_;
+ my $edir= $ENV{"YARRG_${what}_DIR"};
return $edir if defined $edir;
my $dir= dotperllibdir();
- if (stat "$dir/DATA") {
- return "$dir/DATA";
+ my $dirwhat= "$dir/$what";
+ if (stat $dirwhat) {
+ return $dirwhat;
} elsif ($!==&ENOENT) {
return "$dir";
} else {
- die "stat $dir/DATA $!";
+ die "stat $dirwhat $!";
}
return '.';
}
+sub webdatadir () { return some_datadir('WEBDATA'); }
+sub datadir () { return some_datadir('DATA'); }
+
my @ocean_list;
sub ocean_list () {
return @ocean_list;
}
-sub dbw_connect ($) {
+sub dbw_filename ($) {
my ($ocean) = @_;
die "unknown ocean $ocean ?"
unless grep { $_ eq $ocean } ocean_list();
- return dbr_connect(datadir(), $ocean);
+ return dbr_filename(datadir(), $ocean);
+}
+
+sub dbw_connect ($) {
+ my ($ocean) = @_;
+ my $fn= dbw_filename($ocean);
+ return db_connect_core($fn);
}
sub to_json_shim ($) {
}
+sub dbw_lookup_string ($$$$$$$$) { # => ( $emsg, @dbresults )
+ my ($each,
+ $sth, $stmt_nqs, $abbrev_initials, $maxambig,
+ $em_nomatch, $em_manyambig, $emf_ambiguous) = @_;
+
+ $each =~ s/^\s*//; $each =~ s/\s*$//; $each =~ s/\s+/ /g;
+ my %m;
+ my $results;
+ my @pats= ("$each", "$each \%", "$each\%", "\%$each\%");
+ if ($abbrev_initials) {
+ push @pats, join ' ', map { "$_%" } split //, $each;
+ }
+ foreach my $pat (@pats) {
+ $sth->execute(($pat) x $stmt_nqs);
+ $results= $sth->fetchall_arrayref();
+ last if @$results==1;
+ $m{ $_->[0] }=1 for @$results;
+ $results= undef;
+ }
+ if (!$results) {
+ if (!%m) {
+ return $em_nomatch;
+ } elsif (keys(%m) > $maxambig) {
+ return $em_manyambig;
+ } else {
+ return $emf_ambiguous->($each, join(', ', sort keys %m));
+ }
+ }
+ return (undef, @{ $results->[0] });
+}
+
+sub expected_error ($) {
+ my $r= { Emsg => $_[0] };
+ bless $r, 'CommodsWeb::ExpectedError';
+ die $r;
+}
+
+sub printable ($) { # printable($m) where $m is the Mason request object
+ my ($m) = @_;
+ my $a= scalar $m->caller_args(-1);
+ foreach my $t (qw(pdf ps html pdf2 ps2)) {
+ return $t if $a->{"printable_$t"};
+ }
+ return 0;
+}
+
+sub tr_datarow ($$) {
+ my ($m, $lineno) = @_;
+ $lineno &= 1;
+ if (!printable($m)) {
+ $m->print("<tr class=\"datarow$lineno\">");
+ } else {
+ $m->print("<tr bgcolor=\"".
+ ($lineno ? "#ffffff" : "#e3e3e3" ).
+ "\">");
+ }
+}
+
+package CommodsWeb::ExpectedError;
+
+sub emsg ($) {
+ my ($self) = @_;
+ return $self->{Emsg};
+}
+
1;
TARGETS= yarrg
-all: clean-other-directory $(TARGETS)
+default: clean-other-directory $(TARGETS)
+all: default routesearch
-CONVERT_OBJS= convert.o ocr.o pages.o structure.o common.o rgbimage.o resolve.o
+CONVERT_OBJS= convert.o ocr.o pages.o structure.o rgbimage.o resolve.o
+COMMON_OBJS= common.o
+ROUTESEARCH_OBJS= rsvalue.o rsmain.o rssql.o rssearch.o
-yarrg: $(CONVERT_OBJS) -lnetpbm -lXtst -lX11 -lpcre -lm
+yarrg: $(CONVERT_OBJS) $(COMMON_OBJS) -lnetpbm -lXtst -lX11 -lpcre -lm
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ $(LDLIBS)
-$(CONVERT_OBJS): ocr.h convert.h structure.h common.h
+$(CONVERT_OBJS): common.h ocr.h convert.h structure.h
+
+routesearch: $(ROUTESEARCH_OBJS) $(COMMON_OBJS) -lsqlite3 -lglpk -lm
+ $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ $(LDLIBS)
+
+$(ROUTESEARCH_OBJS): common.h rscommon.h
+$(COMMON_OBJS): common.h
clean:
rm -f *.o core core.* *~ vgcore.*
--test-servers Set default servers to be the test servers, not
the real live ones (doesn't affect explicit settings).
-Controlling what happens to the results - only one at a time:
- --upload (default) Upload to the YARRG and PCTB servers
- --tsv Print data as clean tab-separated-values file
- --raw-tsv Dump the raw (not deduped, unsorted) OCR'd data
- --best-prices Print best buy and sell price for each commodity
- --arbitrage Print arbitrage opportunities
+Controlling what happens to the results - one or more:
+ --upload (default) Upload to both the YARRG and PCTB servers
+ --upload-pctb Upload to the PCTB servers
+ --upload-yarrg Upload to the YARRG servers
+ --tsv Print data as clean tab-separated-values file
+ --raw-tsv Dump the raw (not deduped, unsorted) OCR'd data
+ --best-prices Print best buy and sell price for each commodity
+ --arbitrage Print arbitrage opportunities
Privacy options, which control conversations with the dictionary server:
--dict-local-only * Do not talk to the server even to fetch new dictionary.
ypp-sc-tools and YARRG are
Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
Copyright (C) 2009 Clare Boothby
+Copyright (C) 2009 Steve Early
This program is free software: you can redistribute it and/or modify
it under the terms of
UPLOADER
--------
- sometimes fails to work on Sage - sunshine widget resets or something
+detect all unexpected mouse movements
- detect all unexpected mouse movements
+more flexible installation arrangements
- more flexible installation arrangements
-
- W windows uploader
+windows uploader
DATABASE/DICTIONARY MANAGER
---------------------------
- commodity mass/volume in live database
- eliminate black dye from live database
+eliminate black dye from live database
- when update rejected print better error message including
- broken commodity name
+when update rejected print better error message including
+ broken commodity name
- notice commodities deleted from source-info and warn about them
+notice commodities deleted from source-info and warn about them
- support Opal and Jade (currently there are some unicode problems)
+support Opal and Jade (currently there are some unicode problems)
WEBSITE
-------
- trades for route with an archipelago should produce
- a message saying `searched for arbitrage trades only in
- Ruby' or some such.
-
- multi-visit routes / circular routes
-
- adjustable potential cost of losses (rather than fixed
- 1e-BIG per league)
- use power formula (compound interest)
- suggest 0.5%
-
- initial/final stocks feature
-
- max volume/mass
-
- max capital
-
- better documentation
-
- printable voyage trading plan
-
-
-KEYLETTERS
-----------
-
-P needed before public release
-O needed before public release to support multiple oceans
+allow unticking based on minimum margin or minimum profit
-C needs ypp client and network connection
-N needs network connection
-W needs to be done by someone with Windows
+initial/final stocks feature
-D dependencies unsatisfied
+query_routesearch should show capital for each voyage
+query_routesearch should support ending in specific place(s)
sysassert( r= malloc(sz) );
return r;
}
+void *mcalloc(size_t sz) {
+ void *r;
+ if (!sz) return 0;
+ sysassert( r= malloc(sz) );
+ memset(r, 0, sz);
+ return r;
+}
void *mrealloc(void *p, size_t sz) {
assert(sz);
void *r;
return r;
}
+DEFINE_VWRAPPERF(, progress, )
+DEFINE_VWRAPPERF(, progress_log, )
+DEFINE_VWRAPPERF(, progress_spinner, )
+DEFINE_VWRAPPERF(, warning, )
+DEFINE_VWRAPPERF(, fatal, NORET)
-FILE *dbfile;
-static const char *basepath; /* as passed in by caller */
-static pid_t dbzcat;
-
-int dbfile_gzopen(const char *basepath_spec) {
- assert(!dbfile);
-
- basepath= basepath_spec;
+static int last_progress_len;
- char *zpath= masprintf("%s.gz", basepath);
- int e= gzopen(zpath, O_RDONLY, &dbfile, &dbzcat, 0);
- free(zpath);
- if (e) { errno=e; sysassert(errno==ENOENT); return 0; }
+static void vprogress_core(int spinner, const char *fmt, va_list al) {
+ int r;
- return 1;
-}
+ if (o_quiet) return;
+ if (!debug_flags && !isatty(2)) return;
+
+ if (last_progress_len)
+ putc('\r',stderr);
-int dbfile_open(const char *tpath) {
- assert(!dbfile);
+ r= vfprintf(stderr,fmt,al);
- basepath= tpath;
+ if (spinner) {
+ putc(spinner,stderr);
+ r++;
+ }
- dbzcat= -1;
- dbfile= fopen(tpath,"r");
- if (!dbfile) { sysassert(errno==ENOENT); return 0; }
- return 1;
-}
+ if (r < last_progress_len) {
+ fprintf(stderr,"%*s", last_progress_len - r, "");
+ if (!r) putc('\r', stderr);
+ else while (last_progress_len-- > r) putc('\b',stderr);
+ }
+ last_progress_len= r;
-void dbfile_close(void) {
- gzclose(&dbfile, &dbzcat, basepath);
+ if (ferror(stderr) || fflush(stderr)) _exit(16);
}
-
-#define dbassertgl(x) ((x) ? (void)0 : dbfile_assertfail(file,line,#x))
-
-void dbfile_getsline(char *lbuf, size_t lbufsz, const char *file, int line) {
- errno=0;
- char *s= fgets(lbuf,lbufsz,dbfile);
- sysassert(!ferror(dbfile));
- dbassertgl(!feof(dbfile));
- assert(s);
- int l= strlen(lbuf);
- dbassertgl(l>0); dbassertgl(lbuf[--l]=='\n');
- lbuf[l]= 0;
+
+void vprogress(const char *fmt, va_list al) { vprogress_core(0,fmt,al); }
+void vprogress_spinner(const char *fmt, va_list al) {
+ static const char spinchars[]="/-\\";
+ static int spinner;
+
+ vprogress_core(spinchars[spinner],fmt,al);
+ spinner++;
+ spinner %= (sizeof(spinchars)-1);
}
-int dbfile_vscanf(const char *fmt, va_list al) {
- int r= vfscanf(dbfile,fmt,al);
- sysassert(!ferror(dbfile));
- return r;
+void vprogress_log(const char *fmt, va_list al) {
+ if (o_quiet) return;
+
+ progress("");
+ vfprintf(stderr,fmt,al);
+ putc('\n',stderr);
+ fflush(stderr);
}
-int dbfile_scanf(const char *fmt, ...) {
- va_list al;
- va_start(al,fmt);
- int r= dbfile_vscanf(fmt,al);
- va_end(al);
- return r;
+void vwarning(const char *fmt, va_list al) {
+ progress("");
+ fputs("Warning: ",stderr);
+ vfprintf(stderr,fmt,al);
+ fputs("\n",stderr);
+ fflush(stderr);
}
-void dbfile_assertfail(const char *file, int line, const char *m) {
- if (dbzcat)
- fatal("Error in dictionary file %s.gz:\n"
- " Requirement not met at %s:%d:\n"
- " %s",
- basepath, file,line, m);
- else if (dbfile)
- fatal("Error in dictionary file %s at byte %ld:\n"
- " Requirement not met at %s:%d:\n"
- " %s",
- basepath,(long)ftell(dbfile), file,line, m);
- else
- fatal("Semantic error in dictionaries:\n"
- " Requirement not met at %s:%d:\n"
- " %s",
- file,line, m);
+void vfatal(const char *fmt, va_list al) {
+ progress("");
+ fputs("\n\nFatal error: ",stderr);
+ vfprintf(stderr,fmt,al);
+ fflush(stderr);
+ fputs("\n\n",stderr);
+ _exit(4);
}
-int gzopen(const char *zpath, int oflags, FILE **f_r, pid_t *pid_r,
- const char *gziplevel /* 0 for read; may be 0, or "-1" etc. */) {
-
- int zfd= open(zpath, oflags, 0666);
- if (zfd<0) return errno;
-
- int pipefds[2];
- sysassert(! pipe(pipefds) );
+void sysassert_fail(const char *file, int line, const char *what) {
+ int e= errno;
+ progress("");
+ fprintf(stderr,
+ "\nfatal operational error:\n"
+ " unsuccessful execution of: %s\n"
+ " %s:%d: %s\n\n",
+ what, file,line, strerror(e));
+ _exit(16);
+}
- int oi,io; const char *cmd; const char *stdiomode;
- switch ((oflags & O_ACCMODE)) {
- case O_RDONLY: oi=0; io=1; cmd="gunzip"; stdiomode="r"; break;
- case O_WRONLY: oi=1; io=0; cmd="gzip"; stdiomode="w"; break;
- default: abort();
+void waitpid_check_exitstatus(pid_t pid, const char *what, int sigpipeok) {
+ pid_t got;
+ int st;
+ for (;;) {
+ got= waitpid(pid, &st, 0);
+ if (pid==-1) { sysassert(errno==EINTR); continue; }
+ break;
}
-
- sysassert( (*pid_r=fork()) != -1 );
- if (!*pid_r) {
- sysassert( dup2(zfd,oi)==oi );
- sysassert( dup2(pipefds[io],io)==io );
- sysassert(! close(zfd) );
- sysassert(! close(pipefds[0]) );
- sysassert(! close(pipefds[1]) );
- execlp(cmd,cmd,gziplevel,(char*)0);
- sysassert(!"execlp gzip/gunzip");
+ sysassert( got==pid );
+
+ if (WIFEXITED(st)) {
+ if (WEXITSTATUS(st))
+ fatal("%s failed with nonzero exit status %d",
+ what, WEXITSTATUS(st));
+ } else if (WIFSIGNALED(st)) {
+ if (!sigpipeok || WTERMSIG(st) != SIGPIPE)
+ fatal("%s died due to signal %s%s", what,
+ strsignal(WTERMSIG(st)), WCOREDUMP(st)?" (core dumped)":"");
+ } else {
+ fatal("%s gave strange wait status %d", what, st);
}
- sysassert(! close(zfd) );
- sysassert(! close(pipefds[io]) );
- sysassert( *f_r= fdopen(pipefds[oi], stdiomode) );
+}
- return 0;
+char *masprintf(const char *fmt, ...) {
+ char *r;
+ va_list al;
+ va_start(al,fmt);
+ sysassert( vasprintf(&r,fmt,al) >= 0);
+ sysassert(r);
+ va_end(al);
+ return r;
}
-void gzclose(FILE **f, pid_t *p, const char *what) {
- if (!*f) return;
-
- sysassert(!ferror(*f));
- sysassert(!fclose(*f));
-
- if (*p != -1) {
- char *process= masprintf("%s (de)compressor",what);
- waitpid_check_exitstatus(*p,process,1);
- free(process);
- *p= -1;
- }
+unsigned debug_flags;
- *f= 0;
+void debug_flush(void) {
+ sysassert(!ferror(debug));
+ sysassert(!fflush(debug));
}
#include <string.h>
#include <stdint.h>
#include <stdlib.h>
+#include <stddef.h>
#include <unistd.h>
#include <dirent.h>
#include <inttypes.h>
-#include <fnmatch.h>
-
-#include <pcre.h>
#include <fcntl.h>
#include <unistd.h>
#define RECT_W(r) ((r).br.x - (r).tl.x + 1)
#define RECT_H(r) ((r).br.y - (r).tl.y + 1)
-
-
-#define DEBUG_FLAG_LIST \
- DF(findypp) \
- DF(pages) \
- DF(rect) \
- DF(pixmap) \
- DF(struct) \
- DF(ocr) \
- DF(rsync) \
- DF(structcolon) \
- DF(callout)
-
+#ifdef DEBUG_FLAG_LIST
enum {
#define DF(f) dbg__shift_##f,
DEBUG_FLAG_LIST
DEBUG_FLAG_LIST
#undef DF
};
+#define DEBUGP(f) (!!(debug_flags & dbg_##f))
-unsigned debug_flags;
+#endif /*DEBUG_FLAG_LIST*/
-#define DEBUGP(f) (!!(debug_flags & dbg_##f))
+#ifndef debug_flags
+extern unsigned debug_flags;
+#endif
void debug_flush(void);
-#define debug stderr
-
-const char *get_vardir(void);
-const char *get_libdir(void);
+#ifndef debug
+# define debug stderr
+#endif
#define FMT(f,a) __attribute__((format(printf,f,a)))
#define SCANFMT(f,a) __attribute__((format(scanf,f,a)))
/*---------- error handling ----------*/
+extern int o_quiet;
+
+void vwarning(const char *fmt, va_list) FMT(1,0);
+void warning(const char *fmt, ...) FMT(1,2);
+
+void vprogress(const char *fmt, va_list) FMT(1,0);
+void progress(const char *fmt, ...) FMT(1,2);
+
+void vprogress_log(const char *fmt, va_list) FMT(1,0);
+void progress_log(const char *fmt, ...) FMT(1,2);
+
+void vprogress_spinner(const char *fmt, va_list) FMT(1,0);
+void progress_spinner(const char *fmt, ...) FMT(1,2);
+
void vfatal(const char *fmt, va_list) FMT(1,0) NORET;
void fatal(const char *fmt, ...) FMT(1,2) NORET;
void *mmalloc(size_t sz);
+void *mcalloc(size_t sz);
void *mrealloc(void *p, size_t sz);
-
-#define dbassert(x) ((x) ? (void)0 : dbfile_assertfail(__FILE__,__LINE__,#x))
-void dbfile_assertfail(const char *file, int line, const char *m) NORET;
-
-FILE *dbfile;
-void dbfile_getsline(char *lbuf, size_t lbufsz, const char *file, int line);
-int dbfile_open(const char *tpath); /* 0: ENOENT; 1: worked */
-int dbfile_gzopen(const char *tpath); /* 0: ENOENT; 1: worked */
-void dbfile_close(void); /* idempotent */
-
-int dbfile_scanf(const char *fmt, ...) SCANFMT(1,2);
-int dbfile_vscanf(const char *fmt, va_list al) SCANFMT(1,0);
-
-int gzopen(const char *zpath, int oflags, FILE **f_r, pid_t *pid_r,
- const char *gziplevel /* 0 for read; may be 0, or "-1" etc. */);
- /* returns errno value from open */
-void gzclose(FILE **f, pid_t *p, const char *what);
- /* also OK with f==0, or p==-1 */
-
char *masprintf(const char *fmt, ...) FMT(1,2);
-#define EXECLP_HELPER(helper, ...) do{ \
- char *helper_path= masprintf("%s/%s",get_libdir(),helper); \
- execlp(helper_path,helper, __VA_ARGS__); \
- sysassert(errno==ENOENT); \
- fatal("Failed to find helper program %s.\n" \
- "(Are you in the correct directory?)", helper); \
- }while(0)
-
#define ARRAYSIZE(a) ((sizeof((a)) / sizeof((a)[0])))
#define FILLZERO(obj) (memset(&(obj),0,sizeof((obj))))
#include "convert.h"
-void debug_flush(void) {
- sysassert(!ferror(debug));
- sysassert(!fflush(debug));
-}
-
const char *get_vardir(void) { return "."; }
const char *get_libdir(void) { return "."; }
}
+FILE *dbfile;
+static const char *basepath; /* as passed in by caller */
+static pid_t dbzcat;
+int dbfile_gzopen(const char *basepath_spec) {
+ assert(!dbfile);
-DEFINE_VWRAPPERF(, progress, )
-DEFINE_VWRAPPERF(, progress_log, )
-DEFINE_VWRAPPERF(, progress_spinner, )
-DEFINE_VWRAPPERF(, warning, )
-DEFINE_VWRAPPERF(, fatal, NORET)
+ basepath= basepath_spec;
-static int last_progress_len;
-
-static void vprogress_core(int spinner, const char *fmt, va_list al) {
- int r;
-
- if (o_quiet) return;
- if (!debug_flags && !isatty(2)) return;
+ char *zpath= masprintf("%s.gz", basepath);
+ int e= gzopen(zpath, O_RDONLY, &dbfile, &dbzcat, 0);
+ free(zpath);
+ if (e) { errno=e; sysassert(errno==ENOENT); return 0; }
- if (last_progress_len)
- putc('\r',stderr);
+ return 1;
+}
- r= vfprintf(stderr,fmt,al);
+int dbfile_open(const char *tpath) {
+ assert(!dbfile);
- if (spinner) {
- putc(spinner,stderr);
- r++;
- }
+ basepath= tpath;
- if (r < last_progress_len) {
- fprintf(stderr,"%*s", last_progress_len - r, "");
- if (!r) putc('\r', stderr);
- else while (last_progress_len-- > r) putc('\b',stderr);
- }
- last_progress_len= r;
+ dbzcat= -1;
+ dbfile= fopen(tpath,"r");
+ if (!dbfile) { sysassert(errno==ENOENT); return 0; }
+ return 1;
+}
- if (ferror(stderr) || fflush(stderr)) _exit(16);
-}
-
-void vprogress(const char *fmt, va_list al) { vprogress_core(0,fmt,al); }
-void vprogress_spinner(const char *fmt, va_list al) {
- static const char spinchars[]="/-\\";
- static int spinner;
-
- vprogress_core(spinchars[spinner],fmt,al);
- spinner++;
- spinner %= (sizeof(spinchars)-1);
+void dbfile_close(void) {
+ gzclose(&dbfile, &dbzcat, basepath);
}
-void vprogress_log(const char *fmt, va_list al) {
- if (o_quiet) return;
-
- progress("");
- vfprintf(stderr,fmt,al);
- putc('\n',stderr);
- fflush(stderr);
+#define dbassertgl(x) ((x) ? (void)0 : dbfile_assertfail(file,line,#x))
+
+void dbfile_getsline(char *lbuf, size_t lbufsz, const char *file, int line) {
+ errno=0;
+ char *s= fgets(lbuf,lbufsz,dbfile);
+ sysassert(!ferror(dbfile));
+ dbassertgl(!feof(dbfile));
+ assert(s);
+ int l= strlen(lbuf);
+ dbassertgl(l>0); dbassertgl(lbuf[--l]=='\n');
+ lbuf[l]= 0;
}
-void vwarning(const char *fmt, va_list al) {
- progress("");
- fputs("Warning: ",stderr);
- vfprintf(stderr,fmt,al);
- fputs("\n",stderr);
- fflush(stderr);
+int dbfile_vscanf(const char *fmt, va_list al) {
+ int r= vfscanf(dbfile,fmt,al);
+ sysassert(!ferror(dbfile));
+ return r;
}
-void vfatal(const char *fmt, va_list al) {
- progress("");
- fputs("\n\nFatal error: ",stderr);
- vfprintf(stderr,fmt,al);
- fflush(stderr);
- fputs("\n\n",stderr);
- _exit(4);
+int dbfile_scanf(const char *fmt, ...) {
+ va_list al;
+ va_start(al,fmt);
+ int r= dbfile_vscanf(fmt,al);
+ va_end(al);
+ return r;
}
-void sysassert_fail(const char *file, int line, const char *what) {
- int e= errno;
- progress("");
- fprintf(stderr,
- "\nfatal operational error:\n"
- " unsuccessful execution of: %s\n"
- " %s:%d: %s\n\n",
- what, file,line, strerror(e));
- _exit(16);
+void dbfile_assertfail(const char *file, int line, const char *m) {
+ if (dbzcat)
+ fatal("Error in dictionary file %s.gz:\n"
+ " Requirement not met at %s:%d:\n"
+ " %s",
+ basepath, file,line, m);
+ else if (dbfile)
+ fatal("Error in dictionary file %s at byte %ld:\n"
+ " Requirement not met at %s:%d:\n"
+ " %s",
+ basepath,(long)ftell(dbfile), file,line, m);
+ else
+ fatal("Semantic error in dictionaries:\n"
+ " Requirement not met at %s:%d:\n"
+ " %s",
+ file,line, m);
}
-void waitpid_check_exitstatus(pid_t pid, const char *what, int sigpipeok) {
- pid_t got;
- int st;
- for (;;) {
- got= waitpid(pid, &st, 0);
- if (pid==-1) { sysassert(errno==EINTR); continue; }
- break;
+int gzopen(const char *zpath, int oflags, FILE **f_r, pid_t *pid_r,
+ const char *gziplevel /* 0 for read; may be 0, or "-1" etc. */) {
+
+ int zfd= open(zpath, oflags, 0666);
+ if (zfd<0) return errno;
+
+ int pipefds[2];
+ sysassert(! pipe(pipefds) );
+
+ int oi,io; const char *cmd; const char *stdiomode;
+ switch ((oflags & O_ACCMODE)) {
+ case O_RDONLY: oi=0; io=1; cmd="gunzip"; stdiomode="r"; break;
+ case O_WRONLY: oi=1; io=0; cmd="gzip"; stdiomode="w"; break;
+ default: abort();
}
- sysassert( got==pid );
-
- if (WIFEXITED(st)) {
- if (WEXITSTATUS(st))
- fatal("%s failed with nonzero exit status %d",
- what, WEXITSTATUS(st));
- } else if (WIFSIGNALED(st)) {
- if (!sigpipeok || WTERMSIG(st) != SIGPIPE)
- fatal("%s died due to signal %s%s", what,
- strsignal(WTERMSIG(st)), WCOREDUMP(st)?" (core dumped)":"");
- } else {
- fatal("%s gave strange wait status %d", what, st);
+
+ sysassert( (*pid_r=fork()) != -1 );
+ if (!*pid_r) {
+ sysassert( dup2(zfd,oi)==oi );
+ sysassert( dup2(pipefds[io],io)==io );
+ sysassert(! close(zfd) );
+ sysassert(! close(pipefds[0]) );
+ sysassert(! close(pipefds[1]) );
+ execlp(cmd,cmd,gziplevel,(char*)0);
+ sysassert(!"execlp gzip/gunzip");
}
+ sysassert(! close(zfd) );
+ sysassert(! close(pipefds[io]) );
+ sysassert( *f_r= fdopen(pipefds[oi], stdiomode) );
+
+ return 0;
}
-char *masprintf(const char *fmt, ...) {
- char *r;
- va_list al;
- va_start(al,fmt);
- sysassert( vasprintf(&r,fmt,al) >= 0);
- sysassert(r);
- va_end(al);
- return r;
+void gzclose(FILE **f, pid_t *p, const char *what) {
+ if (!*f) return;
+
+ sysassert(!ferror(*f));
+ sysassert(!fclose(*f));
+
+ if (*p != -1) {
+ char *process= masprintf("%s (de)compressor",what);
+ waitpid_check_exitstatus(*p,process,1);
+ free(process);
+ *p= -1;
+ }
+
+ *f= 0;
}
#ifndef CONVERT_H
#define CONVERT_H
+#define DEBUG_FLAG_LIST \
+ DF(findypp) \
+ DF(pages) \
+ DF(rect) \
+ DF(pixmap) \
+ DF(struct) \
+ DF(ocr) \
+ DF(rsync) \
+ DF(structcolon) \
+ DF(callout)
+
+
#include "common.h"
#include "ocr.h"
+#include <fnmatch.h>
+#include <pcre.h>
#include <pam.h>
#include <time.h>
#include <limits.h>
void fetch_with_rsync(const char *stem);
void fetch_with_rsync_gz(const char *stem);
-void vwarning(const char *fmt, va_list) FMT(1,0);
-void warning(const char *fmt, ...) FMT(1,2);
-
-void vprogress(const char *fmt, va_list) FMT(1,0);
-void progress(const char *fmt, ...) FMT(1,2);
-
-void vprogress_log(const char *fmt, va_list) FMT(1,0);
-void progress_log(const char *fmt, ...) FMT(1,2);
-
-void vprogress_spinner(const char *fmt, va_list) FMT(1,0);
-void progress_spinner(const char *fmt, ...) FMT(1,2);
-
enum flags {
ff_singlepage= 000002,
ff_testservers= 000004,
extern const char *o_ocean, *o_pirate;
extern int o_quiet;
+
+#define dbassert(x) ((x) ? (void)0 : dbfile_assertfail(__FILE__,__LINE__,#x))
+void dbfile_assertfail(const char *file, int line, const char *m) NORET;
+
+FILE *dbfile;
+void dbfile_getsline(char *lbuf, size_t lbufsz, const char *file, int line);
+int dbfile_open(const char *tpath); /* 0: ENOENT; 1: worked */
+int dbfile_gzopen(const char *tpath); /* 0: ENOENT; 1: worked */
+void dbfile_close(void); /* idempotent */
+
+int dbfile_scanf(const char *fmt, ...) SCANFMT(1,2);
+int dbfile_vscanf(const char *fmt, va_list al) SCANFMT(1,0);
+
+int gzopen(const char *zpath, int oflags, FILE **f_r, pid_t *pid_r,
+ const char *gziplevel /* 0 for read; may be 0, or "-1" etc. */);
+ /* returns errno value from open */
+void gzclose(FILE **f, pid_t *p, const char *what);
+ /* also OK with f==0, or p==-1 */
+
+
+const char *get_vardir(void);
+const char *get_libdir(void);
+
+
+#define EXECLP_HELPER(helper, ...) do{ \
+ char *helper_path= masprintf("%s/%s",get_libdir(),helper); \
+ execlp(helper_path,helper, __VA_ARGS__); \
+ sysassert(errno==ENOENT); \
+ fatal("Failed to find helper program %s.\n" \
+ "(Are you in the correct directory?)", helper); \
+ }while(0)
+
+
/*----- from pages.c -----*/
void screenshot_startup(void);
extern const char *ocean, *pirate;
extern char *archipelago, *island;
-
#endif /*CONVERT_H*/
dist INTEGER NOT NULL,
PRIMARY KEY (aiid, biid)
);
+ CREATE TABLE IF NOT EXISTS vessels (
+ name TEXT NOT NULL,
+ mass INTEGER NOT NULL,
+ volume INTEGER NOT NULL,
+ shot INTEGER NOT NULL,
+ PRIMARY KEY (name)
+ );
END
;
$dbh->commit;
}
-#---------- island list ----------
-#---------- routes ----------
-# now done by yppedia-chart-parser
-
-__DATA__
+#---------- vessel types ----------
+{
+ my $idempotent= $dbh->prepare(<<'END')
+ INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
+ VALUES (?,?,?,?)
+END
+ ;
+ foreach my $name (sort keys %vessels) {
+ my $v= $vessels{$name};
+ my $shotdamage= $shotname2damage{$v->{Shot}};
+ die "no shot damage for shot $v->{Shot} for vessel $name"
+ unless defined $shotdamage;
+ my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
+ $idempotent->execute(@qa);
+ }
+ $dbh->commit;
+}
#print Dumper($results);
print "strict graph $ocean {\n";
-#print " nodesep=10;\n";
+print " splines=true;\n";
+print " nslimit=10;\n";
+print " mclimit=10;\n";
foreach my $row (@$islands) {
my ($id,$str) = @$row;
}
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).",
+ print " n$ia -- n$ib [ w=".(1.0/($dist*$dist)).", len=".(0.5*$dist+1).", label=$dist ];\n";
+ #len=$dist, minlen=$dist, , ,
#w=".(1.0/$dist).",
}
* sponsored by Three Rings.
*/
-#include "ocr.h"
#include "convert.h"
typedef struct {
--- /dev/null
+#ifndef RSCOMMON_H
+#define RSCOMMON_H
+
+#include <sqlite3.h>
+
+#define DEBUG_FLAG_LIST \
+ DF(sql) \
+ DF(sql2) \
+ DF(value) \
+ DF(value2) \
+ DF(search) \
+ DF(filter) \
+ DF(check) \
+ DF(tableau) \
+ DF(lp)
+
+//#define debug_flags 0
+
+#define debug debug_file
+
+#include "common.h"
+
+extern FILE *debug_file;
+#define DEBUG_DEV "/dev/stdout" /* just for glpk */
+
+
+#define GRANUS 3
+
+#define COUNTER_LIST \
+ CTR(commodities_loaded) \
+ CTR(trades_loaded) \
+ CTR(islands_arbitrage) \
+ CTR(ipairs_relevant) \
+ CTR(quantities_loaded) \
+ CTR(routes_considered) \
+ CTR(routes_wrongfinalelim) \
+ CTR(routes_quickelim) \
+ CTR(routes_bucketelim) \
+ CTR(routes_valued) \
+ CTR(routes_wrongfinal) \
+ CTRA(newbests_granu,GRANUS*2) \
+ CTR(subroute_tails_valued) \
+ CTR(subroutes_valued) \
+ CTR(subroutes_nonempty)
+#define CTR(x) extern int ctr_##x;
+#define CTRA(x,n) extern int ctr_##x[n];
+ COUNTER_LIST
+#undef CTR
+#undef CTRA
+
+#define SQL_MUST( call ) ({ \
+ /* `call' is an expression returning result, using const char *sqe; \
+ * chk1 and chk2 are blocks using sqe and int sqr; */ \
+ const char *sql_must_call_string= #call; \
+ int sqr; \
+ if (DEBUGP(sql2)) fprintf(debug,"SQL %s", sql_must_call_string); \
+ sqr= (call); \
+ if (DEBUGP(sql2)) fprintf(debug," = %d\n", sqr); \
+ if (sqr) sql_fatal("(unknown)", sqr, sql_must_call_string); \
+ }) \
+
+void sql_fatal(const char *stmt_what, int sqr, const char *act_what) NORET;
+
+#define SQL_STEP(ssh) (sql_step((ssh), #ssh, __FILE__, __LINE__))
+int sql_step(sqlite3_stmt *ssh, const char *ssh_string,
+ const char *file, int line);
+
+#define SQL_DISTINCT_DECL(cols, nintcols) \
+ int cols[nintcols]; \
+ cols[0]= -1;
+#define SQL_DISTINCT_STEP(ssh, cols, nkeycols) \
+ (sql_step_distinct((ssh), #ssh, __FILE__, __LINE__, \
+ (cols), sizeof((cols))/sizeof((cols)[0]), nkeycols))
+int sql_step_distinct(sqlite3_stmt *ssh, const char *ssh_string,
+ const char *file, int line,
+ int *cols, int ncols, int nkeycols);
+ /* These work if we're making a query whose columns consist of:
+ * - keys: integer column(s) on which the results are sorted by the query
+ * - consequences: zero or more integer cols strictly dependent on the keys
+ * - extra: zero or more further (possibly non-integer) columns
+ *
+ * Call SQL_DISTINCT_DECL, passing intcols = the total number of keys and
+ * consequences; it will declare int cols[intfields];
+ *
+ * Then each SQL_DISTINCT_STEP is like SQL_STEP only you have to
+ * pass the number of key columns and it only returns rows with
+ * distinct keys. Rows with all-identical keys are asserted to
+ * have identical consequences. After each call to
+ * SQL_DISTINCT_STEP the keys and consequences will be stored in
+ * cols.
+ */
+
+int sql_single_int(const char *stmt);
+
+#define SQL_PREPARE(ss,stmt) ((ss)= sql_prepare((stmt),#ss))
+sqlite3_stmt *sql_prepare(const char *stmt, const char *what);
+
+#define SQL_BIND(ss,index,value) (sql_bind((ss),(index),(value),#ss,#value))
+void sql_bind(sqlite3_stmt *ss, int index, int value,
+ const char *ss_what, const char *val_what);
+
+#define MAX_ROUTELEN 20
+
+extern sqlite3 *db;
+
+void setup_sql(const char *database);
+
+
+typedef struct {
+ double distance_loss_factor;
+ struct TradesBlock *trades;
+ double route_tail_value;
+} IslandPair;
+
+IslandPair *ipair_get_maybe(int si, int di);
+
+double value_route(int nislands, const int *islands, int exclude_arbitrage);
+void setup_value(void);
+
+#define AP 2 /* 0=absolute, 1=perleague */
+#define A 0
+#define P 1
+
+typedef struct {
+ double value[AP];
+ int length;
+ int ports[MAX_ROUTELEN];
+} OnePotentialResult;
+
+typedef struct {
+ OnePotentialResult prs[AP];
+} Bucket;
+
+void setup_search(void);
+void search(int start_isle, int final_isle /* -1 means any */,
+ Bucket ****buckets_base_io[GRANUS]
+ /* bucket_base[granui][finalthing][midthing]-> */);
+
+extern double max_mass, max_volu, max_capi;
+extern double distance_loss_factor_per_league;
+extern int max_dist, min_trade_maxprofit;
+
+#define LOSS_FACTOR_PER_DELAY_SLOT (1-1e-8)
+
+extern int islandtablesz;
+
+extern int narches;
+extern char **archnames;
+extern int *islandid2arch;
+
+extern int granusz_fin[GRANUS], granusz_mid[GRANUS];
+
+
+extern FILE *output;
+
+
+#define NEW(ptr) ((ptr)= mmalloc(sizeof(*ptr)))
+
+#define MCALLOC(array, count) ((array)= mcalloc(sizeof(*(array)) * (count)))
+
+#define MCALLOC_INITEACH(array, count, init_this) ({ \
+ MCALLOC((array), (count)); \
+ int initi; \
+ typeof(&(array)[0]) this; \
+ for (initi=0, this=(array); initi<(count); initi++, this++) { \
+ init_this; \
+ } \
+ })
+
+
+typedef struct {
+ double value;
+ Bucket *bucket;
+} HighScoreEntry;
+
+extern int granus;
+extern int nhighscores[GRANUS][AP];
+extern HighScoreEntry *highscores[GRANUS][AP];
+
+
+#define ONDEMAND(pointer_lvalue, calloc_size_count) \
+ ((pointer_lvalue) ? : \
+ ((pointer_lvalue) = mcalloc(sizeof(*(pointer_lvalue)) * calloc_size_count)))
+
+
+static inline int isle2arch(int isle) {
+ int arch= islandid2arch[isle];
+ assert(arch>=0);
+ return arch;
+}
+
+static inline int route2midarch(const int *ports, int nports) {
+ int archs[nports], last_arch=-1, narchs=0, i;
+ for (i=0; i<nports; i++) {
+ int arch= isle2arch(ports[i]);
+ if (arch==last_arch) continue;
+ archs[narchs++]= last_arch= arch;
+ }
+ return archs[narchs/2];
+}
+
+
+#endif /*RSCOMMON_H*/
--- /dev/null
+/**/
+
+#include "rscommon.h"
+
+#include <ctype.h>
+
+int o_quiet= 0;
+double max_mass=-1, max_volu=-1, max_capi=-1;
+double distance_loss_factor_per_league;
+int max_dist=-1, min_trade_maxprofit=0;
+
+FILE *debug_file;
+FILE *output;
+
+#define tabdebugf printf
+
+
+#define CTR(x) int ctr_##x;
+#define CTRA(x,n) int ctr_##x[n];
+ COUNTER_LIST
+#undef CTR
+#undef CTRA
+
+static Bucket ****results[GRANUS];
+ /* results[GRANUS][start_isle_ix][finalisle][midisle]-> */
+
+static pid_t debugoutpid;
+
+int main(int argc, const char **argv) {
+ const char *arg;
+ int i, ap;
+ int granui;
+ const char *database=0;
+ const char *concur_base=0, *concur_rhs=0;
+ int concur_lim=-1;
+
+#ifndef debug_flags
+ debug_flags= ~( dbg_sql2 );
+#endif
+
+ for (;;) {
+ arg= *++argv;
+ if (arg[0] != '-') break;
+ if (!strcmp(arg,"-d")) {
+ database= *++argv;
+ } else if (!strcmp(arg,"-C")) {
+ concur_base= *++argv;
+ concur_rhs= *++argv;
+ concur_lim= atoi(*++argv);
+ } else if (!strcmp(arg,"-g")) {
+ granus= atoi(*++argv);
+ assert(granus>=1 && granus<=GRANUS);
+#ifndef debug_flags
+ } else if (!strcmp(arg,"-DN")) {
+ debug_flags= 0;
+ } else if (!strcmp(arg,"-D1")) {
+ debug_flags= ~(dbg_sql2|dbg_lp|dbg_value2);
+#endif
+ } else {
+ abort();
+ }
+ }
+
+ if (debug_flags) {
+ /* glpk insists on writing stuff to stdout, and it does buffering,
+ * so we route all our debug through it this too */
+ int realstdout;
+ sysassert( (realstdout= dup(1)) > 2 );
+ sysassert( output= fdopen(realstdout,"w") );
+
+ int pfd[2];
+ sysassert(! pipe(pfd) );
+ sysassert( (debugoutpid= fork()) >=0 );
+ if (!debugoutpid) {
+ sysassert( dup2(pfd[0],0)==0 );
+ sysassert( dup2(2,1)==1 );
+ sysassert(! close(pfd[0]) );
+ sysassert(! close(pfd[1]) );
+ sysassert(! execlp("cat","cat",(char*)0) );
+ }
+ sysassert( dup2(pfd[1],1)==1 );
+ sysassert(! close(pfd[0]) );
+ sysassert(! close(pfd[1]) );
+
+ debug_file= stdout;
+ } else {
+ output= stdout;
+ debug_file= stderr;
+ }
+
+ sysassert( !setvbuf(debug,0,_IOLBF,0) );
+
+ max_mass= atof(*argv++);
+ max_volu= atof(*argv++);
+ max_capi= atof(*argv++);
+ double loss_per_league= atof(*argv++);
+ distance_loss_factor_per_league= 1.0 - loss_per_league;
+
+ min_trade_maxprofit= atoi(*argv++);
+
+ if (concur_base) {
+ for (i=0; i<concur_lim; i++) {
+ char *concfn= masprintf("%s%02d%s", concur_base, i, concur_rhs);
+ int concfd, r;
+ sysassert( (concfd= open(concfn, O_RDWR|O_CREAT|O_TRUNC, 0600)) >= 0);
+ struct flock fl;
+ memset(&fl,0,sizeof(fl));
+ fl.l_type= F_WRLCK;
+ r= fcntl(concfd, F_SETLK, &fl);
+ free(concfn);
+ if (!r) goto concur_ok;
+ sysassert( errno == EWOULDBLOCK );
+ close(concfd);
+ }
+ fprintf(output,"@@@ concurrency limit exceeded (%d)\n", concur_lim);
+ exit(0);
+
+ concur_ok:
+ /* deliberately leak concfd */
+ fprintf(output,"concurrency slot %d\n", i);
+ }
+
+ setup_sql(database);
+ setup_value();
+ setup_search();
+
+ for (i=0; i<narches; i++)
+ fprintf(output,"arch %d %s\n",i,archnames[i]);
+ fprintf(output,"setup complete, starting search\n");
+
+ arg= *argv++;
+ if (!strcmp(arg,"specific")) {
+ int ia[argc], ni=0;
+ while ((arg= *argv++))
+ ia[ni++]= atoi(arg);
+
+ double val= value_route(ni, ia, 0);
+ fprintf(output, "route value is %g\n", val);
+ } else if (!strcmp(arg,"search")) {
+ for (granui=0; granui<GRANUS; granui++)
+ MCALLOC(results[granui], argc);
+
+ max_dist= atoi(*argv++);
+
+ for (ap=0; ap<AP; ap++) {
+ int nhs= atoi(*argv++);
+ for (granui=0; granui<GRANUS; granui++) {
+ nhighscores[granui][ap]= nhs;
+ MCALLOC(highscores[granui][ap], nhs);
+ }
+ }
+ const char *final_isle_spec= *argv++;
+
+ int resultsix= 0;
+ while ((arg= argv[resultsix])) {
+ int init_isle= atoi(arg);
+
+ int final_isle;
+ if (!strcmp(final_isle_spec,"circ")) final_isle= init_isle;
+ else if (!strcmp(final_isle_spec,"any")) final_isle= -1;
+ else final_isle= atoi(final_isle_spec);
+ assert(final_isle);
+
+ Bucket ****buckets_base_io[GRANUS];
+ for (granui=0; granui<GRANUS; granui++)
+ buckets_base_io[granui]= &results[granui][resultsix];
+
+ search(init_isle, final_isle, buckets_base_io);
+ resultsix++;
+ }
+
+ int mid, fin;
+ for (granui=0; granui<granus; granui++) {
+ fprintf(output,"\n");
+ for (i=0; i<resultsix; i++) {
+ tabdebugf("========== start #%d granui%d %s ==========\n",
+ i, granui, argv[i]);
+ Bucket ***buckets_resultsix= results[granui][i];
+ if (!buckets_resultsix) continue;
+ tabdebugf(" ");
+ for (mid=0; mid<granusz_mid[granui]; mid++) {
+ tabdebugf("| m%-3d ",mid);
+ }
+ tabdebugf("\n");
+ for (fin=0; fin<granusz_fin[granui]; fin++) {
+ Bucket **buckets_fin= buckets_resultsix[fin];
+ if (!buckets_fin) continue;
+ tabdebugf("f%-3d",fin);
+ for (mid=0; mid<granusz_mid[granui]; mid++) {
+ Bucket *result= buckets_fin[mid];
+ if (!result) {
+ tabdebugf("| ");
+ } else {
+ tabdebugf("|%5d",(int)(result->prs[A].value[A]));
+ tabdebugf(" ");
+ tabdebugf("%4d",(int)(result->prs[P].value[P]));
+ }
+ }
+ tabdebugf("\n");
+ }
+ } /* i */
+
+ for (ap=0; ap<AP; ap++) {
+ int pos;
+ fprintf(output,"============== granui%d ap=%d ==============\n",
+ granui, ap);
+ for (pos=nhighscores[granui][ap]-1; pos>=0; pos--) {
+ HighScoreEntry *hs= &highscores[granui][ap][pos];
+ Bucket *bucket= hs->bucket;
+ if (!bucket) continue;
+ OnePotentialResult *pr= &bucket->prs[ap];
+ const int *const ports= pr->ports;
+ int nports;
+ for (nports=0; nports<MAX_ROUTELEN && ports[nports]>=0; nports++);
+ int finisle= ports[nports-1];
+ int finarch= isle2arch(finisle);
+ int midisle= ports[nports/2];
+ int midarch= route2midarch(ports,nports);
+ fprintf(output,
+ " @%2d %c#%2d | start%3d mid%d:%3d f%d:%3d"
+ " | %3dlg | %5d %5d %4d |",
+ pos, "ap"[ap], nhighscores[granui][ap] - pos,
+ ports[0], midarch,midisle, finarch,finisle, pr->length,
+ (int)hs->value, (int)pr->value[A], (int)pr->value[P]);
+ for (i=0; i<nports; i++) fprintf(output," %d",ports[i]);
+ fprintf(output,"\n");
+ } /* pos */
+ } /* ap */
+ } /* granui */
+ fprintf(output,"\n");
+
+ } else {
+ abort();
+ }
+
+#define CTR(x) fprintf(output," %-30s %10d\n",#x,ctr_##x);
+#define CTRA(x,n) for (i=0;i<n;i++) \
+ fprintf(output," %-27s[%d] %10d\n",#x,i,ctr_##x[i]);
+ COUNTER_LIST
+#undef CTR
+
+ if (debug_flags) {
+ sysassert(! fclose(debug) );
+ waitpid_check_exitstatus(debugoutpid,"debug cat",1);
+ }
+ sysassert(! fclose(output) );
+
+ return 0;
+}
--- /dev/null
+/**/
+
+#include "rscommon.h"
+
+DEBUG_DEFINE_DEBUGF(search);
+DEBUG_DEFINE_SOME_DEBUGF(filter,fildebugf);
+
+typedef struct Neighbour {
+ struct Neighbour *next;
+ int islandid;
+ int dist;
+} Neighbour;
+
+static Neighbour **neighbours; /* neighbours[islandid]->islandid etc. */
+static sqlite3_stmt *ss_neigh;
+
+static int ports[MAX_ROUTELEN];
+static int final_isle;
+
+static Neighbour *get_neighbours(int isle) {
+ Neighbour **np= &neighbours[isle];
+ Neighbour *head= *np;
+ if (head) return head;
+
+ SQL_BIND(ss_neigh, 1, isle);
+ while (SQL_STEP(ss_neigh)) {
+ Neighbour *add;
+ NEW(add);
+ add->islandid= sqlite3_column_int(ss_neigh, 0);
+ add->dist= sqlite3_column_int(ss_neigh, 1);
+ add->next= head;
+ head= add;
+ }
+ SQL_MUST( sqlite3_reset(ss_neigh) );
+
+ *np= head;
+ return head;
+}
+
+
+static Bucket ***buckets_base[GRANUS];
+
+
+static double process_route(int nports, int totaldist,
+ double overestimate_excepting_tail) {
+ int i, ap, granui;
+ int leagues_divisor= totaldist + nports;
+
+ ctr_routes_considered++;
+
+ int wrong_final= final_isle && ports[nports-1] != final_isle;
+
+ debugf("========== ROUTE");
+ for (i=0; i<nports; i++)
+ debugf(" %d",ports[i]);
+ debugf("\n");
+
+ double guess[AP]={0,0};
+ if (nports>=2) {
+ int pair[2], i;
+ pair[1]= ports[nports-1];
+ guess[A]= overestimate_excepting_tail;
+
+ for (i=0; i<nports; i++) {
+ pair[0]= ports[i];
+ IslandPair *ip= ipair_get_maybe(pair[0], pair[1]);
+ if (!ip) continue;
+ if (ip->route_tail_value < 0) {
+ ctr_subroute_tails_valued++;
+ ip->route_tail_value= value_route(2, pair, pair[0]!=pair[1]);
+ }
+ guess[A] += ip->route_tail_value;
+ }
+ guess[P]= guess[A] / leagues_divisor;
+
+ if (wrong_final) {
+ ctr_routes_wrongfinalelim++;
+ debugf(" WFELIM\n");
+ return guess[A];
+ }
+
+ for (granui=0; granui<granus; granui++) {
+ if (guess[A] > highscores[granui][A][0].value ||
+ guess[P] > highscores[granui][P][0].value)
+ goto not_quickelim;
+ }
+ ctr_routes_quickelim++;
+ debugf(" QELIM %f %f\n", guess[A], guess[P]);
+ return guess[A];
+ not_quickelim:;
+ }
+
+ int finisle= ports[nports-1];
+ int finarch= isle2arch(finisle);
+
+ int midisle= ports[nports/2];
+ int midarch= route2midarch(ports,nports);
+
+ Bucket *buckets[GRANUS];
+ for (granui=0; granui<granus; granui++) {
+ Bucket **buckets_fin;
+ int mid, fin;
+ switch (granui) {
+ case 0: fin=finarch; mid=midarch; break;
+ case 1: fin=finisle; mid=midarch; break;
+ case 2: fin=finisle; mid=midisle; break;
+ default: abort();
+ }
+ buckets_fin= ONDEMAND(buckets_base[granui][fin], granusz_mid[granui]);
+ buckets[granui]= ONDEMAND(buckets_fin[mid], 1);
+ }
+
+ if (nports>=2) {
+ for (granui=0; granui<granus; granui++)
+ for (ap=0; ap<AP; ap++)
+ if (guess[ap] > buckets[granui]->prs[ap].value[ap] &&
+ guess[ap] > highscores[granui][ap][0].value)
+ goto not_bucketelim;
+ ctr_routes_bucketelim++;
+ debugf(" ELIM %f %f\n", guess[A], guess[P]);
+ return guess[A];
+ not_bucketelim:
+ debugf(" COMPUTE %f %f\n", guess[A], guess[P]);
+ }
+
+ ctr_routes_valued++;
+
+ double value[AP];
+ value[A]= value_route(nports, ports, 0);
+ value[P]= value[A] / leagues_divisor;
+
+ if (wrong_final) {
+ ctr_routes_wrongfinal++;
+ return value[0];
+ }
+
+ for (granui=granus-1; granui>=0; granui--) {
+ Bucket *bucket= buckets[granui];
+
+ if (value[A] <= bucket->prs[A].value[A] &&
+ value[P] <= bucket->prs[P].value[P])
+ continue;
+
+ debugf(" SOMEHOW %d BEST\n",granui);
+
+ fildebugf("granu %d f%d:%3d mid%d:%3d ",granui,
+ finarch,finisle,midarch,midisle);
+
+ for (ap=0; ap<AP; ap++) {
+ HighScoreEntry *scores= highscores[granui][ap];
+ int nscores= nhighscores[granui][ap];
+
+ fildebugf("ap=%d %15f", ap, value[ap]);
+ if (value[ap] < bucket->prs[ap].value[ap]) {
+ debugf(" ");
+ } else {
+ int pos;
+ ctr_newbests_granu[granui*AP+ap]++;
+ bucket->prs[ap].length= totaldist;
+ memcpy(bucket->prs[ap].value, value, sizeof(value));
+ memcpy(bucket->prs[ap].ports, ports, sizeof(*ports) * nports);
+ if (nports < MAX_ROUTELEN-1) bucket->prs[ap].ports[nports]= -1;
+ fildebugf("** ");
+ for (pos=0; pos < nscores; pos++)
+ if (scores[pos].bucket == bucket) goto found;
+ /* not found */
+ pos= -1;
+ found:
+ for (;;) {
+ pos++;
+ if (pos >= nscores) break; /* new top */
+ if (scores[pos].value >= value[ap]) break; /* found spot */
+ if (pos>0)
+ scores[pos-1]= scores[pos];
+ }
+ pos--;
+ if (pos>0) {
+ scores[pos].value= value[ap];
+ scores[pos].bucket= bucket;
+ if (granui < granus-1 &&
+ highscores[granui][A][0].bucket &&
+ highscores[granui][P][0].bucket) {
+ /* both absolute and perleague are full at this granularity,
+ * so we don't care about anything more granular */
+ fildebugf("\n STOP-GRANU ");
+ granus= granui+1;
+ }
+ }
+ fildebugf("@%2d/%2d ", pos, nscores);
+ } /* new best */
+ } /* ap */
+ } /* granui */
+
+ fildebugf(" route");
+
+ for (i=0; i<nports; i++)
+ fildebugf(" %d",ports[i]);
+ fildebugf("\n");
+
+ return value[0];
+}
+
+static void recurse(int last_isle,
+ int nports /* excluding last_isle */,
+ int totaldist /* including last_isle */,
+ double last_estimate) {
+ ports[nports++]= last_isle;
+ double estimate= process_route(nports, totaldist, last_estimate);
+ if (nports >= MAX_ROUTELEN) return;
+
+ Neighbour *add;
+ for (add= get_neighbours(last_isle); add; add=add->next) {
+ int newdist= totaldist + add->dist;
+ if (newdist > max_dist) continue;
+
+ recurse(add->islandid, nports, newdist, estimate);
+ }
+}
+
+void search(int start_isle, int final_isle_spec,
+ Bucket ****buckets_base_io[GRANUS]) {
+ int granui;
+ for (granui=0; granui<GRANUS; granui++)
+ buckets_base[granui]=
+ ONDEMAND(*buckets_base_io[granui], granusz_fin[granui]);
+
+ final_isle= final_isle_spec <= 0 ? 0 : final_isle_spec;
+ recurse(start_isle,0,0,1e6);
+}
+
+int nhighscores[GRANUS][AP];
+HighScoreEntry *highscores[GRANUS][AP];
+int granus=GRANUS, granusz_fin[GRANUS], granusz_mid[GRANUS];
+
+int narches;
+char **archnames;
+int *islandid2arch;
+
+void setup_search(void) {
+ MCALLOC(neighbours, islandtablesz);
+
+ SQL_PREPARE(ss_neigh,
+ "SELECT biid, dist FROM routes WHERE aiid=?");
+
+ int max_narches=
+ sql_single_int(" SELECT count(*) FROM (\n"
+ " SELECT DISTINCT archipelago\n"
+ " FROM islands\n"
+ " )");
+ MCALLOC(archnames, max_narches);
+ MCALLOC_INITEACH(islandid2arch, islandtablesz, *this=-1);
+
+ sqlite3_stmt *archs;
+ SQL_PREPARE(archs,
+ " SELECT islandid, archipelago\n"
+ " FROM islands\n"
+ " ORDER BY archipelago");
+ while (SQL_STEP(archs)) {
+ int isle= sqlite3_column_int(archs,0);
+ const char *archname= (const char*)sqlite3_column_text(archs,1);
+ int arch;
+ for (arch=0; arch<narches; arch++)
+ if (!strcmp(archnames[arch], archname)) goto found;
+ assert(narches < max_narches);
+ arch= narches++;
+ archnames[arch]= masprintf("%s",archname);
+ found:
+ islandid2arch[isle]= arch;
+ }
+ sqlite3_finalize(archs);
+
+ granusz_fin[0]= granusz_mid[0]= narches;
+ granusz_fin[1]= islandtablesz; granusz_mid[1]= narches;
+ granusz_fin[2]= granusz_mid[2]= islandtablesz;
+}
--- /dev/null
+
+#include "rscommon.h"
+
+sqlite3 *db;
+sqlite3_stmt *ss_ipair;
+
+int islandtablesz;
+
+DEBUG_DEFINE_DEBUGF(sql);
+DEBUG_DEFINE_SOME_DEBUGF(sql,debug2f);
+
+static int busy_handler(void *u, int previous) {
+ debugf("[[DB BUSY %d]]",previous);
+ sysassert(! usleep(5000) );
+ return 1;
+}
+
+void setup_sql(const char *database) {
+ sqlite3_stmt *sst;
+
+ SQL_MUST( sqlite3_open(database, &db) );
+ SQL_MUST( sqlite3_busy_handler(db, busy_handler, 0) );
+
+ sst= sql_prepare("BEGIN","(begin)");
+ assert( !SQL_STEP(sst) );
+ sqlite3_finalize(sst);
+
+ islandtablesz= 1 + sql_single_int("SELECT max(islandid) FROM islands");
+ debugf("SQL islandtablesz=%d\n",islandtablesz);
+}
+
+int sql_single_int(const char *stmt) {
+ sqlite3_stmt *sst;
+ sst= sql_prepare(stmt,"(single int)");
+ assert( SQL_STEP(sst) );
+ int rv= sqlite3_column_int(sst,0);
+ sqlite3_finalize(sst);
+ return rv;
+}
+
+void sql_fatal(const char *stmt_what, int sqr, const char *act_what) {
+ fatal("SQL call failed, stmt %s code %d: %s: %s",
+ stmt_what, sqr, sqlite3_errmsg(db), act_what);
+}
+
+void sql_bind(sqlite3_stmt *ss, int index, int value,
+ const char *ss_what, const char *val_what) {
+ debug2f("SQL BIND %s #%d = %d = %s\n", ss_what, index, value, val_what);
+ int sqr= sqlite3_bind_int(ss, index, value);
+ if (sqr) sql_fatal(ss_what, sqr,
+ masprintf("bind #%d (%s)", index, val_what));
+}
+
+sqlite3_stmt *sql_prepare(const char *stmt, const char *what) {
+ sqlite3_stmt *ssr;
+ debugf("SQL PREPARE %s [[\n%s\n]]\n", what, stmt);
+ SQL_MUST( sqlite3_prepare(db, stmt, -1, &ssr, 0) );
+ return ssr;
+}
+
+int sql_step_distinct(sqlite3_stmt *ssh, const char *ssh_string,
+ const char *file, int line,
+ int *cols, int ncols, int nkeycols) {
+ for (;;) {
+ if (!sql_step(ssh, ssh_string, file, line)) return 0;
+
+ int i;
+ for (i=0; i<ncols; i++) {
+ int v= sqlite3_column_int(ssh, i);
+ if (v == cols[i]) continue;
+
+ assert(i<nkeycols);
+ cols[i++]= v;
+ for ( ; i<ncols; i++)
+ cols[i]= sqlite3_column_int(ssh, i);
+ return 1;
+ }
+ }
+}
+
+int sql_step(sqlite3_stmt *ssh, const char *ssh_string,
+ const char *file, int line) {
+ for (;;) {
+ int sqr;
+ sqr= sqlite3_step((ssh));
+ switch (sqr) {
+ case SQLITE_DONE:
+ debug2f("SQL %s DONE\n",ssh_string);
+ return 0;
+ case SQLITE_ROW:
+ if (DEBUGP(sql2)) {
+ int i;
+ fprintf(debug,"SQL %s R",ssh_string);
+ for (i=0; i<sqlite3_column_count(ssh); i++) {
+ fputc('\t',debug);
+ const char *txt= (const char*)sqlite3_column_text(ssh,i);
+ fputs(txt ? txt : "<null>", debug);
+ }
+ fputs("\n",debug);
+ }
+ return 1;
+ default: fatal("SQL step failed at %s:%d: code %d: %s: %s",
+ file, line, sqr, sqlite3_errmsg(db), ssh_string);
+ }
+ }
+}
--- /dev/null
+/**/
+
+#include <glpk.h>
+
+#include "rscommon.h"
+
+DEBUG_DEFINE_DEBUGF(value);
+DEBUG_DEFINE_SOME_DEBUGF(value2,debug2f);
+
+typedef struct { int mass, volu; } CommodInfo;
+static int commodstabsz;
+static CommodInfo *commodstab;
+
+static sqlite3_stmt *ss_ipair_dist;
+static sqlite3_stmt *ss_ite_buy, *ss_ite_sell;
+
+
+#define MAX_LEGS (MAX_ROUTELEN-1)
+
+typedef struct {
+ int commodid, src_price, dst_price;
+} Trade;
+
+#define TRADES_PER_BLOCK 10
+
+typedef struct TradesBlock {
+ struct TradesBlock *next;
+ int ntrades;
+ Trade t[TRADES_PER_BLOCK];
+} TradesBlock;
+
+static IslandPair ***ipairs; /* ipairs[sislandid][dislandid] */
+
+typedef struct IslandTradeEnd {
+ struct IslandTradeEnd *next;
+ /* key: */
+ int commodid, price;
+ /* values: */
+ int qty;
+ unsigned long generation;
+ int rownum;
+} IslandTradeEnd;
+
+typedef struct {
+ IslandTradeEnd *src, *dst;
+} IslandTradeEndHeads;
+
+IslandTradeEndHeads *itradeends;
+ /* itradeends[islandid].{src,dst}->commodid etc. */
+
+static LPX *lp;
+static unsigned long generation;
+
+static int nconstraint_rows;
+static int constraint_rows[1+2+3*MAX_LEGS];
+static double constraint_coeffs[1+2+3*MAX_LEGS];
+ /* dummy0, src, dst, for_each_leg( [mass], [volume], [capital] ) */
+
+static void add_constraint(int row, double coefficient) {
+ nconstraint_rows++; /* glpk indices start from 1 !!! */
+ constraint_rows [nconstraint_rows]= row;
+ constraint_coeffs[nconstraint_rows]= coefficient;
+}
+
+static IslandTradeEnd *get_ite(const Trade *t, IslandTradeEnd **trades,
+ int price) {
+ IslandTradeEnd *search;
+
+ for (search= *trades; search; search=search->next)
+ if (search->commodid==t->commodid && search->price==price)
+ return search;
+ abort();
+}
+
+static void avail_c(const Trade *t, IslandTradeEnd *ite,
+ int price, const char *srcdst,
+ int islandid, sqlite3_stmt *ss_ite) {
+ /* find row number of trade availability constraint */
+ IslandTradeEnd *search= ite;
+
+ if (search->generation != generation) {
+ search->rownum= lpx_add_rows(lp, 1);
+ lpx_set_row_bnds(lp, search->rownum, LPX_UP, 0, search->qty);
+
+ if (DEBUGP(value) || DEBUGP(check)) {
+ char *name= masprintf("%s_i%d_c%d_%d_all",
+ srcdst, islandid, t->commodid, price);
+ lpx_set_row_name(lp,search->rownum,name);
+
+ if (DEBUGP(check)) {
+ int nrows= lpx_get_num_rows(lp);
+ assert(search->rownum == nrows);
+ int i;
+ for (i=1; i<nrows; i++)
+ assert(strcmp(name, lpx_get_row_name(lp,i)));
+ }
+ free(name);
+ }
+ search->generation= generation;
+ }
+
+ add_constraint(search->rownum, 1.0);
+}
+
+static int setup_leg_constraints(double max_thing, int legs, const char *wh) {
+ int leg, startrow;
+ if (max_thing < 0 || !legs) return -1;
+ startrow= lpx_add_rows(lp, legs);
+ for (leg=0; leg<legs; leg++) {
+ int row= leg+startrow;
+ lpx_set_row_bnds(lp, row, LPX_UP, 0, max_thing);
+ if (DEBUGP(value)) {
+ char *name= masprintf("%s_%d",wh,leg);
+ lpx_set_row_name(lp,row,name);
+ free(name);
+ }
+ }
+ return startrow;
+}
+
+static void add_leg_c(int startrow, int leg, double value) {
+ if (startrow<=0) return;
+ assert(value > 0);
+ add_constraint(startrow+leg, value);
+}
+
+IslandPair *ipair_get_maybe(int si, int di) {
+ IslandPair **ipa;
+
+ assert(si < islandtablesz);
+ assert(di < islandtablesz);
+
+ if (!(ipa= ipairs[si])) return 0;
+ return ipa[di];
+}
+
+static IslandPair *ipair_get_create(int si, int di) {
+ IslandPair *ip, **ipa;
+
+ assert(si < islandtablesz);
+ assert(di < islandtablesz);
+
+ if (!(ipa= ipairs[si])) {
+ ipairs[si]= MCALLOC(ipa, islandtablesz);
+ }
+ if ((ip= ipa[di]))
+ return ip;
+
+ ipa[di]= NEW(ip);
+ ip->trades= 0;
+ ip->route_tail_value= -1;
+
+ if (si==di) ctr_islands_arbitrage++;
+ else ctr_ipairs_relevant++;
+
+ debug2f("VALUE ipair_get(i%d,i%d) running...\n", si,di);
+ SQL_MUST( sqlite3_bind_int(ss_ipair_dist, 1, si) );
+ SQL_MUST( sqlite3_bind_int(ss_ipair_dist, 2, di) );
+ assert(SQL_STEP(ss_ipair_dist));
+ int dist= sqlite3_column_int(ss_ipair_dist, 0);
+ ip->distance_loss_factor= pow(distance_loss_factor_per_league, dist);
+ sqlite3_reset(ss_ipair_dist);
+
+ return ip;
+}
+
+double value_route(int nislands, const int *islands, int exclude_arbitrage) {
+ int s,d;
+
+ ctr_subroutes_valued++;
+
+ /* We need to construct the LP problem. GLPK talks
+ * about rows and columns, which are numbered from 1.
+ *
+ * Each column is a `structural variable' ie one of the entries in
+ * the objective function. In our case the set of structural
+ * variable is, for each port, the set of Trades which collect at
+ * that island. (We use `port' to mean `specific visit to an
+ * island' so if an island appears more than once so do its trades.)
+ * We don't need to worry about crossing with all the possible
+ * delivery locations as we always deliver on the first port.
+ * We will call such a structural variable a Flow, for brevity.
+ *
+ * We iterate over the possible Flows adding them as columns as we
+ * go, and also adding their entries to the various constraints.
+ *
+ * Each row is an `auxiliary variable' ie one of the constraints.
+ * We have two kinds of constraint:
+ * - mass/volume/capital: one constraint for each sailed leg
+ * (unless relevant constraint is not satisfied)
+ * - quantity of commodity available for collection
+ * or delivery at particular price and island
+ * The former are numbered predictably: we have first all the mass
+ * limits, then all the volume limits, then all the capital limits
+ * (as applicable) - one for each leg, ie one for each entry
+ * in islands except the first.
+ *
+ * The latter are added as needed and the row numbers are stored in
+ * a data structure for later reuse.
+ */
+
+ assert(nislands >= 1);
+ assert(++generation);
+
+ assert(!lp);
+ lp= lpx_create_prob();
+ lpx_set_obj_dir(lp, LPX_MAX);
+ lpx_set_int_parm(lp, LPX_K_MSGLEV, DEBUGP(lp) ? 3 : 1);
+ lpx_set_int_parm(lp, LPX_K_PRESOL, 1);
+
+ if (DEBUGP(value)) {
+ lpx_set_prob_name(lp,(char*)"value_route");
+ lpx_set_obj_name(lp,(char*)"profit");
+ }
+
+ int legs= nislands-1;
+ int mass_constraints= setup_leg_constraints(max_mass, legs, "mass");
+ int volu_constraints= setup_leg_constraints(max_volu, legs, "volu");
+ int capi_constraints= setup_leg_constraints(max_capi, legs, "capi");
+
+ double delay_slot_loss_factor= 1.0;
+ for (s=0;
+ s<nislands;
+ s++, delay_slot_loss_factor *= LOSS_FACTOR_PER_DELAY_SLOT) {
+ int si= islands[s];
+
+ for (d= s + exclude_arbitrage;
+ d < nislands;
+ d++) {
+ int di= islands[d];
+ int already_d;
+ for (already_d=s+1; already_d<d; already_d++)
+ if (islands[already_d] == di)
+ /* visited this island already since we left s, uninteresting */
+ goto next_d;
+
+ if (d>s && di==si)
+ /* route has returned to si, no need to think more about s */
+ goto next_s;
+
+ /*----- actually add these trades to the LP problem -----*/
+
+ IslandPair *ip= ipair_get_maybe(islands[s], islands[d]);
+
+ if (!ip || !ip->trades)
+ goto next_d;
+
+ double loss_factor= delay_slot_loss_factor * ip->distance_loss_factor;
+ debugf(" SOME i%d#%d..i%d#%d dslf=%g dlf=%g lf=%g\n",
+ si,s, di,d,
+ delay_slot_loss_factor, ip->distance_loss_factor, loss_factor);
+
+ TradesBlock *block;
+ for (block=ip->trades; block; block=block->next) {
+ int inblock;
+ for (inblock=0; inblock<block->ntrades; inblock++) {
+ Trade *t= &block->t[inblock];
+
+ debugf(" TRADE i%d#%d..i%d#%d c%d %d-%d ",
+ si,s, di,d, t->commodid, t->src_price, t->dst_price);
+
+ IslandTradeEnd
+ *src_ite= get_ite(t, &itradeends[si].src, t->src_price),
+ *dst_ite= get_ite(t, &itradeends[di].dst, t->dst_price);
+
+ int qty= src_ite->qty < dst_ite->qty ? src_ite->qty : dst_ite->qty;
+ int maxprofit= qty * (t->dst_price - t->src_price);
+ debugf("maxprofit=%d ",maxprofit);
+ if (maxprofit < min_trade_maxprofit) {
+ debugf("trivial\n");
+ continue;
+ }
+
+ nconstraint_rows=0;
+
+ avail_c(t, src_ite, t->src_price, "src", si,ss_ite_sell);
+ avail_c(t, dst_ite, t->dst_price, "dst", di,ss_ite_buy);
+
+ int leg;
+ for (leg=s; leg<d; leg++) {
+ add_leg_c(mass_constraints,leg, commodstab[t->commodid].mass*1e-3);
+ add_leg_c(volu_constraints,leg, commodstab[t->commodid].volu*1e-3);
+ add_leg_c(capi_constraints,leg, t->src_price);
+ }
+
+ double unit_profit= t->dst_price * loss_factor - t->src_price;
+ debugf(" unit profit %f\n", unit_profit);
+ if (unit_profit <= 0) continue;
+
+ int col= lpx_add_cols(lp,1);
+ lpx_set_col_bnds(lp, col, LPX_LO, 0, 0);
+ lpx_set_obj_coef(lp, col, unit_profit);
+ lpx_set_mat_col(lp, col, nconstraint_rows,
+ constraint_rows, constraint_coeffs);
+
+ if (DEBUGP(value)) {
+ char *name= masprintf("c%d_p%d_%d_p%d_%d", t->commodid,
+ s, t->src_price, d, t->dst_price);
+ lpx_set_col_name(lp, col, name);
+ free(name);
+ }
+ } /* inblock */
+ } /* block */
+
+ /*----- that's done adding these trades to the LP problem -----*/
+
+ next_d:;
+ } /* for (d) */
+ next_s:;
+ } /* for (s) */
+
+ double profit= 0;
+
+ if (lpx_get_num_cols(lp)) {
+ ctr_subroutes_nonempty++;
+
+ if (DEBUGP(lp))
+ lpx_write_cpxlp(lp, (char*)DEBUG_DEV);
+
+ int ipr= lpx_simplex(lp);
+ assert(ipr==LPX_E_OK);
+
+ if (DEBUGP(lp))
+ lpx_print_sol(lp, (char*)DEBUG_DEV);
+
+ int lpst= lpx_get_status(lp);
+ assert(lpst == LPX_OPT);
+ profit= lpx_get_obj_val(lp);
+ }
+
+ lpx_delete_prob(lp);
+ lp= 0;
+
+ debugf(" %s %f\n",
+ exclude_arbitrage ? "base value" : "route value",
+ profit);
+ return profit;
+}
+
+#define TRADE_FROM \
+ " FROM sell, buy\n" \
+ " WHERE sell.commodid=buy.commodid AND sell.price < buy.price\n"
+
+static void read_trades(void) {
+ /* We would like to use DISTINCT but sqlite3 is too stupid
+ * to notice that it could use the index to do the DISTINCT
+ * which makes it rather slow. */
+ sqlite3_stmt *ss_trades;
+
+#define TRADE_COLS \
+ "sell.commodid, sell.islandid, sell.price, buy.islandid, buy.price"
+ SQL_PREPARE(ss_trades,
+ " SELECT " TRADE_COLS "\n"
+ TRADE_FROM
+ " ORDER BY " TRADE_COLS);
+
+ SQL_DISTINCT_DECL(cols,5);
+ while (SQL_DISTINCT_STEP(ss_trades,cols,5)) {
+ ctr_trades_loaded++;
+ IslandPair *ip= ipair_get_create(cols[1], cols[3]);
+ TradesBlock *block= ip->trades;
+ if (!block || ip->trades->ntrades >= TRADES_PER_BLOCK) {
+ NEW(block);
+ block->next= ip->trades;
+ ip->trades= block;
+ block->ntrades= 0;
+ }
+ Trade *trade= &block->t[block->ntrades];
+ trade->commodid= cols[0];
+ trade->src_price= cols[2];
+ trade->dst_price= cols[4];
+ block->ntrades++;
+ }
+ sqlite3_finalize(ss_trades);
+}
+
+static void read_islandtradeends(const char *bs, int srcdstoff) {
+
+#define TRADEEND_KEYCOLS "%s.commodid, %s.islandid, %s.stallid"
+ char *stmt= masprintf(" SELECT " TRADEEND_KEYCOLS ", %s.price, %s.qty\n"
+ TRADE_FROM
+ " ORDER BY " TRADEEND_KEYCOLS,
+ bs,bs,bs,bs,bs, bs,bs,bs);
+ char *stmt_id= masprintf("qtys (%s)",bs);
+ sqlite3_stmt *ss= sql_prepare(stmt, stmt_id);
+ free(stmt); free(stmt_id);
+
+ SQL_DISTINCT_DECL(cols,5);
+ while (SQL_DISTINCT_STEP(ss,cols,3)) {
+ ctr_quantities_loaded++;
+ IslandTradeEnd *search;
+
+ int commodid= cols[0];
+ int islandid= cols[1];
+ int price= cols[3];
+ int qty= cols[4];
+
+ IslandTradeEnd **trades= (void*)((char*)&itradeends[islandid] + srcdstoff);
+
+ for (search= *trades; search; search=search->next)
+ if (search->commodid==commodid && search->price==price)
+ goto found;
+ /* not found, add new end */
+
+ NEW(search);
+ search->commodid= commodid;
+ search->price= price;
+ search->next= *trades;
+ search->generation= 0;
+ search->qty= 0;
+ *trades= search;
+
+ found:
+ search->qty += qty;
+ }
+ sqlite3_finalize(ss);
+}
+
+void setup_value(void) {
+ sqlite3_stmt *sst;
+
+ commodstabsz= sql_single_int("SELECT max(commodid) FROM commods") + 1;
+ MCALLOC_INITEACH(commodstab, commodstabsz,
+ this->mass= this->volu= -1
+ );
+
+ SQL_PREPARE(sst,
+ "SELECT commodid,unitmass,unitvolume FROM commods");
+ while (SQL_STEP(sst)) {
+ ctr_commodities_loaded++;
+ int id= sqlite3_column_int(sst,0);
+ assert(id>=0 && id<commodstabsz);
+ commodstab[id].mass= sqlite3_column_int(sst,1);
+ commodstab[id].volu= sqlite3_column_int(sst,2);
+ }
+ sqlite3_finalize(sst);
+
+ MCALLOC(ipairs, islandtablesz);
+ MCALLOC(itradeends, islandtablesz);
+
+ SQL_PREPARE(ss_ipair_dist,
+ " SELECT dist FROM dists\n"
+ " WHERE aiid=? and biid=?");
+
+ read_trades();
+ read_islandtradeends("sell", offsetof(IslandTradeEndHeads, src));
+ read_islandtradeends("buy", offsetof(IslandTradeEndHeads, dst));
+}
+vessels
+#| Ship Name |Gun Size|Volume | Mass |
+ |Sloop |small |20,250 |13,500 |
+ |----------------+--------+-------+-------|
+ |Cutter |small |60,750 |40,500 |
+ |----------------+--------+-------+-------|
+ |Dhow |medium |20,250 |13,500 |
+ |----------------+--------+-------+-------|
+ |Longship |small |20,250 |13,500 |
+ |----------------+--------+-------+-------|
+ |Baghlah |medium |27,000 |18,000 |
+ |----------------+--------+-------+-------|
+ |Merchant brig |medium |135,000|90,000 |
+ |----------------+--------+-------+-------|
+ |War brig |medium |81,000 |54,000 |
+ |----------------+--------+-------+-------|
+ |Merchant galleon|large |405,000|270,000|
+ |----------------+--------+-------+-------|
+ |Xebec |medium |182,250|121,500|
+ |----------------+--------+-------+-------|
+ |War frigate |large |324,000|216,000|
+ |----------------+--------+-------+-------|
+ |Grand frigate |large |810,000|540,000|
+# From http://yppedia.puzzlepirates.com/Ship; when updating,
+# delete unused columns and check heading is the same as above.
+# If fields reordered must change parser in Commods.pm.
+
+shot
+ small 2
+ medium 3
+ large 4
+
commods
kraken's blood 1kg
%c dye 1kg
next if $h =~ m/^nocommods/;
}
next if $sfn =~ m/source-info/ && $h =~ m/^ocean\b/;
- next if $h =~ m/^client\b/;
+ next if $h =~ m/^client|^vessels|^shot\b/;
print $df $_, "\n" or die $!;
}
copyright message.
-</%doc><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+</%doc><%perl>
+
+use CommodsWeb;
+
+my $printable= printable($m);
+if ($printable =~ m/^pdf|^ps/) {
+ my $output;
+ my $got= $m->call_self(\$output);
+ if ($got) {
+ my @htargs= qw(htmldoc --continuous --gray --size 210x279mm
+ --left 1cm --right 1cm);
+ $printable =~ m/^[a-z]+/;
+ push @htargs, '-t',$&;
+ if ($printable =~ m/2$/) {
+ push @htargs, qw(--nup 2);
+ }
+ push @htargs, qw(-);
+
+ my $tmpfile= IO::File::new_tmpfile();
+ print $tmpfile $output or die $!;
+ $tmpfile->flush() or die $!;
+ seek $tmpfile,0,0 or die $!;
+ my $htmldoc= open HTMLDOC, "-|";
+ defined $htmldoc or die $!;
+ if (!$htmldoc) {
+ eval {
+ $ENV{'HTMLDOC_NOCGI'}=1;
+ open STDIN, '<&', $tmpfile or die $!;
+
+ exec @htargs;
+ die $!;
+ };
+ print STDERR "HTMLDOC FAILURE $@";
+ _exit(1);
+ }
+ my ($data,$read);
+ $r->content_type($printable eq 'pdf' ? 'application/pdf' :
+ 'application/postscript');
+ while ($read= read HTMLDOC,$data,32768) { print $data; }
+ defined $read or die $!;
+ $?=0; $!=0; close HTMLDOC or die "$! $? $output ";
+ return;
+ }
+}
+set_ctype_utf8();
+$r->content_type('text/html; charset=UTF-8');
+
+</%perl><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<!--
This HTML is generated by the YARRG website, which is
<& copyrightdate &>.
covered by the AGPL.
-->
-% $m->call_next;
-
-<%init>
-use CommodsWeb;
-set_ctype_utf8();
-$r->content_type('text/html; charset=UTF-8');
-</%init>
+% $m->call_next();
This Mason component simply defines how to interpret capacities.
</%doc>
-
-<%attr>
-</%attr>
-
-<%method preparse>
+<%method execute>
<%args>
-$h
+$string
+$dbh
+$debugf
</%args>
<%perl>
-my $def= sub {
- my ($what,$val) = @_;
- if (defined $h->{$what}) {
- $h->{Emsg}= "Multiple definitions of maximum $what.";
+my $commodsth;
+
+my @mv_names= qw(mass volume);
+my @mv_units= qw(kg l);
+
+my (@mv)= (undef,undef);
+return ('',@mv) unless $string =~ m/\S/;
+
+my @canon= ();
+my ($signum,$signopstr)= (+1,undef);
+my $show_answer=0;
+my $first_term=1;
+my $last_signopstr= 'NONE';
+
+my $canon_numeric= sub {
+ my ($val,$mvi) = @_;
+ sprintf "%g%s", $val, $mv_units[$mvi];
+};
+
+my $parse_values= sub {
+ local ($_) = @_;
+ $debugf->("TERM VALUES '$_'");
+ $_ .= ' ';
+ my $def= sub {
+ my ($mvi,$val) = @_;
+ if ($first_term) {
+ expected_error("Initial term specifies".
+ " $mv_names[$mvi] more than once.")
+ if defined $mv[$mvi];
+ $mv[$mvi]= $val;
+ } else {
+ expected_error("Cannot add or subtract mass to/from volume")
+ unless defined $mv[$mvi];
+ $mv[$mvi] += $signum * $val;
+ }
+ push @canon, $canon_numeric->($val,$mvi);
+ };
+ while (m/\S/) {
+ $debugf->("VALUE '$_'");
+ my $iqtyrex= '[1-9] \d{0,8}';
+ my $fqtyrex= '\d{1,9} \. \d{0,3} |' . $iqtyrex;
+ if (s/^( $fqtyrex ) \s* kg \s+ //xo) { $def->(0, $1 ); }
+ elsif (s/^( $fqtyrex ) \s* t \s+ //xo) { $def->(0, $1 * 1000.0 ); }
+ elsif (s/^( $fqtyrex ) \s* l \s+ //xo) { $def->(1, $1 ); }
+ elsif (s/^( $fqtyrex ) \s* kl \s+ //xo) { $def->(1, $1 * 1000.0 ); }
+ elsif (s/^( $iqtyrex ) \s* ([a-z ]+) \s+ //xo) {
+ my ($qty,$spec) = ($1,$2);
+ $debugf->("VALUE COMMOD $qty '$spec'");
+ expected_error("Capacity specification must start with".
+ " ship size or amount with units")
+ if $first_term;
+ $commodsth ||=
+ $dbh->prepare("SELECT commodname,unitmass,unitvolume
+ FROM commods WHERE commodname LIKE ?");
+ my ($emsg,$commod,@umv)=
+ dbw_lookup_string($spec,$commodsth,1,0,0,
+ "No commodity or unit matches \`$spec'",
+ "Ambiguous commodity (or unit) \`$spec'",
+ undef);
+ expected_error($emsg) if defined $emsg;
+ $debugf->("VALUE COMMOD FOUND '$commod' @umv");
+ foreach my $mvi (0,1) {
+ next unless defined $mv[$mvi];
+ $mv[$mvi] += $signum * $qty * $umv[$mvi] * 0.001;
+ }
+ push @canon, sprintf "%d", $qty;
+ push @canon, $commod;
+ } else {
+ s/\s+$//;
+ expected_error("Did not understand value \`$_'");
}
- 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);
+my $parse_term= sub {
+ local ($_) = @_;
+ $debugf->("TERM '$_' signum=$signum");
+ s/^\s+//; s/\s+$//;
+ expected_error("empty term in capacity") unless m/\S/;
+ if (m/^\s*(\d{1,2}(?:\.\d{0,4})?)\%\s*$/) {
+ $debugf->("TERM PERCENT $1");
+ expected_error("percentage may not be first item")
+ if $first_term;
+ my $pct= 100.0 + $signum * $1;
+ foreach (@mv) {
+ next unless defined;
+ $_ *= $pct / 100.0;
+ }
+ push @canon, sprintf "%g%%", $pct;
+ } elsif (!m/[^a-z]/) {
+ $debugf->("TERM NAME");
+ expected_error("Name (should be unit or commodity) \`$_'".
+ " without preceding quantity")
+ unless $first_term;
+ my $sth= $dbh->prepare("SELECT name,mass,volume".
+ " FROM vessels WHERE name LIKE ?");
+ my ($emsg,$ship,@smv)=
+ dbw_lookup_string($_,$sth,1,1,2,
+ "Ship name `$_' not understood.",
+ "Too many matching ship types.",
+ sub { "Ambiguous - could be $_[0]" });
+ expected_error($emsg) if defined $emsg;
+ $debugf->("TERM NAME SHIP '$ship' @smv");
+ $show_answer= 1;
+ @mv = @smv;
+ push @canon, $ship;
} else {
- ${ $h->{Emsg} }= "Cannot understand capacity \`$_'.";
- last;
+ $parse_values->($_);
}
+ $first_term= 0;
+};
+
+while ($string =~ s/^(.*?)(\bminus\b|-|\bplus\b|\+)//) {
+ my ($lhs)= ($1);
+ my @nextsign= $2 =~ m/^p|^\+/ ? (+1,'+') : (-1,'-');
+ $show_answer= 1;
+ $debugf->("GROUP S='$2'");
+ $parse_term->($lhs);
+ ($signum,$signopstr)= @nextsign;
+ push @canon, ($last_signopstr=$signopstr)
+ if $signopstr ne $last_signopstr;
}
-</%perl>
-</%method>
+$parse_term->($string);
-<%method postquery>
-<%args>
-$h
-</%args>
-<%perl>
+my $canon= join ' ', @canon;
-if (defined $h->{'mass'} or defined $h->{'volume'}) {
- @{ $h->{Results} } = [ $h->{'mass'}, $h->{'volume'} ];
+if ($show_answer) {
+ $canon .= " [=";
+ foreach my $mvi (0,1) {
+ next unless defined $mv[$mvi];
+ $canon .= ' '.$canon_numeric->($mv[$mvi], $mvi);
+ }
+ $canon .= "]";
+}
- ${ $h->{Canon} }=
- 'mass limit: '.(defined $h->{'mass'} ? $h->{'mass'} .'kg' : 'none').'; '.
- 'volume limit: '.(defined $h->{'volume'} ? $h->{'volume'} .'l' : 'none').'.';
+$debugf->("FINISHING canon='$canon'");
+
+foreach my $mvi (0,1) {
+ next unless defined $mv[$mvi];
+ next if $mv[$mvi] >= 0;
+ expected_error(sprintf "%s limit is negative: %s",
+ ucfirst($mv_names[$mvi]), $canon_numeric->($mv[$mvi], $mvi));
}
+return ($canon, @mv);
+
</%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 capital.
+
+</%doc>
+
+<%method execute>
+<%args>
+$string
+$dbh
+$debugf
+</%args>
+<%perl>
+
+$_= $string;
+s/^\s+//; s/\s+$//;
+
+my $capital;
+my $canon;
+
+if (!m/\S/) {
+ $canon= '';
+} elsif (m/^([1-9]\d*)( PoE)?$/i) {
+ $capital= $1;
+ $canon= "$capital PoE";
+} else {
+ expected_error("Cannot understand capital \`$_'.");
+}
+
+return ($canon,$capital);
+
+</%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 distances.
+
+</%doc>
+
+<%attr>
+significant_nonempty => 1
+</%attr>
+
+<%method execute>
+<%args>
+$string
+$dbh
+$debugf
+</%args>
+
+<%perl>
+
+$_= $string;
+s/^\s+//; s/\s+$//;
+
+my $leagues;
+my $canon;
+
+if (!m/\S/) {
+ $leagues= 20;
+ $canon= '(default: 20 leagues)';
+} elsif (m/^([1-9]\d*)( leagues)?$/i) {
+ $leagues= $1;
+ $canon= "$leagues leagues";
+} else {
+ expected_error("Cannot understand distance \`$_'.");
+}
+
+return ($canon,$leagues);
+
+</%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 look up island names.
+ It is called by qtextstring.
+
+</%doc>
+
+<%attr>
+multiple => 1
+maxambig => 5
+</%attr>
+
+<%method sqlstmt>
+ SELECT islandname,islandid,NULL
+ FROM islands WHERE islandname LIKE ?
+</%method>
+
+<%method nomatch>
+ no island matches "<% $ARGS{spec} |h %>"
+</%method>
+
+<%method ambiguous>
+ ambiguous island "<% $ARGS{spec} |h %>",
+ could be <% $ARGS{couldbe} |h %>
+</%method>
+
+<%method manyambig>
+
+</%method>
sponsored by Three Rings.
- This Mason component simply defines how to interpret capacities.
+ This Mason component simply defines how to interpret losses per league.
</%doc>
-
-<%attr>
-</%attr>
-
-<%method preparse>
+<%method execute>
<%args>
-$h
+$string
+$dbh
+$debugf
</%args>
<%perl>
-$_= ${ $h->{String} };
+$_= $string;
s/^\s+//; s/\s+$//;
-my $res= sub {
- my ($pct,$str) = @_;
- push @{ $h->{Results} }, [ $pct ];
- ${ $h->{Canon} }= "$str per league";
-};
+my ($pct,$str);
if (!m/\S/) {
+ $str= '';
} elsif (m/^(\d{1,2}(?:\.\d{0,5})?)\%$/) {
- $res->( $1 * 1.0, sprintf("%g%%", $1) );
+ $pct= $1 * 1.0;
+ $str= sprintf("%g%%", $1);
} elsif (m/^1\s*\/\s*([1-9]\d{0,4})/) {
- $res->( 100.0/$1, sprintf("1/%d", $1) );
+ $pct= 100.0/$1;
+ $str= sprintf("1/%d", $1);
} else {
- ${ $h->{Emsg} }= "Cannot understand loss per league \`$_'.";
- return;
+ expected_error("Cannot understand loss per league \`$_'.");
}
+return ("$str per league", $pct);
+
</%perl>
</%method>
-Copyright 2009 Ian Jackson, Clare Boothby
\ No newline at end of file
+Copyright 2009 Ian Jackson, Clare Boothby, Steve Early
\ No newline at end of file
</%doc>
-<html><head><title>YARRG (Yet Another Revenue Research Gatherer)</title>
+<html lang="en"><head>
+<title>YARRG (Yet Another Revenue Research Gatherer)</title>
</head><body>
<a href="lookup">YARRG</a> -
Yet Another Revenue Research Gatherer
|
-<b>development</b>
-|
<a href="intro">introduction</a>
|
<a href="docs">documentation</a>
+|
+<b>development</b>
<h1>YARRG development, contribution and troubleshooting</h1>
licences for details. Not only the client but also the website code
is Free. The yarrg client, support files, and so forth are under
the GNU GPL (v3 or later); the website is under the GNU Affero GPL (v3
-or later). </p>
+or later).
<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 YARRG code. Please just ask us - it's just
-a matter of us adding your database instance's special email address
-to our alias file.
+the format expected by the YARRG code. Please just ask us - at our
+end it's just a matter of us adding your database instance's special
+email address to our alias file.
<p>
</%doc>
-<html><head><title>Website documentation - YARRG</title>
+<html lang="en"><head><title>Website documentation - YARRG</title>
</head><body>
<a href="lookup">YARRG</a> -
Yet Another Revenue Research Gatherer
|
-<a href="devel">development</a>
-|
<a href="intro">introduction</a>
|
<b>documentation</b>
+|
+<a href="devel">development</a>
<h1>Looking up data in YARRG</h1>
route optimiser, it will generate a complete voyage plan, telling you
which goods to buy and sell where at which stalls and prices.
-<p>
+<p><a name="arbitrage"></a>
If you specify only one island or one archipelago, the site shows only
arbitrage trades. If you want single-hop trades within an
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.
-<h3>Vessel capacity</h3>
+<h3><a name="capacity">Vessel capacity</a></h3>
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
<p>
-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.
+So you should specify your vessel capacity. You can enter things
+like:
+<dl>
+<dt>sloop
+<dd>The capacity of a sloop, leaving no allowance for rum and shot
+<dt>wb - 1%
+<dd>The capacity of a war brig minus 1%
+<dt>13t 20kl
+<dd>13 tonnes (13,000kg), 20 kilolitres (20,000l)
+<dt>sloop - 10 small 40 rum
+<dd>The capacity of a sloop which remains after
+ 10 small shot and 40 rum are loaded
+<dt>2t plus 500kg minus 200kg
+<dd>2300kg, with no limit on volume
+</dl>
+Evaluation is strictly from left to right.
+
+<p>
+
+More formally:
+<pre>
+ capacity-string := [ first-term term* ]
+ term := ('+' | '-' | 'plus' | 'minus') (value+ | number'%')
+ value := mass | volume
+ | integer commodity-name-or-abbreviation
+ mass := number ('t' | 'kg')
+ volume := number ('kl' | 'l')
+ first-term := mass | volume | mass volume | volume mass
+ | ship-name-or-abbreviation
+</pre>
+
+If the first term specifies only one of mass or volume, all the
+subsequent terms may only adjust that same value.
-<h3>Expected losses</h3>
+<h3><a name="losses">Expected losses</a></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
<p>
-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.
+Trades whose margin is less than the expected loss are never included
+in the suggested plan. 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, if it's not
+possible to do both.
<p>
-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.
+As a guide: you may expect to lose between 0.01% and 1% per league.
+For example 0.1% would correspond to losing one fight to brigands (who
+take 10% if they win) for every 100 leagues sailed.
<p>
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
+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="capital">Available capital</a></h3>
+
+If you don't specify the amount of capital you have available to
+invest in the voyage, the trading plan will assume that your capital
+is unlimited. If you specify an amount in PoE here, the trading plan
+will never require you to spend more than that amount on commodities.
+
+<p>
+
+The trading plan does not take into account accumulated profits from
+each leg of the journey when applying the available capital
+constraint. For example, if you specify a journey from A to B to C
+and a capital limit of 10000 PoE, the trading plan will not tell you
+to buy 1000 peas at A for 10 PoE each, sail them to B and sell all of
+them for 20 PoE each, and then buy 2000 beans at B for 10 PoE each and
+sail them to C to sell for 20 PoE each even if such a trade would in
+fact be possible. In practice this is unlikely to be a problem!
+
<& footer &>
This Mason component is helpful for debugging and developing. It
outputs plain HTML tables eg for SQL query results. You can either:
- <& dumptable, sth = $executed_statement_handle &>
+ <& dumptable, sth => $executed_statement_handle &>
in which case it will consume the results of the statement and
print them unconditionally, or do the equivalent of:
<& dumptable:start, sth => $sth, [ qa => $qa ] &> or
--- /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 entry fields for route planning
+ advanced parameters (capacity limits, etc).
+
+ Some useful parameters are in %$routeparams:
+ ${ $routeparams->{EmsgRef} }
+ $routeparams->{SayRequiredCapacity}
+ The results are returned there:
+ $routeparams->{LossPerLeaguePct}
+ $routeparams->{MaxMass}
+ $routeparams->{MaxVolume}
+ $routeparams->{MaxCapital}
+
+
+</%doc>
+<%args>
+$qa
+$dbh
+$routeparams
+</%args>
+
+<%method advanced>
+<strong>Advanced options - you may leave these blank:</strong>
+<p>
+</%method>
+
+% if (!$routeparams->{SayRequiredCapacity}) {
+<& SELF:advanced &>
+% }
+
+<table><tr><td>
+
+Vessel or capacity:
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
+ thingstring => 'capacitystring', emsgstore => $routeparams->{EmsgRef},
+ helpref => 'capacity',
+ onresults => sub {
+ ($routeparams->{MaxMass}, $routeparams->{MaxVolume}) = @_;
+ }
+ &>
+ size=40
+</&>
+
+</table>
+% if ($routeparams->{SayRequiredCapacity}) {
+<& SELF:advanced &>
+% }
+<table><tr>
+
+<td>Available capital:
+
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ac',
+ thingstring => 'capitalstring', emsgstore => $routeparams->{EmsgRef},
+ helpref => 'capital',
+ onresults => sub { ($routeparams->{MaxCapital})= @_; }
+ &>
+ size=9
+</&>
+
+<td>
+
+
+
+<td>
+Expected losses:
+
+<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll',
+ thingstring => 'lossperleague', emsgstore => $routeparams->{EmsgRef},
+ helpref => 'losses',
+ onresults => sub { ($routeparams->{LossPerLeaguePct})= @_; }
+ &>
+ size=9
+</&>
+
+<% $m->content %>
+
+</table>
--- /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 form contents for selecting a commodity.
+
+
+</%doc>
+<%args>
+$qa
+$dbh
+$emsg_r
+
+$commodname_r
+$cmid_r
+</%args>
+
+%#---------- textbox, user enters commodity as string ----------
+% if (!$qa->{Dropdowns}) {
+
+Enter commodity (abbreviations are OK):<br>
+
+<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
+ thingstring => 'commodstring', prefix => 'cm',
+ onresults => sub { ($$commodname_r,$$cmid_r)= @{ $_[0] } if @_ }
+ &>
+ size=80
+</&>
+
+% } else { #---------- dropdowns, user selects from menus ----------
+
+% my $sth= $dbh->prepare("SELECT commodname,commodid FROM commods
+% ORDER BY commodname");
+% $sth->execute();
+% my $row;
+<select name="commodid">
+<option value="">Select commodity...</option>
+% while ($row= $sth->fetchrow_arrayref) {
+% my $selected= $qa->{'commodid'} eq $row->[1] ? 'selected' : '';
+<option value="<% $row->[1] %>" <% $selected %>><% $row->[0] |h %></option>
+% ($$commodname_r,$$cmid_r) = @$row if $selected;
+% }
+</select>
+<p>
+
+% } #---------- end of dropdowns, now common middle of page code ----------
--- /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 form contents for selecting a list
+ of locations (eg, a route).
+
+
+</%doc>
+<%args>
+$qa
+$dbh
+$emsg_r
+$warningfs_r
+
+$enterwhat
+$islandids_r
+$archipelagoes_r
+</%args>
+
+%#---------- textbox, user enters route as string ----------
+% if (!$qa->{Dropdowns}) {
+
+<% $enterwhat %>
+% if (defined($archipelagoes_r)) {
+(islands, or archipelagoes,
+% } else {
+(islands
+% }
+separated by |s or commas; abbreviations are OK):<br>
+
+<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r,
+ thingstring => defined($archipelagoes_r) ? 'routestring' : 'islandstring',
+ prefix => 'rl',
+ onresults => sub {
+ foreach (@_) {
+ my ($canonname, $island, $arch) = @$_;
+ push @$islandids_r, $island;
+ push @$archipelagoes_r, defined $island ? undef : $arch
+ if defined $archipelagoes_r;
+ }
+ }
+ &>
+ size=80
+</&>
+
+% } else { #---------- dropdowns, user selects from menus ----------
+
+<%perl>
+my %islandid2;
+my ($sth,$row);
+my @archlistdata;
+my %islandlistdata;
+$islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
+
+my $optionlistmap= sub {
+ my ($optlist, $selected) = @_;
+ my $out='';
+ foreach my $entry (@$optlist) {
+ $out.= sprintf('<option value="%s" %s>%s</option>',
+ encode_entities($entry->[0]),
+ defined $selected && $entry->[0] eq $selected
+ ? 'selected' : '',
+ encode_entities($entry->[1]));
+ }
+ return $out;
+};
+
+$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
+ ORDER BY archipelago;");
+$sth->execute();
+
+while ($row=$sth->fetchrow_arrayref) {
+ my ($arch)= @$row;
+ push @archlistdata, [ $arch, $arch ];
+ $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
+}
+
+$sth= $dbh->prepare("SELECT islandid,islandname,archipelago
+ FROM islands
+ ORDER BY islandname;");
+$sth->execute();
+
+while ($row=$sth->fetchrow_arrayref) {
+ my $arch= $row->[2];
+ push @{ $islandlistdata{'none'} }, [ @$row ];
+ push @{ $islandlistdata{$arch} }, [ @$row ];
+ $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
+}
+
+my %resetislandlistdata;
+foreach my $arch (keys %islandlistdata) {
+ $resetislandlistdata{$arch}=
+ $optionlistmap->($islandlistdata{$arch}, '');
+}
+
+</%perl>
+
+<&| script &>
+ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
+function ms_Setarch(dd) {
+ debug('ms_SetArch '+dd+' arch='+arch);
+ var arch= document.getElementsByName('archipelago'+dd).item(0).value;
+ var got= ms_lists[arch];
+ if (got == undefined) return; // unknown arch ? hrm
+ debug('ms_SetArch '+dd+' arch='+arch+' got ok');
+ var select= document.getElementsByName('islandid'+dd).item(0);
+ select.innerHTML= got;
+ debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
+}
+</&script>
+
+<table style="table-layout:fixed; width:90%;">
+
+<tr>
+% for my $dd (0..$qa->{Dropdowns}-1) {
+<td>
+<select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
+<option value="none">Whole ocean</option>
+<% $optionlistmap->(\@archlistdata, $qa->{"archipelago$dd"}) %></select></td>
+% }
+</tr>
+
+<tr>
+% for my $dd (0..$qa->{Dropdowns}-1) {
+% my $arch= $qa->{"archipelago$dd"};
+% $arch= 'none' if !defined $arch;
+<td>
+<select name="islandid<% $dd %>">
+<% $optionlistmap->($islandlistdata{$arch}, $qa->{"islandid$dd"}) %>
+</select></td>
+% }
+</tr>
+
+</table>
+
+<%perl>
+
+my $argorundef= sub {
+ my ($dd,$base) = @_;
+ my $thing= $qa->{"${base}${dd}"};
+ $thing= undef if defined $thing and $thing eq 'none';
+ return $thing;
+};
+
+for my $dd (0..$qa->{Dropdowns}-1) {
+ my $arch= $argorundef->($dd,'archipelago');
+ my $island= $argorundef->($dd,'islandid');
+ next unless defined $arch or defined $island;
+ if (defined $island and defined $arch) {
+ my $ii= $islandid2{$island};
+ my $iarch= $ii->{Arch};
+ if ($iarch ne $arch) {
+ push @$warningfs_r, sub {
+</%perl>
+ Specified archipelago <% $arch %> but
+ island <% $ii->{Name} %>
+ which is in <% $iarch %>; using the island.<p>
+<%perl>
+ };
+ }
+ $arch= undef;
+ }
+ push @$archipelagoes_r, $arch;
+ push @$islandids_r, $island;
+}
+
+</%perl>
+<p>
+
+% }
You may share and modify the code and the
website, according to the terms of the GNU General Public Licence and
the GNU Affero General Public Licence respectively (v3 or later).
+Note that there is <strong>NO WARRANTY</strong>.
% if (!$isdevel) {
Please see the <a href="devel">YARRG Development webpage</a> for
details of how to obtain the client and server code and full details
</%doc>
-<html><head><title>YARRG (Yet Another Revenue Research Gatherer)</title>
+<html lang="en"><head>
+<title>YARRG (Yet Another Revenue Research Gatherer)</title>
</head><body>
<a href="lookup">YARRG</a> -
Yet Another Revenue Research Gatherer
|
-<a href="devel">development</a>
-|
<b>introduction</b>
|
<a href="docs">documentation</a>
+|
+<a href="devel">development</a>
<h1>Introduction to YARRG</h1>
<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>.
+<a href="http://pctb.ilk.org/">PCTB testing server</a>.
<p>
Before => 'Query: ',
Values => [ [ 'route', 'Trades for route' ],
[ 'commod', 'Prices for commodity' ],
+ [ 'offers', 'Offers at location' ],
+ [ 'routesearch', 'Find profitable route' ],
[ 'age', 'Data age' ] ]
}, { Name => 'BuySell',
Before => '',
[ 1, 'Show individual stalls' ],
],
QuerySpecific => 1,
+ }, { Name => 'RouteSearchType',
+ Before => 'Type of routes to search for: ',
+ Values => [ [ 0, 'Open-ended' ],
+ [ 1, 'Circular' ],
+ ],
+ QuerySpecific => 1,
});
foreach my $var (@vars) {
% }
</%method>
-<html><head><title><% ucfirst $ahtml{Query} %> - YARRG</title>
+<html lang="en"><head><title><% ucfirst $ahtml{Query} %> - YARRG</title>
<style type="text/css">
body {
color: #000000;
</&script>
</head><body>
+% if (!printable($m)) {
<a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
Yet Another Revenue Research Gatherer
|
-<a href="devel">development</a>
-|
<a href="intro">introduction</a>
|
<a href="docs">documentation</a>
+|
+<a href="devel">development</a>
<p>
+% }
<%perl>
foreach my $var (@vars) {
foreach my $var (keys %ARGS) {
next unless $var =~
- m/^(?: (?:route|commod|capacity)string |
- lossperleague |
+ m/^(?: (?:route|commod|capacity|capital|island)string |
+ lossperleague | distance |
commodid |
islandid \d |
archipelago \d |
my $prselector_core= sub {
my ($var)= @_;
+ return if printable($m);
my $name= $var->{Name};
my $lname= lc $var->{Name};
my $delim= $var->{Before};
$debug => 0
</%args>
+% if (!printable($m)) {
<hr>
+% }
<& "query_$styles{Query}", %baseqf, %queryqf, %styles,
- quri => $quri, dbh => $dbh,
+ quri => $quri, dbh => $dbh, queryqf => \%queryqf, allargs => \%ARGS,
prselector => $prselector,
someresults => $someresults,
emsgokorprint => sub {
$dbh
$thingstring
$emsgstore
-$perresult
+$onresults
$prefix => 'ts';
+$helpref => undef;
</%args>
<%perl>
my $stringval= $qa->{$thingstring};
$stringval='' if !defined $stringval;
my $p= $prefix.'_';
+my $checker= $m->fetch_comp("check_${thingstring}");
+my $significant_nonempty= $checker->attr_exists('significant_nonempty');
+
</%perl>
<&| script &>
<%$p%>timeout=false;
<%$p%>request=false;
-<%$p%>done='';
+<%$p%>done=<% $significant_nonempty ? "null" : "''" %>;
<%$p%>needed='';
function <%$p%>Later(){
window.clearTimeout(<%$p%>timeout);
register_onload(<%$p%>Needed);
</&script>
+% if (!printable($m)) {
<input type="text" <% $m->content %>
id="<% $thingstring %>" name="<% $thingstring %>"
onchange="<%$p%>Needed();" onkeyup="<%$p%>Later();"
value="<% $stringval |h %>"
- >
+ ><% defined($helpref) ? "<a href=\"docs#$helpref\">[?]</a>" : '' %>
<br>
<div id="<%$p%>results"> </div><br>
+% } else {
+<kbd><strong><% $stringval |h %></strong></kbd>
+<br>
+<br>
+% }
<%perl>
-if (length $thingstring) {
- my ($emsg,$canonstring,$results)= $m->comp('qtextstringcheck',
+if ($significant_nonempty || length $thingstring) {
+ my ($emsg,$canonstring,@results)= $m->comp('qtextstringcheck',
what => $thingstring,
ocean => $qa->{Ocean},
string => $stringval,
$$emsgstore='' unless defined $$emsgstore;
$$emsgstore .= $emsg. ' ';
}
-
- foreach my $entry (@$results) {
-#print STDERR "qts entry perresult \`@$entry'\n";
- $perresult->(@$entry);
- }
+ $onresults->(@results);
}
</%perl>
$string
$what
$dbh => undef
+$debug => 0
</%args>
<%flags>
use Data::Dumper;
use HTML::Entities;
use CommodsWeb;
+use Scalar::Util qw(blessed);
die if $what =~ m/[^a-z]/;
my $chk= $m->fetch_comp("check_${what}");
my $mydbh;
$dbh ||= ($mydbh= dbw_connect($ocean));
-#print STDERR "qtsc string=\`$string'\n";
+my $debugf= !$debug ? sub { } : sub {
+ print "@_\n";
+};
-my ($sth, @sqlstmt_qs);
-if ($chk->method_exists('sqlstmt')) {
- my $sqlstmt= $chk->scall_method("sqlstmt");
- $sth= $dbh->prepare($sqlstmt);
- @sqlstmt_qs= $sqlstmt =~ m/\?/g;
-}
+$debugf->("QTSC STRING '$string'");
my $emsg= '';
my @results;
-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);
-}
+$string =~ s/^\s*//;
+$string =~ s/\s$//;
+$string =~ s/\s+/ /g;
-no warnings qw(exiting);
-
-foreach my $each (@specs) {
- $each =~ s/^\s*//; $each =~ s/\s*$//; $each =~ s/\s+/ /g;
- next if !length $each;
- my $err= sub { $emsg= $_[0]; last; };
- my %m;
- my $results;
- foreach my $pat ("$each", "$each\%", "\%$each\%") {
- $sth->execute(($pat) x @sqlstmt_qs);
- $results= $sth->fetchall_arrayref();
- last if @$results==1;
- map { $m{ $_->[0] }=1 } @$results;
- $results= undef;
+if ($chk->method_exists('execute')) {
+ ($canontext, @results)= eval {
+ $chk->call_method('execute',
+ dbh => $dbh, string => $string,
+ debugf => $debugf);
+ };
+ if ($@) {
+ die unless blessed $@ && $@->isa('CommodsWeb::ExpectedError');
+ $emsg= $@->emsg();
}
- if (!$results) {
- if (!%m) {
- $err->($chk->scall_method("nomatch",
- spec => $each));
- } elsif (keys(%m) > $chk->attr('maxambig')) {
- $err->($chk->scall_method("manyambig"));
- } else {
- $err->($chk->scall_method("ambiguous",
- spec => $each,
- couldbe => join(', ', sort keys %m)));
+} else {
+ my $sqlstmt= $chk->scall_method("sqlstmt");
+ my $sth= $dbh->prepare($sqlstmt);
+ my @sqlstmt_nqs= $sqlstmt =~ m/\?/g;
+ my $sqlstmt_nqs= @sqlstmt_nqs;
+
+ my @specs= $chk->attr('multiple')
+ ? (split m#\s*[/|,]\s*#, $string)
+ : ($string);
+
+ foreach my $each (@specs) {
+ next unless $each =~ m/\S/;
+ my ($temsg, @tresults) =
+ dbw_lookup_string($each,
+ $sth, $sqlstmt_nqs,
+ $chk->attr_exists('abbrev_initials'),
+ $chk->attr('maxambig'),
+ $chk->scall_method("nomatch", spec => $each),
+ $chk->scall_method("manyambig"),
+ sub {
+ $chk->scall_method("ambiguous",
+ spec => $each, couldbe => $_[1])
+ });
+ if (defined $temsg) {
+ $emsg= $temsg;
+ last;
}
- }
- push @results, $results->[0];
-};
+ push @results, [ @tresults ];
+ };
+}
if (!defined $canontext) {
$canontext= join ' | ', map { $_->[0] } @results;
}
-if ($chk->method_exists('postquery')) {
- $chk->call_method('postquery', h => $hooks);
-}
$emsg='' if !defined $emsg;
@results=() if length $emsg;
-#print STDERR "qtsc emsg=\`$emsg' results=\`@results'\n";
+$debugf->("QTSC EMSG='$emsg' RESULTS='@results'");
if ($format =~ /json/) {
- $r->content_type($ctype or $format);
+ $ctype ||= $format;
+ die unless grep { $_ eq $ctype }
+ qw(application/json text/plain text/xml);
+ $r->content_type($ctype);
my $jobj= {
success => 1*!length $emsg,
show => (length $emsg ? $emsg :
return $emsg,
$canontext,
- [ @results ];
+ @results;
</%perl>
<%perl>
my $now= time;
-my $row;
my $sth= $dbh->prepare("SELECT archipelago, islandid, islandname, timestamp
FROM uploads NATURAL JOIN islands
- ORDER BY archipelago, islandid");
+ ORDER BY archipelago, islandname");
$sth->execute();
</%perl>
+<& SELF:pageload &>
+<%method pageload>
<&| script &>
da_pageload= Date.now();
</&script>
+</%method>
<h1>Market data age</h1>
+<& SELF:agestable, now => $now, fetchrow => sub { $sth->fetchrow_hashref } &>
+
+<%method agestable>
+<%args>
+ $now
+ $fetchrow
+</%args>
<table id="ts_table">
<tr>
<th>Archipelago
<th>Island
<th>Age
</tr>
+% my $row;
% my %da_ages;
% my %ts_sortkeys;
% $da_ages{'id_loaded'}= 0;
% my $rowix= 0;
-% while ($row=$sth->fetchrow_hashref) {
+% while ($row= $fetchrow->()) {
+% print STDERR "$row\n";
% my $rowid= "id_$row->{'islandid'}";
% my $cellid= "c$rowid";
% my $age= $now - $row->{'timestamp'};
<tr id=<% $rowid %> class="<% 'datarow'.($rowix & 1) %>"
> <td><% $row->{'archipelago'} |h
%> <td><% $row->{'islandname'} |h
- %> <td id="<% $cellid %>"><% prettyprint_age($age) %> </tr>
+ %> <td id="<% $cellid %>" align=right><% prettyprint_age($age) %> </tr>
% $rowix++;
% }
</table>
+<& SELF:dataages, id2age => \%da_ages,
+ jsprefix => 'dat_', elemidprefix => "'c'+" &>
+
+<&| tabsort, table => 'ts_table', rowclass => 'datarow', cols => [
+ {}, {},
+ { DoReverse => 1,
+ Numeric => 1,
+ SortKey => "dat_ages[rowid]" }]
+ &>
+ ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+</&tabsort>
+<p>
+% print $m->content();
+Time since this page loaded:
+<span id="cid_loaded">(not known; times above not updating)</span>
+
+</%method>
-<& SELF:dataages, id2age => \%da_ages, elemidprefix => "'c'+" &>
<%method dataages>
<%args>
$id2age
$elemidprefix => ''
+ $jsprefix => 'da_'
</%args>
<&| script &>
- function da_Refresh() {
+ function <% $jsprefix %>Refresh() {
var now= Date.now();
debug('updating now='+now);
- for (var ageid in da_ages) {
- var oldage= da_ages[ageid];
+ for (var ageid in <% $jsprefix %>ages) {
+ var oldage= <% $jsprefix %>ages[ageid];
var el= document.getElementById(<% $elemidprefix %>ageid);
var age= oldage + (now - da_pageload) / 1000;
var newhtml= <% meta_prettyprint_age('age','Math.floor','+') %>;
el.innerHTML= newhtml;
}
}
- da_ages= <% to_json_protecttags($id2age) %>;
- window.setInterval(da_Refresh, 10000);
- register_onload(da_Refresh);
+ <% $jsprefix %>ages= <% to_json_protecttags($id2age) %>;
+ window.setInterval(<% $jsprefix %>Refresh, 10000);
+ register_onload(<% $jsprefix %>Refresh);
</&>
</%method>
-<&| tabsort, table => 'ts_table', rowclass => 'datarow', cols => [
- {}, {},
- { DoReverse => 1,
- Numeric => 1,
- SortKey => "da_ages[rowid]" }]
- &>
- ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
-</&tabsort>
-
-<p>
-Time since this page loaded:
-<span id="cid_loaded">(not known; times above not updating)</span>
-
<form action="lookup" method="get">
<input type=submit name=submit value="Reload">
<& "lookup:formhidden", ours => sub { 0; } &>
<form action="<% $quri->() |h %>" method="get">
-%#---------- textbox, user enters route as string ----------
-% if (!$qa->{Dropdowns}) {
-
-Enter commodity (abbreviations are OK):<br>
-
-<&| qtextstring, qa => $qa, dbh => $dbh,
- thingstring => 'commodstring', emsgstore => \$emsg,
- perresult => sub { ($commodname,$cmid)= @_; }
+<& enter_commod, qa => $qa, dbh => $dbh, emsg_r => \$emsg,
+ commodname_r => \$commodname,
+ cmid_r => \$cmid
&>
- size=80
-</&>
-
-% } else { #---------- dropdowns, user selects from menus ----------
-
-% my $sth= $dbh->prepare("SELECT commodname,commodid FROM commods
-% ORDER BY commodname");
-% $sth->execute();
-% my $row;
-<select name="commodid">
-<option value="">Select commodity...</option>
-% while ($row= $sth->fetchrow_arrayref) {
-% my $selected= $commodid eq $row->[1] ? 'selected' : '';
-<option value="<% $row->[1] %>" <% $selected %>><% $row->[0] |h %></option>
-% ($commodname,$cmid) = @$row if $selected;
-% }
-</select>
-
-% } #---------- end of dropdowns, now common middle of page code ----------
<input type=submit name=submit value="Go">
% my $ours= sub { $_[0] =~ m/^commodstring|^commodid/; };
% my $rowix= 0;
% while ($island= $islands->fetchrow_hashref) {
% if (!$rowix) {
-<table id="<% $bs %>_table">
+<table id="<% $bs %>_table" rules=groups>
+<colgroup span=2>
+<colgroup span=1>
+<colgroup span=2>
+<colgroup span=3>
<tr>
-<th colspan=3>
+<th colspan=2>
+<th colspan=1>
<th colspan=2>Prices
<th colspan=3>Quantity at price
<tr id="<% $bs %>_table_thr">
<td><% $s->[0]= $island->{'archipelago'} |h %>
<td><% $s->[1]= $island->{'islandname'} |h %>
<td><% $stallname |h %>
- <td><% $s->[3]= (length $bestqty ? $bestprice : '-') %>
- <td><% $s->[4]= $median %>
- <td><% $s->[5]= $bestqty %>
- <td><% $s->[6]= $approxqty %>
- <td><% $s->[7]= $cqty %>
+ <td align=right><% $s->[3]= (length $bestqty ? $bestprice : '-') %>
+ <td align=right><% $s->[4]= $median %>
+ <td align=right><% $s->[5]= $bestqty %>
+ <td align=right><% $s->[6]= $approxqty %>
+ <td align=right><% $s->[7]= $cqty %>
</tr>
% for my $cix (0..$#$s) {
% $ts_sortkeys{$cix}{$rowid}= $s->[$cix];
--- /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 core of the `offers' query.
+
+
+</%doc>
+<%args>
+$quri
+$dbh
+$commodid => undef;
+$commodstring => '';
+$islandid => undef;
+$prselector
+$someresults
+$emsgokorprint
+</%args>
+
+<%perl>
+my $emsg;
+my @warningfs;
+my @islandids;
+my @archipelagoes;
+my ($commodname,$cmid);
+
+my $qa= \%ARGS;
+</%perl>
+
+<h1>Prices for commodity at location(s)</h1>
+
+% $prselector->('BuySell');
+
+<form action="<% $quri->() |h %>" method="get">
+
+<& enter_commod, qa => $qa, dbh => $dbh, emsg_r => \$emsg,
+ commodname_r => \$commodname,
+ cmid_r => \$cmid
+ &>
+
+<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg,
+ warningfs_r => \@warningfs,
+ enterwhat => 'Enter location',
+ islandids_r => \@islandids,
+ archipelagoes_r => \@archipelagoes
+ &>
+
+<input type=submit name=submit value="Go">
+% my $ours= sub { $_[0] =~
+% m/^commodstring|^commodid|^routestring|^archipelago|^island/;
+% };
+<& "lookup:formhidden", ours => $ours &>
+
+</form>
+
+%#========== results ==========
+<%perl>
+
+$emsgokorprint->($emsg) or $cmid=undef;
+return unless defined $cmid and @islandids;
+
+foreach my $wf (@warningfs) { $wf->(); }
+
+if ($qa->{'debug'}) {
+</%perl>
+<pre>
+bs= <% $qa->{BuySell} %>
+cmdid= <% $cmid %>
+islandids= <% join ',', map { defined($_) ? $_ : 'U' } @islandids %>
+</pre>
+<%perl>
+}
+
+my $locdesc;
+if (@islandids>1) {
+ $locdesc= ' at specified locations';
+} elsif (defined $islandids[0]) {
+ my $sth= $dbh->prepare("SELECT islandname FROM islands
+ WHERE islandid == ?");
+ $sth->execute($islandids[0]);
+ $locdesc= ' at '.($sth->fetchrow_array())[0];
+} else {
+ $locdesc= ' in '.$archipelagoes[0];
+}
+
+my $now= time;
+
+my @conds;
+my @condvals;
+push @condvals, $cmid;
+foreach my $ix (0..$#islandids) {
+ my $iid= $islandids[$ix];
+ my $arch= $archipelagoes[$ix];
+ if (defined $iid) {
+ push @conds, 'offers.islandid == ?';
+ push @condvals, $iid;
+ } else {
+ push @conds, 'islands.archipelago == ?';
+ push @condvals, $arch;
+ }
+}
+foreach my $bs (split /_/, $qa->{BuySell}) {
+ my %da_ages;
+ my %ts_sortkeys;
+
+ die unless grep { $bs eq $_ } qw(buy sell);
+ my $ascdesc= $bs eq 'buy' ? 'DESC' : 'ASC';
+</%perl>
+<h2>Offers to <% uc $bs |h %> <% $commodname |h %> <% $locdesc %></h2>
+<%perl>
+ my $stmt= "
+ SELECT archipelago, islandname,
+ stallname, price, qty, timestamp,
+ offers.stallid
+ FROM $bs AS offers
+ JOIN islands ON offers.islandid==islands.islandid
+ JOIN uploads ON offers.islandid==uploads.islandid
+ JOIN stalls ON offers.stallid==stalls.stallid
+ WHERE offers.commodid == ?
+ AND ( ".join("
+ OR ", @conds)."
+ )
+ ORDER BY archipelago, islandname, price $ascdesc, qty ASC,
+ stallname $ascdesc
+";
+ if ($qa->{'debug'}) {
+</%perl>
+<pre>
+<% $stmt %>
+<% join ',', @condvals |h %>
+</pre>
+<%perl>
+ }
+
+ my $row;
+ my $sth= $dbh->prepare($stmt);
+ $sth->execute(@condvals);
+ my $rowix= 0;
+</%perl>
+% while ($row= $sth->fetchrow_arrayref) {
+% if (!$rowix) {
+<table id="<% $bs %>_table" rules=groups>
+<colgroup span=2>
+<colgroup span=3>
+<colgroup span=1>
+<tr>
+<th>Archipelago
+<th>Island
+<th>Stall or Shoppe
+<th>Price
+<th>Quantity
+<th>Data age
+</tr>
+% }
+% my $rowid= ${bs}.$row->[6];
+% my $tscellid= "c$rowid";
+% my $age= $now - $row->[5];
+% $da_ages{$rowid}= $age;
+% $row->[5]=
+<tr id=<% $rowid %> class="<% 'datarow'.($rowix & 1) %>" >
+% foreach my $ci (0..4) {
+% my $val= $row->[$ci];
+% $ts_sortkeys{$ci}{$rowid}= $val;
+<td <% $ci >= 3 ? 'align=right' : '' %> ><% $val |h %>
+% }
+<td id="<% $tscellid %>" align=right><% prettyprint_age($age) %>
+</tr>
+% $rowix++;
+% }
+% if ($rowix) {
+</table>
+
+<&| tabsort, table => "${bs}_table", rowclass => 'datarow', cols => [
+ {}, {}, {},
+ { Numeric => 1, DoReverse => 1 },
+ { Numeric => 1, DoReverse => 1 },
+ { Numeric => 1, DoReverse => 1, SortKey => "${bs}_ages[rowid]" }],
+ sortkeys => "${bs}_sortkeys"
+ &>
+ <%$bs%>_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+ <%$bs%>_ages= <% to_json_protecttags(\%da_ages) %>;
+</&tabsort>
+% } else {
+No offers.
+% }
+
+<%perl>
+}
+</%perl>
+
+<p>
+(Please don't use these pages to scrape data out of the YARRG
+database. This will be a pain for you to program, slow to run, and
+pointlessly overload our server. Instead, see our
+<a href="devel">information for developers</a>
+to find out how to get testing data or a real-time feed.)
$routestring => '';
$capacitystring => '';
$lossperleague => '';
+$capitalstring => '';
$someresults
$emsgokorprint
</%args>
<%perl>
my $emsg;
+my @warningfs;
my @archipelagoes;
my @islandids;
-my %islandid2;
-my ($max_volume, $max_mass);
-my $lossperleaguepct;
my $qa= \%ARGS;
<h1>Specify route</h1>
-% $prselector->('ShowStalls');
-
-%#---------- textbox, user enters route as string ----------
+% # Sadly we need to do this rather hacky thing to make it be a POST
+% # form if the user has already selected some thing(s)
% if (!$qa->{Dropdowns}) {
-
-Enter route (islands, or archipelagoes, separated by |s or commas;
- abbreviations are OK):<br>
-
-% $startform->($routestring =~ m/\S/);
-
-<&| qtextstring, qa => $qa, dbh => $dbh,
- thingstring => 'routestring', emsgstore => \$emsg,
- perresult => sub {
- my ($canonname, $island, $arch) = @_;
- push @islandids, $island;
- push @archipelagoes, defined $island ? undef : $arch;
- }
- &>
- 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 {
-% defined $ARGS{"archipelago$_"} ||
-% defined $ARGS{"islandid$_"}
+% $startform->($routestring =~ m/\S/);
+% } else {
+% $startform->(grep {
+% defined $qa->{"archipelago$_"} ||
+% defined $qa->{"islandid$_"}
% } (0..$qa->{Dropdowns}-1));
+% }
-<%perl>
-my ($sth,$row);
-my @archlistdata;
-my %islandlistdata;
-$islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
-
-my $optionlistmap= sub {
- my ($optlist, $selected) = @_;
- my $out='';
- foreach my $entry (@$optlist) {
- $out.= sprintf('<option value="%s" %s>%s</option>',
- encode_entities($entry->[0]),
- defined $selected && $entry->[0] eq $selected
- ? 'selected' : '',
- encode_entities($entry->[1]));
- }
- return $out;
-};
-
-$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
- ORDER BY archipelago;");
-$sth->execute();
-
-while ($row=$sth->fetchrow_arrayref) {
- my ($arch)= @$row;
- push @archlistdata, [ $arch, $arch ];
- $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
-}
-
-$sth= $dbh->prepare("SELECT islandid,islandname,archipelago
- FROM islands
- ORDER BY islandname;");
-$sth->execute();
-
-while ($row=$sth->fetchrow_arrayref) {
- my $arch= $row->[2];
- push @{ $islandlistdata{'none'} }, [ @$row ];
- push @{ $islandlistdata{$arch} }, [ @$row ];
- $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
-}
-
-my %resetislandlistdata;
-foreach my $arch (keys %islandlistdata) {
- $resetislandlistdata{$arch}=
- $optionlistmap->($islandlistdata{$arch}, '');
-}
-
-</%perl>
-
-<&| script &>
-ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
-function ms_Setarch(dd) {
- debug('ms_SetArch '+dd+' arch='+arch);
- var arch= document.getElementsByName('archipelago'+dd).item(0).value;
- var got= ms_lists[arch];
- if (got == undefined) return; // unknown arch ? hrm
- debug('ms_SetArch '+dd+' arch='+arch+' got ok');
- var select= document.getElementsByName('islandid'+dd).item(0);
- select.innerHTML= got;
- debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
-}
-</&script>
-
-<table style="table-layout:fixed; width:90%;">
+% $prselector->('ShowStalls');
-<tr>
-% for my $dd (0..$qa->{Dropdowns}-1) {
-<td>
-<select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
-<option value="none">Whole ocean</option>
-<% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
-% }
-</tr>
+<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg,
+ warningfs_r => \@warningfs,
+ enterwhat => 'Enter route',
+ islandids_r => \@islandids,
+ archipelagoes_r => \@archipelagoes
+ &>
-<tr>
-% for my $dd (0..$qa->{Dropdowns}-1) {
-% my $arch= $ARGS{"archipelago$dd"};
-% $arch= 'none' if !defined $arch;
-<td>
-<select name="islandid<% $dd %>">
-<% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
-</select></td>
-% }
-</tr>
+%#---------- textboxes, user enters details as strings ----------
+% my $routeparams= { EmsgRef => \$emsg };
+% if (!$qa->{Dropdowns}) {
-</table>
+<& enter_advrouteopts, qa=>$qa, dbh=>$dbh, 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|^[RT]/;
+% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^capitalstring|^[RT]/;
% };
<& "lookup:formhidden", ours => $ours &>
$emsgokorprint->($emsg) or @islandids=();
-my $argorundef= sub {
- my ($dd,$base) = @_;
- my $thing= $ARGS{"${base}${dd}"};
- $thing= undef if defined $thing and $thing eq 'none';
- return $thing;
-};
-
-for my $dd (0..$qa->{Dropdowns}-1) {
- my $arch= $argorundef->($dd,'archipelago');
- my $island= $argorundef->($dd,'islandid');
- next unless defined $arch or defined $island;
- if (defined $island and defined $arch) {
- my $ii= $islandid2{$island};
- my $iarch= $ii->{Arch};
- if ($iarch ne $arch) {
- $someresults->();
-</%perl>
- Specified archipelago <% $arch %> but
- island <% $ii->{Name} %>
- which is in <% $iarch %>; using the island.<br>
-<%perl>
- }
- $arch= undef;
- }
- push @archipelagoes, $arch;
- push @islandids, $island;
+foreach my $warningf (@warningfs) {
+ $someresults->();
+ $warningf->();
}
</%perl>
% if (@islandids) {
-% $someresults->('Relevant trades');
+% $someresults->();
<& routetrade,
dbh => $dbh,
islandids => \@islandids,
archipelagoes => \@archipelagoes,
qa => $qa,
- max_mass => $max_mass,
- max_volume => $max_volume,
- lossperleaguepct => $lossperleaguepct
+ routeparams => $routeparams
&>
-</form>
% }
+</form>
--- /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 core of the `routesearch' query.
+
+
+</%doc>
+<%args>
+$quri
+$dbh
+$queryqf
+$islandstring => '';
+$capacitystring => '';
+$lossperleague => '';
+$capitalstring => '';
+$distance => '';
+$prselector
+$someresults
+$emsgokorprint
+$allargs
+</%args>
+
+<%perl>
+use BSD::Resource;
+
+my $emsg;
+my @warningfs;
+my @islandids;
+
+my $maxmaxdist=35;
+my $maxcpu=90;
+my $concur_lim=5;
+
+my $qa= \%ARGS;
+my $routeparams= { EmsgRef => \$emsg, SayRequiredCapacity => 1 };
+my $maxdist;
+my $maxcountea=15;
+
+</%perl>
+
+<h1>Find most profitable routes and trades</h1>
+
+% if ($qa->{Dropdowns}) {
+This feature is not available from the "drop down menus" interface.
+% } else {
+
+% $prselector->('RouteSearchType');
+
+<form action="<% $quri->() |h %>" method="get">
+
+<& enter_route, qa=>$qa, dbh=>$dbh, emsg_r=>\$emsg, warningfs_r=>\@warningfs,
+ enterwhat => 'Enter starting point(s)',
+ islandids_r => \@islandids, archipelagoes_r => undef
+ &>
+
+<&| enter_advrouteopts, qa=>$qa, dbh=>$dbh, routeparams=>$routeparams &>
+<td>
+
+
+<td>
+ Maximum distance:
+ <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
+ thingstring => 'distance', emsgstore => \$emsg,
+ onresults => sub { ($maxdist)= @_; } &>
+ size=10
+ </&>
+</&>
+
+<input type=submit name=submit value="Search">
+% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^capitalstring|^capacitystring|^distance/; };
+<& "lookup:formhidden", ours => $ours &>
+
+% }
+
+</form>
+<%perl>
+
+if (!$emsg && $maxdist > $maxmaxdist) {
+ $emsg= "Searching for routes of more than $maxmaxdist leagues is not".
+ " supported, sorry.";
+}
+
+$emsgokorprint->($emsg) or return;
+@islandids or return;
+$allargs->{'submit'} or return;
+defined $routeparams->{MaxMass} or defined $routeparams->{MaxVolume} or return;
+
+#---------- prepare island names ----------
+
+my $islandname_stmt= $dbh->prepare(<<END);
+ SELECT islandname, archipelago
+ FROM islands
+ WHERE islandid = ?
+END
+
+my $isleinfo = sub {
+ my ($id) = @_;
+ $islandname_stmt->execute($id);
+ my $row= $islandname_stmt->fetchrow_hashref();
+ local $_= $row->{'islandname'};
+ s/ Island$//;
+ return $_, $row->{'islandname'}, $row->{'archipelago'};
+};
+
+#---------- compute the results ----------
+
+my @rsargs= ($concur_lim, '-DN');
+my $concur_fail;
+
+foreach my $k (qw(MaxMass MaxVolume MaxCapital)) {
+ my $v= $routeparams->{$k};
+ push @rsargs, (defined $v ? $v : -1);
+}
+push @rsargs, defined $routeparams->{LossPerLeaguePct}
+ ? $routeparams->{LossPerLeaguePct}*0.01 : 1e-9;
+push @rsargs, '0';
+push @rsargs, 'search',$maxdist, $maxcountea,$maxcountea;
+push @rsargs, $ARGS{RouteSearchType} ? 'circ' : 'any';
+push @rsargs, @islandids;
+
+m/[^-.0-9a-zA-Z]/ and die "$_ $& ?" foreach @rsargs;
+
+if ($qa->{'debug'}) {
+</%perl>
+[[ <% "@rsargs" |h %> ]]<br><pre>
+<%perl>
+}
+
+unshift @rsargs,
+ 'nice', sourcebasedir().'/yarrg/routesearch',
+ '-d', dbw_filename($qa->{'Ocean'}),
+ '-C', webdatadir().'/_concur.', '.lock';
+
+# touch _concur.0{0,1,2,3,4}.lock
+# really chgrp www-data _concur.0?.lock
+
+my %results; # $results{$ap}{"5 6 9 10"} = { stuff }
+
+my $fh= new IO::File;
+my $child= $fh->open("-|"); defined $child or die $!;
+if (!$child) {
+ my $cpu= BSD::Resource::RLIMIT_CPU;
+ my ($soft,$hard)= getrlimit($cpu);
+ setrlimit($cpu,$maxcpu,$hard) or die $! if $hard<=$maxcpu;
+ exec @rsargs;
+ die $!;
+}
+
+while (<$fh>) {
+ chomp;
+ if ($qa->{'debug'}) {
+</%perl>
+<% $_ |h %>
+<%perl>
+ }
+ next unless m/^\s*\@/;
+ if (m/^\@\@\@ concurrency limit exceeded/) {
+ $concur_fail= 1;
+ last;
+ }
+ die unless m/^ \@ *\d+ ([ap])\# *\d+ \|.*\| *(\d+)lg *\| *\d+ +(\d+) +(\d+) *\| ([0-9 ]+)$/;
+ my ($ap,$isles) = (uc $1,$5);
+ next if $results{$ap} && %{$results{$ap}} >= $maxcountea;
+ my $item= { A => $3, P => $4, Leagues => $2 };
+ my (@i, @fi, @a);
+ foreach (split / /, $isles) {
+ my ($name,$fullname,$arch)= $isleinfo->($_);
+ push @i, $name;
+ push @fi, $fullname;
+ push @a, $arch unless @a && $a[-1] eq $arch;
+ }
+ $item->{Isles}= [ @i ];
+ $item->{Archs}= [ @a ];
+ $item->{Start}= $i[0];
+ $item->{Finish}= $i[-1];
+ $item->{Vias}= [ ];
+ my $i;
+ for ($i=1; $i < @i-1; $i++) {
+ push @{ $item->{Vias} }, $i[$i];
+ }
+ my %linkqf= %$queryqf;
+ delete $linkqf{'query'};
+ $linkqf{'routestring'}= join ', ', @fi;
+ $item->{Url}= $quri->(%linkqf);
+ $item->{ArchesString}= join ', ', @a;
+ $item->{ViasString}= join ' ', map { $_.',' } @{ $item->{Vias} };
+ $item->{RouteSortString}= join ', ', @i;
+ $results{$ap}{$isles}= $item;
+}
+
+if ($qa->{'debug'}) {
+ print "</pre>\n";
+}
+
+$!=0;
+if (!close $fh) {
+ die $! if $!;
+ die $? if $? != 24; # SIGXCPU but not in POSIX.pm :-/
+</%perl>
+<h2>Search took too long and was terminated</h2>
+
+Sorry, but your query resulted in a search that took too long.
+Searches are limited to <% $maxcpu |h %> seconds of CPU time to
+avoid them consuming excessive resources on the server system, and to
+make sure that shorter searches can still happen.
+
+<p>
+Please try a search with a smaller minimum distance, or place more
+restrictions on the route.
+
+<%perl>
+ return;
+}
+
+if ($concur_fail) {
+</%perl>
+<h2>Server too busy</h2>
+
+Sorry, but there are already <% $concur_lim |h %> route searches
+running. We limit the number which can run at once to avoid
+overloading the server system and to make sure that the rest of the
+YARRG website still runs quickly.
+<p>
+
+If you submitted several searches and gave up on them (eg by hitting
+`back' or `stop' in your browser), be aware that that doesn't
+generally stop the search process at the server end. So it's best to
+avoid asking for large searches that you're not sure about.
+
+<p>
+Otherwise, please try later. Searches are limited to <% $maxcpu |h %>
+seconds of CPU time so more processing resources should be available soon.
+
+<%perl>
+ return;
+}
+
+$someresults->();
+
+</%perl>
+% foreach my $ap (qw(A P)) {
+% if ($ap eq 'A') {
+<h2>Best routes for total profit</h2>
+% } else {
+<h2>Best routes for profit per league</h2>
+% }
+<table rules=groups id="ap<% $ap %>_table">
+<colgroup span=2>
+<colgroup span=1>
+<colgroup span=1>
+<colgroup span=3>
+<tr>
+<th colspan=2>Profit
+<th>Dist.
+<th>Archipelagoes
+<th>
+<th>Route
+<th>
+<tr>
+<th>Abs.
+<th>Per.lg.
+<th>
+<th>(link to plan)
+<th>Start
+<th>Via
+<th>Finish
+<tr>
+<tr id="ap<% $ap %>_sortrow"><th><th><th><th><th><th><th>
+% my $datarow=0;
+% my %sortkeys;
+% foreach my $isles (sort {
+% $results{$ap}{$b}{$ap} <=>
+% $results{$ap}{$a}{$ap}
+% } keys %{$results{$ap}}) {
+% my $item= $results{$ap}{$isles};
+% my $ci=0;
+% my $rowid= "r${ap}$isles"; $rowid =~ y/ /_/;
+% foreach my $k (qw(A P Leagues ArchesString
+% Start RouteSortString Finish)) {
+% $sortkeys{$ci}{$rowid}= $item->{$k};
+% $ci++;
+% }
+<tr class="datarow<% $datarow %>" id="<% $rowid %>">
+<td align=right><% $item->{A} |h %>
+<td align=right><% $item->{P} |h %>
+<td align=right><% $item->{Leagues} |h %>
+<td align=left><a href="<% $item->{Url} |h %>"><%
+ $item->{ArchesString} |h %></a>
+<td align=left><% $item->{Start} |h %>,
+<td align=left><% $item->{ViasString} |h %>
+<td align=left><% $item->{Finish} |h %>
+</td>
+% $datarow ^= 1;
+% } # $isles
+</table>
+<&| tabsort, table => "ap${ap}_table", sortkeys => "ap${ap}_sortkeys",
+ throw => "ap${ap}_sortrow", rowclass => "datarow", cols => [
+ { DoReverse => 1, Numeric => 1 },
+ { DoReverse => 1, Numeric => 1 },
+ { DoReverse => 1, Numeric => 1 },
+ { },
+ { },
+ { },
+ { },
+ ] &>
+ ap<% $ap %>_sortkeys= <% to_json_protecttags(\%sortkeys) %>;
+</&tabsort>
+% } # $ap
+
+<p>
+
+<h2>Notes</h2>
+
+Per league values count each island visited as one
+(additional) league; the `Dist.' column is however the actual distance
+to be sailed. All profit figures are somewhat approximate; get a
+complete trading plan for a route for accurate information.
+
+<%perl>
+
+
+</%perl>
@islandids
@archipelagoes
$qa
-$max_mass
-$max_volume
-$lossperleaguepct
+$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;
my @flow_conds;
my @query_params;
my %dists;
+my $expected_total_profit;
my $sd_condition= sub {
my ($bs, $ix) = @_;
}
};
-my %islandpair;
-# $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
-
my $specific= !grep { !defined $_ } @islandids;
-my $confusing= 0;
-foreach my $src_i (0..$#islandids) {
- my $src_isle= $islandids[$src_i];
- my $src_cond= $sd_condition->('sell',$src_i);
+my %ipair2subflowinfs;
+# $ipair2subflowinfs{$orgi,$dsti}= [ [$orgix,$distix], ... ]
+
+my @subflows;
+# $subflows[0]{Flow} = { ... }
+# $subflows[0]{Org} = $orgix
+# $subflows[0]{Dst} = $dstix
+
+foreach my $org_i (0..$#islandids) {
+ my $org_isle= $islandids[$org_i];
+ my $org_cond= $sd_condition->('sell',$org_i);
my @dst_conds;
- foreach my $dst_i ($src_i..$#islandids) {
+ foreach my $dst_i ($org_i..$#islandids) {
my $dst_isle= $islandids[$dst_i];
- my $dst_cond= $sd_condition->('buy',$dst_i);
- if ($dst_i==$src_i and !defined $src_isle) {
+ # Don't ever consider sailing things round the houses:
+ next if defined $dst_isle and
+ grep { $dst_isle == $_ } @islandids[$org_i..$dst_i-1];
+ next if defined $org_isle and
+ grep { $org_isle == $_ } @islandids[$org_i+1..$dst_i];
+ my $dst_cond;
+ if ($dst_i==$org_i and !defined $org_isle) {
# we always want arbitrage, but mentioning an arch
# once shouldn't produce intra-arch trades
- $dst_cond=
- "($dst_cond AND sell.islandid = buy.islandid)";
+ $dst_cond= "sell.islandid = buy.islandid";
+ } else {
+ $dst_cond= $sd_condition->('buy',$dst_i);
}
push @dst_conds, $dst_cond;
- if ($specific && !$confusing &&
- # With a circular route, do not carry goods round the loop
- !(($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 ];
- }
+ if ($specific) {
+ push @{ $ipair2subflowinfs{$org_isle,$dst_isle} },
+ [ $org_i, $dst_i ];
}
}
- push @flow_conds, "$src_cond AND (
+ push @flow_conds, "$org_cond AND (
".join("
OR ",@dst_conds)."
)";
$f= {
Ix => scalar(@flows),
- Var => "f".@flows,
%$got
};
$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
<& 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 %>
+<a href="docs#arbitrage">[?]</a>.
+% }
+% }
+
<%perl>
+my @sail_total;
+
if (!@flows) {
print 'No profitable trading opportunities were found.';
return;
my $first= $base;
do {
my $this= $uue % $base;
-print STDERR "uue=$uue this=$this ";
+#print STDERR "uue=$uue this=$this ";
$uue -= $this;
$uue /= $base;
$this += $first;
$cmpu .= chr($this + ($this < 26 ? ord('a') :
$this < 52 ? ord('A')-26
: ord('0')-52));
-print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
-die "$cmpu $uue ?" if length $cmpu > 20;
+#print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
+ die "$cmpu $uue ?" if length $cmpu > 20;
} while ($uue);
$cmpu;
} @uid;
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>
-% my $optimise= $specific && !$confusing && @islandids>1;
+% my $optimise= $specific;
% if (!$optimise) {
<p>
-% if (@islandids<=1) {
-Route contains only one location.
-% }
% if (!$specific) {
Route contains archipelago(es), not just specific islands.
% }
-% if ($confusing) {
-Route is complex - it visits the same island several times
-and isn't a simple loop.
-% }
Therefore, optimal voyage trade plan not calculated.
% } else { # ========== OPTMISATION ==========
Maximize
totalprofit:
- ".(join "
- ", map {
- sprintf "%+.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
- } @flows)."
+";
+
+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};
+}
+$cplex .= "
Subject To
";
-my %avail_csts;
+my %avail_lims;
foreach my $flow (@flows) {
- if ($flow->{Suppress}) {
- $cplex .= "
- $flow->{Var} = 0
-";
- next;
- }
+ next if $flow->{Suppress};
foreach my $od (qw(org dst)) {
- my $cstname= join '_', (
- 'avail',
- $flow->{'commodid'},
+ my $limname= join '_', (
$od,
- $flow->{"${od}_id"},
+ 'i'.$flow->{"${od}_id"},
+ 'c'.$flow->{'commodid'},
$flow->{"${od}_price"},
$flow->{"${od}_stallid"},
);
-
- push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
- $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
+
+ push @{ $avail_lims{$limname}{SubflowVars} },
+ map { $_->{Var} } @{ $flow->{Subflows} };
+ $avail_lims{$limname}{Qty}= $flow->{"${od}_qty_agg"};
}
}
-foreach my $cstname (sort keys %avail_csts) {
- my $c= $avail_csts{$cstname};
- $cplex .= "
- ". sprintf("%-30s","$cstname:")." ".
- join("+", @{ $c->{Flows} }).
- " <= ".$c->{Qty}."\n";
+foreach my $limname (sort keys %avail_lims) {
+ my $c= $avail_lims{$limname};
+ $cplex .=
+ sprintf(" %-30s","$limname:")." ".
+ join("+", @{ $c->{SubflowVars} }).
+ " <= ".$c->{Qty}."\n";
}
foreach my $ci (0..($#islandids-1)) {
- my @rel_flows;
+ my @rel_subflows;
+
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} ";
+ my @relsubflow= grep {
+ $_->{Org} <= $ci &&
+ $_->{Dst} > $ci;
+ } @{ $f->{Subflows} };
+ next unless @relsubflow;
+ die unless @relsubflow == 1;
+ push @rel_subflows, @relsubflow;
+#print " RELEVANT $ci $relsubflow[0]->{Var} ";
}
-#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 " RELEVANT $ci COUNT ".scalar(@rel_subflows)." ";
+ if (!@rel_subflows) {
+ foreach my $mv (qw(mass volume)) {
+ $sail_total[$ci]{$mv}= 0;
+ }
+ next;
+ }
+
+ my $applylimit= sub {
+ my ($mv, $f2val) = @_;
+ my $max= $routeparams->{"Max".ucfirst $mv};
+ $max= 1e9 unless defined $max;
#print " DEFINED MAX $mv $max ";
$cplex .= "
". sprintf("%-10s","${mv}_$ci:")." ".
- join(" + ", map { ($_->{"unit$mv"}*1e-3).' f'.$_->{Ix} } @rel_flows).
- " <= $max";
- }
+ join(" + ", map {
+#print " PART MAX $_->{Var} $_->{Flow}{Ix} ";
+ $f2val->($_->{Flow}) .' '. $_->{Var};
+ } @rel_subflows).
+ " <= $max";
+ };
+
+ $applylimit->('mass', sub { $_[0]{'unitmass'} *1e-3 });
+ $applylimit->('volume', sub { $_[0]{'unitvolume'}*1e-3 });
+ $applylimit->('capital', sub { $_[0]{'org_price'} });
$cplex.= "\n";
}
$cplex.= "
Bounds
".(join "
- ", map { "$_->{Var} >= 0" } @flows)."
+ ", map { "$_->{Var} >= 0" } @subflows)."
";
$cplex.= "
Integer
".(join "
- ", map { "f$_" } (0..$#flows))."
+ ", map { $_->{Var} } @subflows)."
End
";
my $input= pipethrough_prep();
print $input $cplex or die $!;
my $output= pipethrough_run_along($input, undef, 'glpsol',
- qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
+ qw(glpsol --tmlim 2 --memlim 5 --intopt --cuts --bfs
+ --cpxlp /dev/stdin -o /dev/stdout));
print "<pre>\n" if $qa->{'debug'};
my $found_section= 0;
my $glpsol_out= '';
+ my $continuation='';
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;
+ if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
+ die "$_ $found_section ?" if $found_section>0;
$found_section= 1;
next;
}
+ if (m/^Objective:\s+totalprofit = (\d+(?:\.\d*)?) /) {
+ $expected_total_profit= $1;
+ }
next unless $found_section==1;
- next if m/^[- ]+$/;
- if (!/\S/) {
- $found_section= 2;
- next;
+ if (!length $continuation) {
+ next if !$continuation && m/^[- ]+$/;
+ if (!/\S/) {
+ $found_section= 0;
+ next;
+ }
+ if (m/^ \s* \d+ \s+ \w+ $/x) {
+ $continuation= $&;
+ next;
+ }
+ }
+ $_= $continuation.$_;
+ $continuation= '';
+ my ($varname, $qty) = m/^
+ \s* \d+ \s+
+ (\w+) \s+ (?: [A-Z*]+ \s+ )?
+ ([0-9.]+) \s
+ /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;
+ my @relsubflow= grep { $_->{Org} == $orgix }
+ @{ $flow->{Subflows} };
+ die "$ix $orgix @relsubflow" unless @relsubflow == 1;
+ my $sf= $relsubflow[0];
+ $sf->{OptQty}= $qty;
+ $sf->{OptProfit}= $qty * $flow->{'unitprofit'};
+ $sf->{OptCapital}= $qty * $flow->{'org_price'};
+ } elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
+ my ($mv,$ix) = ($1,$2);
+ $sail_total[$ix]{$mv}= $qty;
}
- my ($ix, $qty) =
- m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
- my $flow= $flows[$ix] or die;
- $flow->{OptQty}= $qty;
- $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
- $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
}
print "</pre>\n" if $qa->{'debug'};
my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
pipethrough_run_finish($output,$prerr);
- die $prerr unless $found_section;
+ map { defined $_->{OptQty} or die "$prerr $_->{Flow}{Ix}" } @subflows;
+ defined $expected_total_profit or die "$prerr ?";
};
-$addcols->({ DoReverse => 1, Special => sub {
+$addcols->({ DoReverse => 1, TotalSubflows => 1, Special => sub {
my ($flow,$col,$v,$spec) = @_;
if ($flow->{ExpectedUnitProfit} < 0) {
$spec->{Span}= 3;
} }, qw(
OptQty
));
-$addcols->({ Total => 0, DoReverse => 1 }, qw(
+$addcols->({ Total => 0, DoReverse => 1, TotalSubflows => 1 }, qw(
OptCapital OptProfit
));
% } # ========== OPTIMISATION ==========
-% my %ts_sortkeys;
-% {
-% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
-% my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
-<table id="trades" rules=groups>
-<colgroup span=1>
-<colgroup span=2>
-<% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
-<colgroup span=1>
-<colgroup span=2>
-<colgroup span=2>
-<colgroup span=2>
-<colgroup span=3>
-<colgroup span=3>
-% if ($optimise) {
-<colgroup span=3>
-% }
-<tr class="spong">
-<th>
-<th<% $cdspan %>>Collect
-<th<% $cdspan %>>Deliver
-<th>
-<th colspan=2>Collect
-<th colspan=2>Deliver
-<th colspan=2>Profit
-<th colspan=3>Max
-<th colspan=1>
-<th colspan=2>Max
-% if ($optimise) {
-<th colspan=3>Planned
-% }
-
-<tr>
-<th>
-<th>Island <% $cdstall %>
-<th>Island <% $cdstall %>
-<th>Commodity
-<th>Price
-<th>Qty
-<th>Price
-<th>Qty
-<th>Margin
-<th>Unit
-<th>Qty
-<th>Capital
-<th>Profit
-<th>Dist
-<th>Mass
-<th>Vol
-% if ($optimise) {
-<th>Qty
-<th>Capital
-<th>Profit
-% }
-% }
-
-<tr id="trades_sort">
-% foreach my $col (@cols) {
-<th>
-% }
-
-% foreach my $flowix (0..$#flows) {
-% my $flow= $flows[$flowix];
-% my $rowid= "id_row_$flow->{UidShort}";
-<tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
-<td><input type=hidden name=R<% $flow->{UidShort} %> value="">
- <input type=checkbox name=T<% $flow->{UidShort} %> value=""
- <% $flow->{Suppress} ? '' : 'checked' %> >
-% my $ci= 1;
-% while ($ci < @cols) {
-% my $col= $cols[$ci];
-% my $spec= {
-% Span => 1,
-% Align => ($col->{Text} ? '' : 'align=right')
-% };
-% my $v= $flow->{$col->{Name}};
-% 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 <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
- %> <% $spec->{Align}
- %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
-% $ci += $spec->{Span};
-% }
+% if (!printable($m)) {
+<h2>Contents</h2>
+<ul>
+% if ($optimise) {
+ <li><a href="#plan">Voyage trading plan</a>
+ <ul>
+ <li><a href="#summary">Summary statistics</a>
+ <li>Printable:
+ <input type=submit name=printable_pdf value="PDF">
+ <input type=submit name=printable_html value="HTML">
+ <input type=submit name=printable_ps value="PostScript">
+ <input type=submit name=printable_pdf2 value="PDF 2-up">
+ <input type=submit name=printable_ps2 value="PostScript 2-up">
+ </ul>
% }
-<tr id="trades_total">
-<th>
-<th colspan=2>Total
-% foreach my $ci (3..$#cols) {
-% my $col= $cols[$ci];
-<td align=right>
-% if (defined $col->{Total}) {
-<% $col->{Total} |h %>
-% }
+ <li><a href="#dataage">Data age summary</a>
+ <li><a href="#trades">Relevant trades</a>
+</ul>
+% } else {
+% my @tl= gmtime $now or die $!;
+<p>
+Generated by YARRG at <strong><%
+ sprintf "%04d-%02d-%02d %02d:%02d:%02d UTC",
+ $tl[5]+1900, @tl[4,3,2,1,0]
+ |h %></strong>.
% }
-</table>
-
-<&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
- throw => 'trades_sort', tbrow => 'trades_total' &>
- ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
-</&tabsort>
-
-<input type=submit name=update value="Update">
% if ($optimise) { # ========== TRADING PLAN ==========
%
% my $total_total= 0;
% my $total_dist= 0;
%
-<h1>Voyage trading plan</h1>
-<table rules=groups>
+<h2><a name="plan">Voyage trading plan</a></h2>
+
+<table rules=groups <% printable($m) ? 'width=100%' : '' %> >
+% my $tbody= sub {
+% if (!printable($m)) { return '<tbody>'; }
+%# return "<tr><td colspan=7><hr>";
+% my ($c)= qw(40 00)[$_[0]];
+% return "<tr><td bgcolor=\"#${c}${c}${c}\" height=1 colspan=7>";
+% };
+%
% foreach my $i (0..$#islandids) {
-<tbody>
-<tr><td colspan=3>
+<% $tbody->(1) %>
+<tr><td colspan=4>
% $iquery->execute($islandids[$i]);
% my ($islandname) = $iquery->fetchrow_array();
% if (!$i) {
% } else {
% my $this_dist= $distance->($islandids[$i-1],$islandids[$i]);
% $total_dist += $this_dist;
+<%perl>
+ my $total_value= 0;
+ foreach my $sf (@subflows) {
+ next unless $sf->{Org} < $i && $sf->{Dst} >= $i;
+ $total_value +=
+ $sf->{OptQty} * $sf->{Flow}{'dst_price'};
+ }
+</%perl>
<strong>Sail to <% $islandname |h %></strong>
-- <% $this_dist |h %> leagues </td>
+- <% $this_dist |h %> leagues,
+ <% $total_value %>poe at risk
+ </td>
% }
<%perl>
my $age_reported= 0;
my %flowlists;
+ #print "<tr><td colspan=6>" if $qa->{'debug'};
foreach my $od (qw(org dst)) {
- foreach my $f (@flows) {
- next if $f->{Suppress};
- next unless $f->{"${od}_id"} == $islandids[$i];
- next unless $f->{OptQty};
+ #print " [[ i $i od $od " if $qa->{'debug'};
+ foreach my $sf (@subflows) {
+ my $f= $sf->{Flow};
+ next unless $sf->{ucfirst $od} == $i;
+ #print " FLOW $f->{Ix} SUB #$sf->{Org}..$sf->{Dst} "
+ # if $qa->{'debug'};
+ next unless $sf->{OptQty};
my $arbitrage= $f->{'org_id'} == $f->{'dst_id'};
- my $loop= $islandids[0] == $islandids[-1] &&
- ($i==0 || $i==$#islandids);
- next if $loop and ($arbitrage ? $i :
- !!$i == !!($od eq 'org'));
+ die if $arbitrage and $sf->{Org} != $sf->{Dst};
my $price= $f->{"${od}_price"};
my $stallname= $f->{"${od}_stallname"};
my $todo= \$flowlists{$od}{
$$todo->{'stallname'}= $stallname;
$$todo->{Price}= $price;
$$todo->{Timestamp}= $f->{"${od}_timestamp"};
- $$todo->{Qty} += $f->{OptQty};
+ $$todo->{Qty} += $sf->{OptQty};
$$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
$$todo->{Stalls}= $f->{"${od}Stalls"};
$$todo->{"${od}Arbitrage"}= 1 if $arbitrage;
}
+ #print "]] " if $qa->{'debug'};
}
+ #print "</tr>" if $qa->{'debug'};
- my $total;
+ my ($total, $total_to_show);
my $dline= 0;
- my $show_flows= sub {
- my ($od,$arbitrage,$collectdeliver) = @_;
+ my $show_total= sub {
+ my ($totaldesc, $sign) = @_;
+ if (defined $total) {
+ die if defined $total_to_show;
+ $total_total += $sign * $total;
+ $total_to_show= [ $totaldesc, $total ];
+ $total= undef;
+ }
+ $dline= 0;
+ };
+ my $show_total_now= sub {
+ my ($xinfo) = @_;
+ return unless defined $total_to_show;
+ my ($totaldesc,$totalwas) = @$total_to_show;
</%perl>
-%
+<tr>
+<td colspan=1>
+<td colspan=2><% $xinfo %>
+<td colspan=2 align=right><% $totaldesc %>
+<td align=right><% $totalwas |h %> total
+<%perl>
+ $total_to_show= undef;
+ };
+</%perl>
+% my $show_flows= sub {
+% my ($od,$arbitrage,$collectdeliver) = @_;
% my $todo= $flowlists{$od};
% return unless $todo;
% foreach my $tkey (sort keys %$todo) {
% my $t= $todo->{$tkey};
% next if $t->{"${od}Arbitrage"} != $arbitrage;
+% $show_total_now->('');
% if (!$age_reported++) {
% my $age= $now - $t->{Timestamp};
% my $cellid= "da_${i}";
% $da_ages{$cellid}= $age;
-<td colspan=3>\
+<td colspan=2>\
(Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
% } elsif (!defined $total) {
% $total= 0;
-<tbody>
+<% $tbody->(0) %>
% }
% $total += $t->{Total};
% my $span= 0 + keys %{ $t->{Stalls} };
% my $td= "td rowspan=$span";
-<tr class="datarow<% $dline %>">
+% tr_datarow($m,$dline);
<<% $td %>><% $collectdeliver %>
<<% $td %>><% $t->{'commodname'} |h %>
%
<<% $td %> align=right><% $t->{Total} |h %> total
%
% foreach my $stallix (1..$#stalls) {
-<tr class="datarow<% $dline %>">
+% tr_datarow($m,$dline);
% $pstall->($stallix);
% }
%
% $dline ^= 1;
% }
% };
-% my $show_total= sub {
-% my ($totaldesc, $sign)= @_;
-% if (defined $total) {
-<tr>
-<td colspan=3>
-<td colspan=2 align=right><% $totaldesc %>
-<td align=right><% $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);
-
+ my $totals= '';
+ if ($i < $#islandids) {
+ $totals .= "In hold $sail_total[$i]{mass}kg,".
+ " $sail_total[$i]{volume} l";
+ my $delim= '; spare ';
+ my $domv= sub {
+ my ($max, $got, $units) = @_;
+ return unless defined $max;
+ $totals .= $delim;
+ $totals .= sprintf "%g %s", ($max-$got), $units;
+ $delim= ', ';
+ };
+ $domv->($routeparams->{MaxMass}, $sail_total[$i]{mass}, 'kg');
+ $domv->($routeparams->{MaxVolume}, $sail_total[$i]{volume}, 'l');
+ $totals .= ".\n";
+ }
+ $show_total_now->($totals);
}
-</%perl>
-<tbody><tr>
+</%perl><a name="summary"></a>
+<% $tbody->(1) %><tr>
<td colspan=2>Total distance: <% $total_dist %> leagues.
<td colspan=3 align=right>Overall net cash flow
<td align=right><strong><%
%></strong>
</table>
<& query_age:dataages, id2age => \%da_ages &>
+Expected average profit:
+ approx. <strong><% sprintf "%d", $expected_total_profit %></strong> poe
+ (considering expected losses, but ignoring rum consumed)
%
% } # ========== TRADING PLAN ==========
+% if (!printable($m)) {
+<h2><a name="dataage">Data age summary</a></h2>
+<%perl>
+ my $sth_i= $dbh->prepare(<<END);
+ SELECT archipelago, islandid, islandname, timestamp
+ FROM uploads NATURAL JOIN islands
+ WHERE islandid = ?
+END
+ my $sth_a= $dbh->prepare(<<END);
+ SELECT archipelago, islandid, islandname, timestamp
+ FROM uploads NATURAL JOIN islands
+ WHERE archipelago = ?
+ ORDER BY islandname
+END
+ my $ix=$#islandids;
+ my $sth_current;
+ my %idone;
+ my $fetchrow= sub {
+ for (;;) {
+ if ($sth_current) {
+ my $row= $sth_current->fetchrow_hashref();
+ if ($row) {
+ next if $idone{$row->{'islandid'}}++;
+ return $row;
+ }
+ }
+ return undef if $ix < 0;
+ my $iid= $islandids[$ix];
+ if (defined $iid) {
+ $sth_i->execute($iid);
+ $sth_current= $sth_i;
+ } else {
+ my $arch= $archipelagoes[$ix];
+ die unless defined $arch && length $arch;
+ $sth_a->execute($arch);
+ $sth_current= $sth_a;
+ }
+ $ix--;
+ }
+ };
+</%perl>
+<&| query_age:agestable, now => $now, fetchrow => $fetchrow &>
+Islands shown in reverse order of visits.<br>
+</&>
+% }
+
+% if (!printable($m)) {
+% my %ts_sortkeys;
+% {
+% my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
+% my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
+<h2><a name="trades">Relevant trades</a></h2>
+<table id="trades" rules=groups>
+<colgroup span=1>
+<colgroup span=2>
+<% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
+<colgroup span=1>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=3>
+<colgroup span=3>
+% if ($optimise) {
+<colgroup span=3>
+% }
+<tr>
+<th>
+<th<% $cdspan %>>Collect
+<th<% $cdspan %>>Deliver
+<th>
+<th colspan=2>Collect
+<th colspan=2>Deliver
+<th colspan=2>Profit
+<th colspan=3>Max
+<th colspan=1>
+<th colspan=2>Max
+% if ($optimise) {
+<th colspan=3>Planned
+% }
+
+<tr>
+<th>
+<th>Island <% $cdstall %>
+<th>Island <% $cdstall %>
+<th>Commodity
+<th>Price
+<th>Qty
+<th>Price
+<th>Qty
+<th>Margin
+<th>Unit
+<th>Qty
+<th>Capital
+<th>Profit
+<th>Dist
+<th>Mass
+<th>Vol
+% if ($optimise) {
+<th>Qty
+<th>Capital
+<th>Profit
+% }
+% }
+
+<tr id="trades_sort">
+% foreach my $col (@cols) {
+<th>
+% }
+
+% foreach my $flowix (0..$#flows) {
+% my $flow= $flows[$flowix];
+% my $rowid= "id_row_$flow->{UidShort}";
+<tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
+<td><input type=hidden name=R<% $flow->{UidShort} %> value="">
+ <input type=checkbox name=T<% $flow->{UidShort} %> value=""
+ <% $flow->{Suppress} ? '' : 'checked' %> >
+% my $ci= 1;
+% while ($ci < @cols) {
+% my $col= $cols[$ci];
+% my $spec= {
+% Span => 1,
+% Align => ($col->{Text} ? '' : 'align=right')
+% };
+% my $cn= $col->{Name};
+% my $v;
+% if (!$col->{TotalSubflows}) {
+% $v= $flow->{$cn};
+% } else {
+% $v= 0;
+% $v += $_->{$cn} foreach @{ $flow->{Subflows} };
+% }
+% 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 <% $spec->{Span} ? "colspan=$spec->{Span}" : ''
+ %> <% $spec->{Align}
+ %>><% exists $spec->{String} ? $spec->{String} : $v |h %>
+% $ci += $spec->{Span};
+% }
+% }
+<tr id="trades_total">
+<th>
+<th colspan=2>Total
+% foreach my $ci (3..$#cols) {
+% my $col= $cols[$ci];
+<td align=right>
+% if (defined $col->{Total}) {
+<% $col->{Total} |h %>
+% }
+% }
+</table>
+
+<&| tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
+ throw => 'trades_sort', tbrow => 'trades_total' &>
+ ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+</&tabsort>
+
+<input type=submit name=update value="Update">
+
+% } # !printable
+
<%init>
use CommodsWeb;
use Commods;
http://www.htmlhelp.com/tools/validator/problems.html#script
</%doc>
+<%perl>
+my $ct= $m->content;
+
+die "bad script content $&"
+ if $ct =~ m,\<\/|--\>,;
+</%perl>
+% if (!printable($m)) {
<script type="text/javascript">
<!--
<% $ct %>
// -->
</script>
-<%init>
-my $ct= $m->content;
-
-die "bad script content $&"
- if $ct =~ m,\<\/|--\>,;
-</%init>
+% }
% print $m->content();
-% my $sortfn= "ts_sort__$table";
+% my $sortfn= "ts_s_$table";
function <% $sortfn %>(compar) {
debug('sorting compar='+compar);
var table= document.getElementById('<% $table %>');
% my $thhtml= '';
% next if $col->{NoSort};
-% my $mapfn= "ts_compar${cix}_map__$table";
-function <% $mapfn %>(rowelement) {
- var rowid = rowelement.id;
+% my $mapfn= "ts_${cix}m_$table";
+function <% $mapfn %>(re) {
+ var rowid = re.id;
% if ($col->{SortKey}) {
return <% $col->{SortKey} %>;
% } else {
% }
}
-% my $comparefn= "ts_compar${cix}_cmp0__$table";
+% my $comparefn= "ts_${cix}c0_$table";
function <% $comparefn %>(a,b) {
- var a_key = <% $mapfn %>(a);
- var b_key = <% $mapfn %>(b);
+ var ak = <% $mapfn %>(a);
+ var bk = <% $mapfn %>(b);
% if ($col->{Numeric}) {
- return a_key - b_key
+ return ak - bk
% } else {
- if (a_key < b_key) return -1;
- if (a_key > b_key) return +1;
+ if (ak < bk) return -1;
+ if (ak > bk) return +1;
return 0;
% }
}
% foreach my $reverse (qw(1 0)) {
-% my $tcomparefn= "ts_compar${cix}_cmp${reverse}__$table";
+% my $tcomparefn= "ts_${cix}c${reverse}_$table";
% if ($reverse) {
% next unless $col->{DoReverse};
function <% $tcomparefn %>(a,b) { return -<% $comparefn %>(a,b); }
+
% }
% $thhtml .= "<a href=\"javascript:$sortfn($tcomparefn)\">".
% ($reverse ? '∨' : '∧'). '</a>';
-file yarrg
-set args -Drect 2>u --edit-charset --find-island --ocean sage
-#break structure.c:596 if here!=aa_background
-break mustfail2
+file ./routesearch
+set args -d OCEAN-Midnight.db -g 3 13470 20220 -1 0.0005 search 0 10 10 30 any 34 7 5 10 35 24 2 2>u
+#break rssearch.c:179 if ports[0]==24 && ports[1]==21
run
~yarrgweb / ypp-sc-tools.web-test.git / commitdiff