chiark / gitweb /
Do topology comparison with new reduction algorithm
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Fri, 28 Aug 2009 17:00:45 +0000 (18:00 +0100)
committerIan Jackson <Ian.Jackson@eu.citrix.com>
Fri, 28 Aug 2009 17:00:45 +0000 (18:00 +0100)
yarrg/yppedia-chart-parser

index e1f022c..f834362 100755 (executable)
@@ -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;
@@ -129,6 +131,10 @@ 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.
@@ -308,7 +314,7 @@ sub yppedia_archs_fillbynearest() {
     }
 }
 
-sub yppedia_graphs_shortest_paths () {
+sub yppedia_graph_shortest_paths () {
     $wialldists= $widists->APSP_Floyd_Warshall();
 }
 
@@ -366,21 +372,81 @@ sub compare_island_lists () {
     }
 }
 
+sub shortest_path_reduction ($$) {
+    my ($what,$base) = @_;
+    printf DEBUG "spr %s before %d\n", $what, scalar($base->edges());
+
+    my $result= Graph::Undirected->new();
+    foreach my $edge_ac ($base->edges()) {
+       my $edgename_ac= join '..', @$edge_ac;
+       printf DEBUG "spr %s edge %s\n", $what, $edgename_ac;
+       my $w_ac= $base->get_edge_weight(@$edge_ac);
+       my $needed= 1;
+       foreach my $vertex_b ($base->vertices()) {
+           next if grep { $_ eq $vertex_b } @$edge_ac;
+           my $w_ab= $base->get_edge_weight($edge_ac->[0], $vertex_b);
+           next unless defined $w_ab;
+           next if $w_ab >= $w_ac;
+           my $w_bc= $base->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 $base->vertices()) {
+       foreach my $ib (sort $base->vertices()) {
+           my $din= $base->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 () {
     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= widist($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 create %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);
            }
        }
@@ -395,14 +461,17 @@ db_setocean($ocean);
 db_connect();
 database_fetch_ocean();
 
+print "computing database spr\n";         database_graph_spr();
+
 print "reading yppedia chart\n";          yppedia_chart_parse();
 print "adding shortcuts\n";               yppedia_graphs_add_shortcuts();
-print "pruning bording vertices\n";       yppedia_graphs_prune_boring();
+print "pruning boring vertices\n";        yppedia_graphs_prune_boring();
 print "checking yppedia graphs\n";        yppedia_graphs_check();
 print "setting archs from source-info\n"; yppedia_archs_sourceinfo();
-print "computing shortest paths\n";       yppedia_graphs_shortest_paths();
+print "computing shortest paths\n";       yppedia_graph_shortest_paths();
 print "setting archs from labels\n";      yppedia_archs_chart_labels();
 print "setting archs from nearby\n";      yppedia_archs_fillbynearest();
+print "computing yppedia spr\n";          yppedia_graph_spr();
 
 print "comparing\n";