WIP db populate; compute shortest paths in Perl (takes 1.5s on liberator)

[ypp-sc-tools.db-live.git] / pctb / db-idempotent-populate

diff --git a/pctb/db-idempotent-populate b/pctb/db-idempotent-populate
index ccc79be3609a42fb0c6197839980f2641a7fcdef..2cae151b3a236a62386c8b554ffcf6d51a396bde 100755 (executable)
--- a/pctb/db-idempotent-populate
+++ b/pctb/db-idempotent-populate
@@ -146,73 +146,78 @@ END
            " for unknown island $islandname\n";
     }
 
+    my $allroutes= $routes{$oceanname};
+
+    my @propqueue= ();
+
+    sub distance_set_propagate ($$$$) {
+       my ($lev, $start, $upto, $start2upto) = @_;
+       $allroutes->{$start}{$upto}= $start2upto;
+       push @propqueue, [ $lev, $start, $upto ];
+    }
+
+    sub distance_propagate_now {
+       my ($lev, $start, $upto) = @_;
+       my $startref= $allroutes->{$start};
+       my $start2upto= $startref->{$upto};
+       my $uptoref=  $allroutes->{$upto};
+
+       for my $next (keys %$uptoref) {
+           next if $next eq $upto;
+           my $unext= $uptoref->{$next};
+           next unless defined $unext;
+           distance_update("${lev}p", $start, $next, $start2upto + $unext);
+       }
+    }
+
+    sub distance_update ($$$$) {
+       my ($lev, $x, $y, $newdist) = @_;
+       distance_update_one("${lev}x",$x,$y,$newdist);
+       distance_update_one("${lev}y",$y,$x,$newdist);
+    }
+
+    sub distance_update_one ($$$$) {
+       my ($lev, $x, $y, $newdist) = @_;
+       my $xref= $allroutes->{$x};
+       my $currently= $xref->{$y};
+       return if defined($currently) and $currently <= $newdist;
+       distance_set_propagate("${lev}o",$x,$y,$newdist);
+    }
+
+    foreach my $xn (keys %$allroutes) {
+       my $routes= $allroutes->{$xn};
+       distance_set_propagate('0', $xn, $xn, 0);
+       foreach my $yn (keys %$routes) {
+           distance_set_propagate('0', $yn, $yn, 0);
+           distance_set_propagate('X', $xn, $yn, $routes->{$yn});
+           distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
+       }
+    }
+    my $ref;
+    while ($ref= shift @propqueue) {
+       distance_propagate_now(@$ref);
+    }
+
     dbdoall(<<END)
- CREATE TEMPORARY TABLE newdists (
-       aiid            INTEGER                 NOT NULL,
-       biid            INTEGER                 NOT NULL,
-       dist            INTEGER                 NOT NULL
- );
- INSERT INTO newdists SELECT (aiid,biid,dist) FROM dists;
- INSERT INTO newdists SELECT (biid,aiid,dist) FROM dists;
- INSERT INTO newdists SELECT (islandid,islandid,0) FROM islands;
+ DELETE FROM dists;
 END
     ;
-
     my $sth= $dbh->prepare(<<'END')
- INSERT INTO newdists VALUES
+ INSERT INTO dists VALUES
        ((SELECT islandid FROM islands WHERE islandname == ?),
         (SELECT islandid FROM islands WHERE islandname == ?),
         ?);
 END
     ;
-    my $allroutes= $routes{$oceanname};
-    foreach my $an (keys %$allroutes) {
-       my $routes= $allroutes->{$an};
-       foreach my $bn (keys %$routes) {
-           $sth->execute($an, $bn, $routes->{$bn});
+    foreach my $xn (keys %$allroutes) {
+       my $routes= $allroutes->{$xn};
+       foreach my $yn (keys %$routes) {
+           $sth->execute($xn, $yn, $routes->{$yn});
        }
     }
+    $dbh->commit();
 
-    my $stmt_updatemain= $dbh->prepare(<<'END')
- UPDATE dists SET dist = (
-       SELECT min(dist) FROM newdists
-       WHERE dists.aiid == newdists.aiid
-         AND dists.biid == newdists.biid
-         AND NOT dists.dist <= newdists.dist
- );
-END
-
-    my $stmt_removeredund= $dbh->prepare(<<'END')
- DELETE FROM newdists
-       WHERE dist > (
-               SELECT dists.dist
-               WHERE dists.aiid == newdists.aiid
-                 AND dists.aiid == newdists.aiid
- );
-END
-    ;
-
-    my $stmt_gennew= $dbh->prepare(<<'END')
- INSERT INTO newdists (
-       SELECT src.aiid, dst.biid, min(src.dist + dst.dist)
-       FROM dists AS src, dists AS dst ON src.biid == dst.aiid
-       GROUP BY src.aiid, dst.biid
- );
-END
-    ;
-    
-    for (;;) {
-       $ar= $dbh->selectall_arrayref("select ia.islandname, ib.islandname,newdists.dist from newdists, islands as ia on newdists.aiid = ia.islandid, islands as ib on newdists.biid = ib.islandid;");
-       print Dumper($ar);
-
-       my $affected= $stmt_updatemain->execute();
-       last unless $affected;
-
-       $stmt_
-       
+    # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname;
 }
 
-#use Data::Dumper;
-#print Dumper(\%routes);
-
 __DATA__