chiark / gitweb /
wip route computation
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 26 Jul 2009 19:20:33 +0000 (20:20 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 26 Jul 2009 19:20:33 +0000 (20:20 +0100)
pctb/Commods.pm
pctb/db-idempotent-populate
pctb/ocean-midnight.txt [new file with mode: 0644]

index 712847d..75d48c4 100644 (file)
@@ -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;
index 1b0ef02..893f4a7 100755 (executable)
@@ -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(<<END)
  CREATE TABLE IF NOT EXISTS $bs (
        commodid        INTEGER                 NOT NULL,
        islandid        INTEGER                 NOT NULL,
        stallid         INTEGER                 NOT NULL,
-       price           INTEGER,
-       qty             INTEGER,
+       price           INTEGER                 NOT NULL,
+       qty             INTEGER                 NOT NULL,
        PRIMARY KEY (commodid, islandid, stallid)
  );
  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
@@ -102,7 +109,7 @@ END
 
 $dbh->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 (file)
index 0000000..6ccae43
--- /dev/null
@@ -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