From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Mon, 27 Jul 2009 00:02:36 +0000 (+0100)
Subject: WIP db populate; compute shortest paths in Perl (takes 1.5s on liberator)
X-Git-Tag: 3.0~31
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=commitdiff_plain;h=9d0479a97adee7ddc6470f6b8d3916ead77d1748

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

diff --git a/pctb/db-idempotent-populate b/pctb/db-idempotent-populate
index ccc79be..2cae151 100755
--- 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__