X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fyppedia-chart-parser;h=09e8fe8b1b82aa22e7140bf5b6ff3069310a499d;hb=0a4c9fe7e73cb5802471cbc0d975d3c7daa6513c;hp=7cc0baf5a1991a82f355c8d06d8e3b7d5568f9e6;hpb=75d214ae42db7fe877d7dbab413cd1d14cfddd3a;p=ypp-sc-tools.main.git

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index 7cc0baf..09e8fe8 100755
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -17,15 +17,23 @@ my %wiisland2node;
 my %winode2island;
 my %winode2lines;
 my %wiccix2arch;
+my $wialldists;
 
 my $dbdists= Graph::Undirected->new();
 my %dbisland2arch;
 
-my %msgcount;
-sub perr ($$) { print STDERR "$_[0]: $_[1]\n"; $msgcount{$_[0]}++; }
-sub warning ($) { perr("warning",$_[0]); }
-sub error   ($) { perr("error",  $_[0]); }
-sub change  ($) { perr("change", $_[0]); }
+my %msgs;
+sub pmsg ($$) { push @{ $msgs{$_[0]} }, "$_[0]: $_[1]\n"; }
+sub warning ($) { pmsg("warning",$_[0]); }
+sub error   ($) { pmsg("error",  $_[0]); }
+sub change  ($) { pmsg("change", $_[0]); }
+sub print_messages () {
+    foreach my $k (qw(change warning error)) {
+	my $m= $msgs{$k};
+	next unless $m;
+	print sort @$m or die $!;
+    }
+}
 
 if (@ARGV && $ARGV[0] eq '--debug') {
     shift @ARGV;
@@ -47,7 +55,7 @@ sub nn_xy ($$) {
     return $n;
 }
 
-sub parse_yppedia_map () {
+sub yppedia_chart_parse () {
     # We don't even bother with tag soup; instead we do line-oriented parsing.
 
     while (<>) {
@@ -103,7 +111,7 @@ sub parse_yppedia_map () {
     }
 }
 
-sub parse_database_map () {
+sub database_fetch_ocean () {
     my ($row,$sth);
     $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
     $sth->execute();
@@ -122,26 +130,22 @@ sub parse_database_map () {
     }
 }			 
 
-sub process_yppedia_graphs () {
-
+sub yppedia_graphs_prune_boring () {
     # Prune the LP database by eliminating boring intermediate vertices
-    #
     foreach my $delete ($widists->vertices()) {
 	next if exists $winode2island{$delete};
 	my @neigh= $widists->neighbours($delete);
 	next unless @neigh==2;
-#	my @aneigh= $wiarchs->has_vertex($delete)
-#	    ? $wiarchs->neighbours($delete) : ();
-#	next unless @aneigh==0 || @aneigh==2;
 	my $weight= 0;
 	map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
 	$widists->add_weighted_edge(@neigh, $weight);
 	$widists->delete_vertex($delete);
 	printf DEBUG "%-5s elide %5s %-5s %2d\n", $delete, @neigh, $weight;
     }
+}
 
+sub yppedia_graphs_check () {
     # Check that it's connected.
-    #
     foreach my $cc ($widists->connected_components()) {
 	next if 2*@$cc > $widists->vertices();
 	my $m= "disconnected league point(s):";
@@ -151,9 +155,10 @@ sub process_yppedia_graphs () {
 	}
 	warning($m);
     }
+}
 
+sub yppedia_archs_sourceinfo () {
     # Assign archipelagoes according to the source-info file
-    #
     foreach my $arch (sort keys %{ $oceans{$ocean} }) {
 	foreach my $islename (sort keys %{ $oceans{$ocean}{$arch} }) {
 	    my $islenode= $wiisland2node{$islename};
@@ -169,12 +174,9 @@ sub process_yppedia_graphs () {
 	    $wiccix2arch{$ccix}= $arch;
 	}
     }
+}
 
-    # Compute all-pairs-shortest-paths on dist, which is the
-    # actual distances between all LPs.
-    #
-    my $wialldists= $widists->APSP_Floyd_Warshall();
-
+sub yppedia_archs_chart_labels () {
     # Assign archipelago labels to groups of islands
     #
     foreach my $label (@wiarchlabels) {
@@ -222,7 +224,9 @@ sub process_yppedia_graphs () {
 	$wiccix2arch{$ccix}= $arch;
 #	print "$ccix $arch ::\n$desc\n";
     }
+}
 
+sub yppedia_archs_fillbynearest() {
     # Assign islands not labelled above to archipelagoes.
     #
     # We do this by, for each connected component (set of islands
@@ -329,10 +333,42 @@ sub compare_island_lists () {
     }
 }
 
+sub compare_distances () {
+    foreach my $ia (sort keys %dbisland2arch) {
+	my $na= $wiisland2node{$ia};
+	next unless defined $na;
+	foreach my $ib (sort keys %dbisland2arch) {
+	    next unless $ia le $ib; # do every pair only once
+	    my $nb= $wiisland2node{$ib};
+	    next unless defined $nb;
+	    my $dbdist= $dbdists->get_edge_weight($ia,$ib);
+	    my $widist= $wialldists->path_length($na,$nb);
+	    if (!defined $dbdist) {
+		change(sprintf "define distance %2d for %s..%s",
+		       $widist, $ia,$ib);
+	    } elsif ($dbdist != $widist) {
+		change(sprintf "change distance %2d to %2d for %s..%s",
+		       $dbdist, $widist, $ia,$ib);
+	    }
+	}
+    }
+}
+
 parse_info_serverside();
+
 db_setocean($ocean);
 db_connect();
-parse_yppedia_map();
-parse_database_map();
-process_yppedia_graphs();
+database_fetch_ocean();
+
+yppedia_chart_parse();
+yppedia_graphs_prune_boring();
+yppedia_graphs_check();
+yppedia_archs_sourceinfo();
+$wialldists= $widists->APSP_Floyd_Warshall();
+yppedia_archs_chart_labels();
+yppedia_archs_fillbynearest();
+
 compare_island_lists();
+compare_distances();
+
+print_messages();