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

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index 09e8fe8..fca7abd 100755
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -12,6 +12,8 @@ my $ocean= 'Midnight';
 
 my $widists= Graph::Undirected->new();
 my $wiarchs= Graph::Undirected->new();
+my $wispr;
+my $dbspr;
 my @wiarchlabels;
 my %wiisland2node;
 my %winode2island;
@@ -34,6 +36,7 @@ sub print_messages () {
 	print sort @$m or die $!;
     }
 }
+sub progress ($) { print "($_[0])\n"; }
 
 if (@ARGV && $ARGV[0] eq '--debug') {
     shift @ARGV;
@@ -81,7 +84,6 @@ sub yppedia_chart_parse () {
 	    $winode2island{$n}= $island;
 	    $widists->add_vertex($n);
 	    $wiarchs->add_vertex($n);
-#print "\$g->add_vertex('$n');\n";
 	    printf DEBUG "%2d,%-2d island %s\n", $x,$y,$island;
 	} elsif (($solid,$x,$y,$dirn) =
 	    m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
@@ -94,13 +96,13 @@ sub yppedia_chart_parse () {
 	    elsif ($dirn eq '/') { $x++; $by++; }
 	    else { die; }
 
-	    $widists->add_weighted_edge($nn->(), nn_xy($bx,$by), 1);
-	    $wiarchs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
-	    $wiarchs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
-#print "\$g->add_edge('".$nn->()."','".nn_xy($bx,$by)."');\n" if $solid;
+	    my $nb= nn_xy($bx,$by);
+	    $widists->add_weighted_edge($nn->(), $nb, 1);
+	    $wiarchs->add_edge($nn->(), $nb) if $solid;
+	    $wiarchs->add_edge($nn->(), $nb) if $solid;
 
-	    printf DEBUG "%2d,%-2d league %-6s %s\n", $x,$y,
-	        $solid?'solid':'dotted', $dirn;
+	    printf DEBUG "%2d,%-2d league %-6s %s %s\n", $x,$y,
+	        $solid?'solid':'dotted', $dirn, $nb;
 	} elsif (
 	    m/^\{\{ chart\ head \}\}$/xi
 		 ) {
@@ -130,6 +132,29 @@ sub database_fetch_ocean () {
     }
 }			 
 
+sub database_graph_spr () {
+    $dbspr= shortest_path_reduction('db',$dbdists);
+}
+
+sub yppedia_graphs_add_shortcuts () {
+    # We add edges between LPs we know about, as you can chart
+    # between them.  Yppedia often lacks these edges.
+    #
+    foreach my $p ($widists->vertices) {
+	my ($ax,$ay) = $p =~ m/^(\d+)\,(\d+)$/ or die;
+	my $add_shortcut= sub {
+	    my $q= sprintf "%d,%d", $ax+$_[0], $ay+$_[1];
+	    return unless $widists->has_vertex($q);
+	    return if $widists->has_edge($p,$q);
+	    printf DEBUG "%-5s league-shortcut %-5s\n", $p, $q;
+	    $widists->add_weighted_edge($p,$q,1);
+	};
+	$add_shortcut->( 2,0);
+	$add_shortcut->(+1,1);
+	$add_shortcut->(-1,1);
+    }
+}
+
 sub yppedia_graphs_prune_boring () {
     # Prune the LP database by eliminating boring intermediate vertices
     foreach my $delete ($widists->vertices()) {
@@ -262,8 +287,9 @@ sub yppedia_archs_fillbynearest() {
 	    next unless $ccs_useful[$targetccix];
 	    foreach my $target ($wiarchs->
 			 connected_component_by_index($targetccix)) {
+		next unless $widists->has_vertex($target);
 		foreach my $source (@sourcecc) {
-		    my $target_dist= $wialldists->path_length($target,$source);
+		    my $target_dist= widist($target,$source);
 		    next unless defined $target_dist;
 		    next if $target_dist >= $best_dist;
 		    $best_dist= $target_dist;
@@ -289,6 +315,20 @@ sub yppedia_archs_fillbynearest() {
     }
 }
 
+sub yppedia_graph_shortest_paths () {
+    $wialldists= $widists->APSP_Floyd_Warshall();
+}
+
+sub widist ($$) {
+    my ($p,$q) = @_;
+    my $pl= $wialldists->path_length($p,$q);
+#    die "$p $q" unless defined $pl;
+#    my @pv= $wialldists->path_vertices($p,$q);
+#    if (@pv == $pl) { return $pl; }
+#   printf DEBUG "%-5s PATHLENGTH %-5s pl=%s pv=%s\n", $p,$q,$pl,join('|',@pv);
+    return $pl;
+}
+			
 sub winode2arch ($) {
     my ($node) = @_;
     my $ccix= $wiarchs->connected_component_by_vertex($node);
@@ -315,7 +355,7 @@ sub compare_island_lists () {
 	}
 	my $dbarch= $dbisland2arch{$island};
 	if ($wiarch ne $dbarch) {
-	    change("change archipelago from $dbarch to $wiarch".
+	    change("archipelago change from $dbarch to $wiarch".
 		   " for island $island");
 	}
     }
@@ -328,9 +368,135 @@ sub compare_island_lists () {
 		next;
 		# We check arches of non-new islands above
 	    }
-	    change("new island in $wiarch: $island");
+	    change("island new in $wiarch: $island");
+	}
+    }
+}
+
+sub shortest_path_reduction ($$) {
+    my ($what,$g) = @_;
+    #
+    # Takes a graph $g (and a string for messages $what) and returns
+    # a new graph which is the miminal shortest path transient reduction
+    # of $g.
+    #
+    # We also check that the shortest path closure of the intended result
+    # is the same graph as the input.  Thus the input must itself be
+    # a shortest path closure; if it isn't, we die.
+
+    my $proof=<<'END'; # way to make a big comment
+
+    Premises and definitions:
+
+    1. F is an undirected weighted graph with positive edge weights.
+
+    2. All graphs we will consider have the same vertices as F.
+
+    3. G = Closure(F) is the graph of cliques whose edge weights
+       are the shortest paths in F, one clique for each connected
+       component in F.
+
+    3a. |XY| for vertices X, Y is the weight of the edge XY in G.
+       If XY is not in G, |XY| is infinite.
+
+    4. A `reduction' of G is a subgraph K of G such that Closure(K) = G.
+       The reduction is `minimal' if there is no strict subgraph K'
+       of K such that Closure(K') = G.
+
+    5. Now each edge of G may be:
+       - `unnecessary': included in no minimal reductions of G.
+       - `essential': included in all minimal reductions of G.
+       - `contingent': included in some but not all.
+
+    6. Consider for any edge AC between the vertices A and C,
+       whether there is any B such that |AB|+|BC| = |AC| ?
+       (There can be no B such that the sum < |AC| since that would
+       mean that |AC| wasn't equal to the shortest path length.)
+
+    6a. No such B:  AC is therefore the only shortest path from A to C
+	(since G is not a multigraph).  AC is thus an essential edge.
+
+    6b. Some such B: Call all such edges AC `questionable'.
+
+    6c. Thus all edges are essential or questionable.
+
+    7. Suppose AC is a shortest contingent edge.  AC must be
+       questionable since it is not essential.  Suppose it is
+       made questionable by the existence of B such that |AB|+|BC| =
+       |AC|.  Consider AB and BC.  Since |AB| and |BC| are positive,
+       |BC| and |AB| must be < |AC| ie AB and BC are shorter than AC.
+       Since AC is a shortest contingent edge, there must be shortest
+       paths in G for AB and BC consisting entirely of essential edges.
+
+    8. Therefore it is always safe to remove AC since the paths
+       A..B and B..C will definitely still remain and provide a path
+       A..B..C with length |AB|+|BC| = |AC|.
+
+    9. Thus AC is unnecessary, contradicting the assumption in 7.
+       There are therefore no shortest contingent edges, and
+       thus no contingent edges.
+
+    10. We can construct a minimal reduction directly: for each edge
+        AC in G, search for a vertex B such that |AB|+|BC| = |AC|.
+        If we find none, AC is essential.  If we find one then AC is
+        not essential and is therefore unnecessary.
+
+END
+    
+    printf DEBUG "spr %s before %d\n", $what, scalar($g->edges());
+
+    my $result= Graph::Undirected->new();
+    foreach my $edge_ac ($g->edges()) {
+	my $edgename_ac= join ' .. ', @$edge_ac;
+	printf DEBUG "spr %s edge %s\n", $what, $edgename_ac;
+	my $w_ac= $g->get_edge_weight(@$edge_ac);
+	my $needed= 1;
+	foreach my $vertex_b ($g->vertices()) {
+	    next if grep { $_ eq $vertex_b } @$edge_ac;
+	    my $w_ab= $g->get_edge_weight($edge_ac->[0], $vertex_b);
+	    next unless defined $w_ab;
+	    next if $w_ab >= $w_ac;
+	    my $w_bc= $g->get_edge_weight($vertex_b, $edge_ac->[1]);
+	    next unless defined $w_ac;
+	    next if $w_ab + $w_bc > $w_ac;
+	    # found path
+	    printf DEBUG "spr %s edge %s unnecessary %s\n",
+	        $what, $edgename_ac, $vertex_b;
+	    $needed= 0;
+	    last;
+	}
+	if ($needed) {
+	    printf DEBUG "spr %s edge %s essential\n", $what, $edgename_ac;
+	    $result->add_weighted_edge(@$edge_ac,$w_ac);
+	}
+    }
+    printf DEBUG "spr %s result %d\n", $what, scalar($result->edges());
+
+    my $apsp= $result->APSP_Floyd_Warshall();
+    foreach my $ia (sort $g->vertices()) {
+	foreach my $ib (sort $g->vertices()) {
+	    my $din= $g->get_edge_weight($ia,$ib);
+	    my $dout= $apsp->path_length($ia,$ib);
+	    $din= defined($din) ? $din : 'infinity';
+	    $dout= defined($dout) ? $dout : 'infinity';
+	    error("$what spr apsp discrepancy in=$din out=$dout".
+                  " for $ia .. $ib")
+		if $din != $dout;
+	}
+    }
+    return $result;
+}
+
+sub yppedia_graph_spr () {
+    my $base= Graph::Undirected->new();
+    foreach my $na (sort keys %winode2island) {
+	my $ia= $winode2island{$na};
+	foreach my $nb (sort keys %winode2island) {
+	    my $ib= $winode2island{$nb};
+	    $base->add_weighted_edge($ia,$ib, widist($na,$nb));
 	}
     }
+    $wispr= shortest_path_reduction('wi',$base);
 }
 
 sub compare_distances () {
@@ -339,15 +505,18 @@ sub compare_distances () {
 	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",
+	    my $dbdist= $dbspr->get_edge_weight($ia,$ib);
+	    my $widist= $wispr->get_edge_weight($ia,$ib);
+	    next unless defined $dbdist || defined $widist;
+	    
+	    if (!defined $widist) {
+		warning(sprintf "route delete %2d for %s .. %s",
+			$dbdist, $ia,$ib);
+	    } elsif (!defined $dbdist) {
+		change(sprintf "route new %2d for %s .. %s",
 		       $widist, $ia,$ib);
 	    } elsif ($dbdist != $widist) {
-		change(sprintf "change distance %2d to %2d for %s..%s",
+		change(sprintf "route change %2d to %2d for %s .. %s",
 		       $dbdist, $widist, $ia,$ib);
 	    }
 	}
@@ -356,19 +525,25 @@ sub compare_distances () {
 
 parse_info_serverside();
 
+progress("reading database");
+
 db_setocean($ocean);
 db_connect();
 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();
+progress("computing database spr");         database_graph_spr();
+
+progress("reading yppedia chart");          yppedia_chart_parse();
+progress("adding shortcuts");               yppedia_graphs_add_shortcuts();
+progress("pruning boring vertices");        yppedia_graphs_prune_boring();
+progress("checking yppedia graphs");        yppedia_graphs_check();
+progress("setting archs from source-info"); yppedia_archs_sourceinfo();
+progress("computing shortest paths");       yppedia_graph_shortest_paths();
+progress("setting archs from labels");      yppedia_archs_chart_labels();
+progress("setting archs from nearby");      yppedia_archs_fillbynearest();
+progress("computing yppedia spr");          yppedia_graph_spr();
 
-compare_island_lists();
-compare_distances();
+progress("comparing islands");              compare_island_lists();
+progress("comparing distances");            compare_distances();
 
 print_messages();