From: Ian Jackson Date: Sun, 26 Jul 2009 19:20:33 +0000 (+0100) Subject: wip route computation X-Git-Tag: 3.0~33 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=commitdiff_plain;h=e3bd945bfba693d7467f28a2c59e77219387caa9 wip route computation --- diff --git a/pctb/Commods.pm b/pctb/Commods.pm index 712847d..75d48c4 100644 --- a/pctb/Commods.pm +++ b/pctb/Commods.pm @@ -32,7 +32,8 @@ BEGIN { our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(&parse_masters %oceans %commods %clients + @EXPORT = qw(&parse_masters &parse_masters_ocean + %oceans %commods %clients %routes %route_mysteries &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap &get_our_version &check_tsv_line &pipethrough_prep &pipethrough_run @@ -47,6 +48,8 @@ BEGIN { our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources; our %commods; # eg $commods{'Fine black cloth'}= $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 # $sources = 's[l]b'; # 's' = Special Circumstances; 'l' = local ; B = with Bleach @@ -78,6 +81,12 @@ sub parse_master_master1 ($$) { $oceans{$ocean}{$arch}{$_} .= $src; }; }); + } elsif (m/^routes (\w+)$/) { + my $ocean= $1; + @ctx= (sub { + m/^(\S[^\t]*\S)\t+(\S[^\t]*\S)\t+([1-9][0-9]{0,2})$/ or die; + $routes{$ocean}{$1}{$2}= $3; + }); } elsif (m/^client (\S+.*\S)$/) { my $client= $1; $clients{$client}= [ ]; @@ -111,11 +120,48 @@ sub parse_master_master1 ($$) { } }; 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_master_map_route_islands($on, \@allislands, $routes); + foreach my $route (values %$routes) { + parse_master_map_route_islands($on, \@allislands, $route); + } + } +} + +sub parse_master_map_route_islands ($$$) { + 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_masters () { parse_master_master1('master-master.txt','s'); } +sub parse_masters_ocean ($) { + my ($oceanname) = @_; + parse_master_master1('master-master.txt','s'); + die "unknown ocean $oceanname ?" unless exists $oceans{$oceanname}; + parse_master_master1("ocean-".(lc $oceanname).".txt",'s'); +} sub parse_pctb_commodmap () { undef %pctb_commodmap; diff --git a/pctb/db-idempotent-populate b/pctb/db-idempotent-populate index 1b0ef02..893f4a7 100755 --- a/pctb/db-idempotent-populate +++ b/pctb/db-idempotent-populate @@ -33,9 +33,9 @@ use DBI; use Commods; @ARGV==1 or die; -my ($ocean) = @ARGV; +my ($oceanname) = @ARGV; -my $dbfn= "OCEAN-$ocean.db"; +my $dbfn= "OCEAN-$oceanname.db"; our $dbh; @@ -45,20 +45,27 @@ sub dbdoall ($) { } } +#---------- setup ---------- + +parse_masters_ocean($oceanname); +our $ocean= $oceans{$oceanname}; + $dbh= DBI->connect("dbi:SQLite:$dbfn",'','', { AutoCommit=>0, RaiseError=>1, ShowErrorStatement=>1, unicode=>1 }) or die "$dbfn $DBI::errstr ?"; +#---------- schema ---------- + foreach my $bs (qw(buy sell)) { dbdoall(<commit; -parse_masters(); +#---------- commodity list ---------- { my $sth= $dbh->prepare(<<'END') @@ -114,3 +121,67 @@ END } $dbh->commit; } + +#---------- island list ---------- + +{ + my $sth= $dbh->prepare(<<'END') + INSERT OR IGNORE INTO islands (islandname, archipelago) values (?, ?); +END + ; + foreach my $archname (sort keys %$ocean) { + my $arch= $ocean->{$archname}; + foreach my $islandname (sort keys %$arch) { + $sth->execute($islandname, $archname); + } + } + $dbh->commit; +} + +#---------- routes ---------- + +foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { + warn "$route_mysteries{$oceanname}{$islandname} routes". + " for unknown island $islandname\n"; +} + +#use Data::Dumper; +#print Dumper(\%routes); + +__DATA__ + + /* 'distances' will hold the final results. */ + create table distances ( + a varchar(40) not null references islands(name), + b varchar(40) not null references islands(name), + distance int not null, + primary key (a,b) ); + + /* Create a rule such that insertion into the distances table is only + possible if a shorter route or a new route is being recorded; all other + inserts are ignored. */ + + create or replace rule update_only_if_shorter as + on insert to distances + where ((new.a,new.b) in (select a,b from distances)) + do instead + update distances set distance=(case when new.distance<=distance then + new.distance else distance end) + where a=new.a and b=new.b; + + /* Start by copying manually entered routes into distances */ + insert into distances (select a,b,distance from routes); + /* Also all the reverse routes */ + insert into distances (select b,a,distance from routes); + /* Also all the null routes */ + insert into distances (select distinct a,a,0 from routes); + insert into distances (select distinct b,b,0 from routes); + + /* Now extend the distances table by computing new routes */ + insert into distances (select source.a,dest.b, + min(source.distance+dest.distance) + from distances source,distances dest + where source.b=dest.a group by source.a,dest.b); + + /* Repeat that query until no new routes are added (i.e. select count(*) + from distances; returns the same value after the query as it does before) */ diff --git a/pctb/ocean-midnight.txt b/pctb/ocean-midnight.txt new file mode 100644 index 0000000..6ccae43 --- /dev/null +++ b/pctb/ocean-midnight.txt @@ -0,0 +1,129 @@ +routes Midnight + # Try to include "shortcut" routes (those where you can chart a + # league that isn't actually on any inter-island charts), but if you + # don't it won't affect things too much. + + # Ruby internal + Olivia Midsummer 3 + Midsummer Cranberry 2 + Olivia Lynx 5 + Olivia Eta 7 + Cranberry Eta 3 + Lynx Eta 3 + Lynx Islay of Luthien 5 + Eta Islay of Luthien 4 + Islay of Luthien Jorvik 5 + Eta Jorvik 5 + + # Pearl internal and interarch + Cleopatra O'Reilly 3 + Cleopatra Zeta 4 + Cleopatra Nuptial 6 + O'Reilly Nuptial 4 + O'Reilly Zeta 6 + Nuptial Zeta 4 + Nuptial Ostreum 6 + Zeta Tadpole 4 + Tadpole Ostreum 6 + Tadpole Frond 4 + Frond Ostreum 4 + Frond Zeta 6 + Nuptial Islay of Luthien 10 + Ostreum Wrasse 6 + Ostreum Gaea 10 + Frond Wrasse 9 + Frond Gaea 13 + + # Diamond internal and interarch - this has lots of shortcut routes + Turtle Jorvik 6 + Turtle Papaya 3 + Turtle Cnossos 8 + Turtle Alpha 7 + Papaya Byrne 3 + Papaya Alpha 6 + Papaya Oyster 8 + Papaya Winter Solstice 11 + Cnossos Alpha 3 + Cnossos Winter Solstice 4 + Cnossos Guava 6 + Winter Solstice Guava 9 + Winter Solstice Alpha 6 + Winter Solstice Oyster 5 + Winter Solstice Park 11 + Winter Solstice Delta 16 + Winter Solstice Byrne 9 + Alpha Oyster 3 + Oyster Park 7 + Oyster Delta 12 + Alpha Byrne 4 + Byrne Remora 10 + Papaya Remora 8 + + # Emerald internal and interarch to Jet and Opal + Wrasse Guava 5 + Wrasse Gaea 5 + Wrasse Epsilon 11 + Guava Epsilon 7 + Gaea Epsilon 4 + Gaea Tinga 8 + Epsilon Emperor 3 + Epsilon Spring 6 + Emperor Spring 4 + Epsilon Tinga 5 + Tinga Spring 4 + Tinga Hephaestus 11 + Spring Hephaestus 8 + Tinga Orca 8 + + # Opal internal + Orca Endurance 3 + Orca Norse 5 + Orca Nu 4 + Nu Norse 3 + Nu Endurance 3 + Nu Oseberg 4 + Norse Oseberg 6 + Norse Waterberry 4 + Waterberry Boyle 3 + Boyle Flow 3 + Flow Oseberg 3 + + # Jet internal + Hephaestus Namath 6 + Hephaestus Xi 4 + Hephaestus Lagniappe 8 + Hephaestus Dugong 10 + Namath Rhinoceros Ridge 3 + Rhinoceros Ridge Lagniappe 2 + Xi Lagniappe 5 + Xi Chaparral 4 + Xi Eclipse 6 + Chaparral Eclipse 4 + Lagniappe Dugong 3 + Lagniappe Eclipse 5 + + # Coral internal and interarch to Jet + Park Angelfish 5 + Angelfish Meke 4 + Park Delta 6 + Delta Angelfish 3 + Delta Macaw 5 + Macaw Monsoon 3 + Monsoon Chaparral 6 + Monsoon Turongo 4 + Monsoon Durian 6 + Turongo Durian 3 + Turongo Angelfish 7 + Turongo Delta 8 + Turongo Park 11 + + # Sapphire internal + Remora The Horseshoe Crabs 3 + Remora Beta 3 + The Horseshoe Crabs Verdant Atoll 3 + The Horseshoe Crabs Beta 5 + Beta Iris 4 + Verdant Atoll Uxmal 3 + Verdant Atoll Iris 6 + Uxmal Iris 4 + Iris Vernal Equinox 3