yarrg/yppedia-chart-parser

   1 #!/usr/bin/perl
   2
   3 # Updater for island topology
   4
   5 # This is part of ypp-sc-tools, a set of third-party tools for assisting
   6 # players of Yohoho Puzzle Pirates.
   7 #
   8 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   9 #
  10 # This program is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation, either version 3 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 #
  23 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  24 # are used without permission.  This program is not endorsed or
  25 # sponsored by Three Rings.
  26
  27 # usage: ./yppedia-chart-parser OCEAN
  28
  29 use strict (qw(vars));
  30 use warnings;
  31
  32 use Graph::Undirected;
  33 use Commods;
  34 use CommodsDatabase;
  35
  36 my $widists= Graph::Undirected->new();
  37 my $wiarchs= Graph::Undirected->new();
  38 my $wispr;
  39 my $dbspr;
  40 my @wiarchlabels;
  41 my %wiisland2node;
  42 my %winode2island;
  43 my %winode2lines;
  44 my %wiccix2arch;
  45 my $wialldists;
  46 my %wtisland2arch;
  47
  48 my $dbdists= Graph::Undirected->new();
  49 my %dbisland2arch;
  50
  51 my %msgs;
  52 sub pmsg ($$) { push @{ $msgs{$_[0]} }, "$_[0]: $_[1]\n"; }
  53 sub warning ($) { pmsg("warning",$_[0]); }
  54 sub error   ($) { pmsg("error",  $_[0]); }
  55 sub change  ($) { pmsg("change", $_[0]); }
  56 sub print_messages () {
  57     foreach my $k (qw(change warning error)) {
  58         my $m= $msgs{$k};
  59         next unless $m;
  60         print sort @$m or die $!;
  61     }
  62 }
  63 sub progress ($) { print "($_[0])\n"; }
  64
  65 if (@ARGV && $ARGV[0] eq '--debug') {
  66     shift @ARGV;
  67     open DEBUG, ">&STDOUT" or die $!;
  68     select(DEBUG); $|=1;
  69 } else {
  70     open DEBUG, ">/dev/null" or die $!;
  71 }
  72 select(STDOUT); $|=1;
  73
  74 @ARGV==1 or die;
  75 $ARGV[0] =~ m/^\-/ and die;
  76 my $ocean= shift @ARGV;
  77
  78
  79 my $parity;
  80 sub nn_xy ($$) {
  81     my ($x,$y) = @_;
  82     my $tp= (0+$x ^ 0+$y) & 1;
  83     defined $parity or $parity=$tp;
  84     $tp==$parity or warning("line $.: parity error $x,$y is $tp not $parity");
  85     my $n= "$_[0],$_[1]";
  86     $winode2lines{$n}{$.}++;
  87     return $n;
  88 }
  89
  90 sub yppedia_chart_parse () {
  91     # We don't even bother with tag soup; instead we do line-oriented parsing.
  92
  93     while (<OCEAN>) {
  94         s/\<--.*--\>//g;
  95         s/^\s*//; chomp; s/\s+$//; s/\s+/ /g;
  96         s/\<\/?(?:b|em)\>//g;
  97         s/\{\{Chart\ style\|[^{}]*\}\}//g;
  98         next unless m/\{\{/; # only interested in chart template stuff
  99
 100         my ($x,$y, $arch,$island,$solid,$dirn);
 101         my $nn= sub { return nn_xy($x,$y) };
 102
 103         if (($x,$y,$arch) =
 104             m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
 105                     \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) {
 106             printf DEBUG "%2d,%-2d arch %s\n", $x,$y,$arch;
 107             push @wiarchlabels, [ $x,$y,$arch ];
 108         } elsif (($x,$y,$island) =
 109             m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
 110                     ([^| ][^|]*[^| ]) \| .*\}\}$/xi) {
 111             my $n= $nn->();
 112             $wiisland2node{$island}= $n;
 113             $winode2island{$n}= $island;
 114             $widists->add_vertex($n);
 115             $wiarchs->add_vertex($n);
 116             printf DEBUG "%2d,%-2d island %s\n", $x,$y,$island;
 117         } elsif (($solid,$x,$y,$dirn) =
 118             m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
 119                     ([-\/\\o]) \| .*\}\}$/xi) {
 120             next if $dirn eq 'o';
 121
 122             my ($bx,$by) = ($x,$y);
 123             if ($dirn eq '-') { $bx+=2; }
 124             elsif ($dirn eq '\\') { $bx++; $by++; }
 125             elsif ($dirn eq '/') { $x++; $by++; }
 126             else { die; }
 127
 128             my $nb= nn_xy($bx,$by);
 129             $widists->add_weighted_edge($nn->(), $nb, 1);
 130             $wiarchs->add_edge($nn->(), $nb) if $solid;
 131             $wiarchs->add_edge($nn->(), $nb) if $solid;
 132
 133             printf DEBUG "%2d,%-2d league %-6s %s %s\n", $x,$y,
 134                 $solid?'solid':'dotted', $dirn, $nb;
 135         } elsif (
 136             m/^\{\{ chart\ head \}\}$/xi
 137                  ) {
 138             next;
 139         } else {
 140             warning("line $.: ignoring incomprehensible: $_");
 141         }
 142     }
 143 }
 144
 145 sub database_fetch_ocean () {
 146     my ($row,$sth);
 147     $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
 148     $sth->execute();
 149     while ($row= $sth->fetchrow_hashref) {
 150         print DEBUG "database-island $row->{'islandname'}".
 151                      " $row->{'archipelago'}\n";
 152         $dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
 153     }
 154     $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b
 155                                 FROM dists
 156                                 JOIN islands AS a ON dists.aiid==a.islandid
 157                                 JOIN islands AS b ON dists.biid==b.islandid');
 158     $sth->execute();
 159     while ($row= $sth->fetchrow_hashref) {
 160         $dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
 161     }
 162 }
 163
 164 sub database_graph_spr () {
 165     $dbspr= shortest_path_reduction('db',$dbdists);
 166 }
 167
 168 sub yppedia_graphs_add_shortcuts () {
 169     # We add edges between LPs we know about, as you can chart
 170     # between them.  Yppedia often lacks these edges.
 171     #
 172     foreach my $p ($widists->vertices) {
 173         my ($ax,$ay) = $p =~ m/^(\d+)\,(\d+)$/ or die;
 174         my $add_shortcut= sub {
 175             my $q= sprintf "%d,%d", $ax+$_[0], $ay+$_[1];
 176             return unless $widists->has_vertex($q);
 177             return if $widists->has_edge($p,$q);
 178             printf DEBUG "%-5s league-shortcut %-5s\n", $p, $q;
 179             $widists->add_weighted_edge($p,$q,1);
 180         };
 181         $add_shortcut->( 2,0);
 182         $add_shortcut->(+1,1);
 183         $add_shortcut->(-1,1);
 184     }
 185 }
 186
 187 sub yppedia_graphs_prune_boring () {
 188     # Prune the LP database by eliminating boring intermediate vertices
 189     foreach my $delete ($widists->vertices()) {
 190         next if exists $winode2island{$delete};
 191         my @neigh= $widists->neighbours($delete);
 192         next unless @neigh==2;
 193         my $weight= 0;
 194         map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
 195         $widists->add_weighted_edge(@neigh, $weight);
 196         $widists->delete_vertex($delete);
 197         printf DEBUG "%-5s elide %5s %-5s %2d\n", $delete, @neigh, $weight;
 198     }
 199 }
 200
 201 sub yppedia_graphs_check () {
 202     # Check that it's connected.
 203     foreach my $cc ($widists->connected_components()) {
 204         next if 2*@$cc > $widists->vertices();
 205         my $m= "disconnected league point(s):";
 206         foreach my $n (@$cc) {
 207             $m .= "\n    LP $n, def. yppedia line(s): ".
 208                 join(',', sort keys %{ $winode2lines{$n} });
 209         }
 210         warning($m);
 211     }
 212 }
 213
 214 sub yppedia_archs_sourceinfo () {
 215     # Assign archipelagoes according to the source-info file
 216     foreach my $arch (sort keys %{ $oceans{$ocean} }) {
 217         foreach my $islename (sort keys %{ $oceans{$ocean}{$arch} }) {
 218             my $islenode= $wiisland2node{$islename};
 219             if (!defined $islenode) {
 220                 error("island $islename in source-info but not in WP map");
 221                 next;
 222             }
 223             my $ccix= $wiarchs->connected_component_by_vertex($islenode);
 224             my $oldarch= $wiccix2arch{$ccix};
 225             error("island in $arch in source-info".
 226                   " connected to $oldarch as well: $islename")
 227                 if defined $oldarch && $oldarch ne $arch;
 228             printf DEBUG "%-5s force-island-arch cc%-2d %-10s %s\n",
 229                 $islenode, $ccix, $arch, $islename;
 230             $wiccix2arch{$ccix}= $arch;
 231         }
 232     }
 233 }
 234
 235 sub yppedia_archs_chart_labels () {
 236     # Assign archipelago labels to groups of islands
 237     #
 238     foreach my $label (@wiarchlabels) {
 239         my ($ax,$ay,$arch) = @$label;
 240         my $best_ccmulti= -1;
 241         my $best_d2= 0;
 242         my $best_n;
 243 #       print DEBUG "$ax,$ay arch-island-search $arch\n";
 244         $ay += 1;  $ax += 2;  # coords are rather to the top left of label
 245         foreach my $vertex ($wiarchs->vertices()) {
 246             next unless exists $winode2island{$vertex};
 247             my $ccix= $wiarchs->connected_component_by_vertex($vertex);
 248             my @cc= $wiarchs->connected_component_by_index($ccix);
 249             my $ccmulti= @cc > 1;
 250             my ($vx,$vy) = split /,/, $vertex;
 251             my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
 252             my $cmp= $ccmulti <=> $best_ccmulti
 253                 ||   $best_d2 <=> $d2;
 254             printf DEBUG "%2d,%-2d arch-island-search %5s d2=%4d cc%-2d".
 255                          " #cc=%2d ccmulti=%d cmp=%2d %s\n",
 256                 $ax,$ay, $vertex, $d2, $ccix, scalar(@cc), $ccmulti, $cmp,
 257                 $winode2island{$vertex};
 258             next unless $cmp > 0;
 259             $best_n=       $vertex;
 260             $best_d2=      $d2;
 261             $best_ccmulti= $ccmulti;
 262         }
 263         die 'no island vertices?!' unless defined $best_n;
 264         my $ccix= $wiarchs->connected_component_by_vertex($best_n);
 265         printf DEBUG
 266             "%2d,%-2d arch-island-select %-5s d2=%4d cc%-2d     %-10s %s\n",
 267             $ax,$ay, $best_n, $ccix, $best_d2, $arch, $winode2island{$best_n};
 268         my $desc= join "\n", map {
 269             my $in= $winode2island{$_};
 270             "    LP $_". (defined $in ? ", $in" : "");
 271         } sort $wiarchs->connected_component_by_index($ccix);
 272
 273         if (exists $wiccix2arch{$ccix} and $wiccix2arch{$ccix} ne $arch) {
 274             error("archipelago determination failed, wrongly merged:\n".
 275                   "    archipelago $arch\n".
 276                   "    archipelago $wiccix2arch{$ccix}\n".
 277                   $desc);
 278             next;
 279         }
 280         $wiccix2arch{$ccix}= $arch;
 281 #       print "$ccix $arch ::\n$desc\n";
 282     }
 283 }
 284
 285 sub yppedia_archs_fillbynearest() {
 286     # Assign islands not labelled above to archipelagoes.
 287     #
 288     # We do this by, for each connected component (set of islands
 289     # linked by purchaseable charts), searching for the nearest other
 290     # connected component which has already been assigned an arch.
 291     # `Nearest' means shortest distance of unpurchaseable charts, in
 292     # leagues.
 293     #
 294     # we need only consider vertices which weren't `boring intermediate
 295     # vertices' (removed during optimisation as being of order 2)
 296     my @ccs_useful= map {
 297         [ grep { $widists->has_vertex($_) } @$_ ]
 298     } $wiarchs->connected_components();
 299
 300     my @assignments;
 301
 302     foreach my $sourceccix (0..$#ccs_useful) {
 303         next if defined $wiccix2arch{$sourceccix};
 304         next unless $ccs_useful[$sourceccix];
 305
 306         my @sourcecc= $wiarchs->connected_component_by_index($sourceccix);
 307         my @islandnodes= grep { $winode2island{$_} } @sourcecc;
 308         next unless @islandnodes; # don't care, then
 309
 310         foreach my $islandnode (@islandnodes) {
 311             printf DEBUG "%-5s arch-join-need cc%-2d             %s\n",
 312                 $islandnode, $sourceccix, $winode2island{$islandnode};
 313         }
 314         my $best_dist= 9999999;
 315         my ($best_target, $best_targetccix, $best_source);
 316         foreach my $targetccix (0..$#ccs_useful) {
 317             next unless defined $wiccix2arch{$targetccix}; # not helpful
 318             next unless $ccs_useful[$targetccix];
 319             foreach my $target ($wiarchs->
 320                          connected_component_by_index($targetccix)) {
 321                 next unless $widists->has_vertex($target);
 322                 foreach my $source (@sourcecc) {
 323                     my $target_dist= widist($target,$source);
 324                     next unless defined $target_dist;
 325                     next if $target_dist >= $best_dist;
 326                     $best_dist= $target_dist;
 327                     $best_source= $source;
 328                     $best_target= $target;
 329                     $best_targetccix= $targetccix;
 330                 }
 331             }
 332         }
 333         die "no possible target ?!" unless defined $best_target;
 334
 335         my $arch= $wiccix2arch{$best_targetccix};
 336         my $best_island= $winode2island{$best_target};
 337         printf DEBUG "%-5s arch-join-to %-5s dist=%2d cc%-2d  %-10s %s\n",
 338             $best_source, $best_target, $best_dist,
 339             $best_targetccix, $arch,
 340             defined($best_island) ? $best_island : "-";
 341
 342         push @assignments, [ $sourceccix, $arch ];
 343     }
 344     foreach my $assign (@assignments) {
 345         $wiccix2arch{$assign->[0]}= $assign->[1];
 346     }
 347 }
 348
 349 sub yppedia_graph_shortest_paths () {
 350     $wialldists= $widists->APSP_Floyd_Warshall();
 351 }
 352
 353 sub widist ($$) {
 354     my ($p,$q) = @_;
 355     my $pl= $wialldists->path_length($p,$q);
 356 #    die "$p $q" unless defined $pl;
 357 #    my @pv= $wialldists->path_vertices($p,$q);
 358 #    if (@pv == $pl) { return $pl; }
 359 #   printf DEBUG "%-5s PATHLENGTH %-5s pl=%s pv=%s\n", $p,$q,$pl,join('|',@pv);
 360     return $pl;
 361 }
 362
 363 sub winode2arch ($) {
 364     my ($node) = @_;
 365     my $ccix= $wiarchs->connected_component_by_vertex($node);
 366     return $wiccix2arch{$ccix};
 367 }
 368 sub wiisland2arch ($) {
 369     my ($island) = @_;
 370     my $node= $wiisland2node{$island};
 371     die "$island ?" unless defined $node;
 372     return winode2arch($node);
 373 }
 374
 375 sub compare_island_lists () {
 376     foreach my $island (sort keys %dbisland2arch) {
 377         my $node= $wiisland2node{$island};
 378         if (!defined $node) {
 379             error("would delete island: $island");
 380             next;
 381         }
 382         my $wiarch= winode2arch($node);
 383         if (!defined $wiarch) {
 384             error("island has no arch: $island");
 385             next;
 386         }
 387         my $dbarch= $dbisland2arch{$island};
 388         if ($wiarch ne $dbarch) {
 389             change("archipelago change from $dbarch to $wiarch".
 390                    " for island $island");
 391         }
 392     }
 393     foreach my $island (sort keys %wiisland2node) {
 394         my $wtarch= $wtisland2arch{$island};
 395         my $wiarch= wiisland2arch($island);
 396         if (!defined $wtarch) {
 397             error("island from chart not found on ocean page: $island");
 398         } elsif (defined $wiarch and $wtarch ne $wiarch) {
 399             error("island in $wtarch on ocean page but".
 400                   " concluded $wiarch from chart: $island");
 401         }
 402
 403         my $dbarch= $dbisland2arch{$island};
 404         if (!defined $dbarch) {
 405             my $wiarch= wiisland2arch($island);
 406             if (!defined $wiarch) {
 407                 error("new island has no arch: $island");
 408                 next;
 409                 # We check arches of non-new islands above
 410             }
 411             change("island new in $wiarch: $island");
 412         }
 413     }
 414     foreach my $island (sort keys %wtisland2arch) {
 415         my $node= $wiisland2node{$island};
 416         next if defined $node;
 417         error("island on ocean page but not in chart: $island");
 418     }
 419 }
 420
 421 sub shortest_path_reduction ($$) {
 422     my ($what,$g) = @_;
 423     #
 424     # Takes a graph $g (and a string for messages $what) and returns
 425     # a new graph which is the miminal shortest path transient reduction
 426     # of $g.
 427     #
 428     # We also check that the shortest path closure of the intended result
 429     # is the same graph as the input.  Thus the input must itself be
 430     # a shortest path closure; if it isn't, we die.
 431
 432     my $proof=<<'END'; # way to make a big comment
 433
 434     Premises and definitions:
 435
 436     1. F is an undirected weighted graph with positive edge weights.
 437
 438     2. All graphs we will consider have the same vertices as F.
 439
 440     3. G = Closure(F) is the graph of cliques whose edge weights
 441        are the shortest paths in F, one clique for each connected
 442        component in F.
 443
 444     3a. |XY| for vertices X, Y is the weight of the edge XY in G.
 445        If XY is not in G, |XY| is infinite.
 446
 447     4. A `reduction' of G is a subgraph K of G such that Closure(K) = G.
 448        The reduction is `minimal' if there is no strict subgraph K'
 449        of K such that Closure(K') = G.
 450
 451     5. Now each edge of G may be:
 452        - `unnecessary': included in no minimal reductions of G.
 453        - `essential': included in all minimal reductions of G.
 454        - `contingent': included in some but not all.
 455
 456     6. Consider for any edge AC between the vertices A and C,
 457        whether there is any B such that |AB|+|BC| = |AC| ?
 458        (There can be no B such that the sum < |AC| since that would
 459        mean that |AC| wasn't equal to the shortest path length.)
 460
 461     6a. No such B:  AC is therefore the only shortest path from A to C
 462         (since G is not a multigraph).  AC is thus an essential edge.
 463
 464     6b. Some such B: Call all such edges AC `questionable'.
 465
 466     6c. Thus all edges are essential or questionable.
 467
 468     7. Suppose AC is a shortest contingent edge.  AC must be
 469        questionable since it is not essential.  Suppose it is
 470        made questionable by the existence of B such that |AB|+|BC| =
 471        |AC|.  Consider AB and BC.  Since |AB| and |BC| are positive,
 472        |BC| and |AB| must be < |AC| ie AB and BC are shorter than AC.
 473        Since AC is a shortest contingent edge, there must be shortest
 474        paths in G for AB and BC consisting entirely of essential edges.
 475
 476     8. Therefore it is always safe to remove AC since the paths
 477        A..B and B..C will definitely still remain and provide a path
 478        A..B..C with length |AB|+|BC| = |AC|.
 479
 480     9. Thus AC is unnecessary, contradicting the assumption in 7.
 481        There are therefore no shortest contingent edges, and
 482        thus no contingent edges.
 483
 484     10. We can construct a minimal reduction directly: for each edge
 485         AC in G, search for a vertex B such that |AB|+|BC| = |AC|.
 486         If we find none, AC is essential.  If we find one then AC is
 487         not essential and is therefore unnecessary.
 488
 489 END
 490
 491     printf DEBUG "spr %s before %d\n", $what, scalar($g->edges());
 492
 493     my $result= Graph::Undirected->new();
 494     foreach my $edge_ac ($g->edges()) {
 495         my $edgename_ac= join ' .. ', @$edge_ac;
 496         printf DEBUG "spr %s edge %s\n", $what, $edgename_ac;
 497         my $w_ac= $g->get_edge_weight(@$edge_ac);
 498         my $needed= 1;
 499         foreach my $vertex_b ($g->vertices()) {
 500             next if grep { $_ eq $vertex_b } @$edge_ac;
 501             my $w_ab= $g->get_edge_weight($edge_ac->[0], $vertex_b);
 502             next unless defined $w_ab;
 503             next if $w_ab >= $w_ac;
 504             my $w_bc= $g->get_edge_weight($vertex_b, $edge_ac->[1]);
 505             next unless defined $w_ac;
 506             next if $w_ab + $w_bc > $w_ac;
 507             # found path
 508             printf DEBUG "spr %s edge %s unnecessary %s\n",
 509                 $what, $edgename_ac, $vertex_b;
 510             $needed= 0;
 511             last;
 512         }
 513         if ($needed) {
 514             printf DEBUG "spr %s edge %s essential\n", $what, $edgename_ac;
 515             $result->add_weighted_edge(@$edge_ac,$w_ac);
 516         }
 517     }
 518     printf DEBUG "spr %s result %d\n", $what, scalar($result->edges());
 519
 520     my $apsp= $result->APSP_Floyd_Warshall();
 521     foreach my $ia (sort $g->vertices()) {
 522         foreach my $ib (sort $g->vertices()) {
 523             my $din= $g->get_edge_weight($ia,$ib);
 524             my $dout= $apsp->path_length($ia,$ib);
 525             $din= defined($din) ? $din : 'infinity';
 526             $dout= defined($dout) ? $dout : 'infinity';
 527             error("$what spr apsp discrepancy in=$din out=$dout".
 528                   " for $ia .. $ib")
 529                 if $din != $dout;
 530         }
 531     }
 532     return $result;
 533 }
 534
 535 sub yppedia_graph_spr () {
 536     my $base= Graph::Undirected->new();
 537     foreach my $na (sort keys %winode2island) {
 538         my $ia= $winode2island{$na};
 539         foreach my $nb (sort keys %winode2island) {
 540             my $ib= $winode2island{$nb};
 541             $base->add_weighted_edge($ia,$ib, widist($na,$nb));
 542         }
 543     }
 544     $wispr= shortest_path_reduction('wi',$base);
 545 }
 546
 547 sub yppedia_ocean_fetch_start ($) {
 548     my ($chart) = @_;
 549     my @args= ();
 550     push @args, '--chart' if $chart;
 551     push @args, $ocean;
 552     open OCEAN, '-|', "./yppedia-ocean-scraper", @args or die $!;
 553 }
 554 sub yppedia_ocean_fetch_done () {
 555     $?=0; $!=0; close OCEAN; $? and die $?; $! and die $!;
 556 }
 557
 558 sub yppedia_ocean_fetch_chart () {
 559     yppedia_ocean_fetch_start(1);
 560     yppedia_chart_parse();
 561     yppedia_ocean_fetch_done();
 562 }
 563
 564 sub yppedia_ocean_fetch_text () {
 565     yppedia_ocean_fetch_start(0);
 566     my $arch;
 567     while (<OCEAN>) {
 568         chomp;
 569         if (m/^ocean /) {
 570             $' eq $ocean or die;
 571         } elsif (m/^  /) {
 572             die unless defined $arch;
 573             $wtisland2arch{$'}= $arch;
 574         } elsif (m/^ /) {
 575             $arch= $';
 576         } else {
 577             die;
 578         }
 579     }
 580     yppedia_ocean_fetch_done();
 581 }
 582
 583 sub compare_distances () {
 584     foreach my $ia (sort keys %dbisland2arch) {
 585         my $na= $wiisland2node{$ia};
 586         next unless defined $na;
 587         foreach my $ib (sort keys %dbisland2arch) {
 588             next unless $ia le $ib; # do every pair only once
 589             my $dbdist= $dbspr->get_edge_weight($ia,$ib);
 590             my $widist= $wispr->get_edge_weight($ia,$ib);
 591             next unless defined $dbdist || defined $widist;
 592
 593             if (!defined $widist) {
 594                 warning(sprintf "route delete %2d for %s .. %s",
 595                         $dbdist, $ia,$ib);
 596             } elsif (!defined $dbdist) {
 597                 change(sprintf "route new %2d for %s .. %s",
 598                        $widist, $ia,$ib);
 599             } elsif ($dbdist != $widist) {
 600                 change(sprintf "route change %2d to %2d for %s .. %s",
 601                        $dbdist, $widist, $ia,$ib);
 602             }
 603         }
 604     }
 605 }
 606
 607 parse_info_serverside();
 608
 609 progress("reading database");
 610
 611 db_setocean($ocean);
 612 db_connect();
 613 database_fetch_ocean();
 614
 615 progress("computing database spr");         database_graph_spr();
 616
 617 progress("fetching yppedia chart");         yppedia_ocean_fetch_chart();
 618 progress("adding shortcuts");               yppedia_graphs_add_shortcuts();
 619 progress("pruning boring vertices");        yppedia_graphs_prune_boring();
 620 progress("checking yppedia graphs");        yppedia_graphs_check();
 621 progress("setting archs from source-info"); yppedia_archs_sourceinfo();
 622 progress("computing shortest paths");       yppedia_graph_shortest_paths();
 623 progress("setting archs from labels");      yppedia_archs_chart_labels();
 624 progress("setting archs from nearby");      yppedia_archs_fillbynearest();
 625 progress("computing yppedia spr");          yppedia_graph_spr();
 626
 627 progress("fetching yppedia ocean text");    yppedia_ocean_fetch_text();
 628
 629 progress("comparing islands");              compare_island_lists();
 630 progress("comparing distances");            compare_distances();
 631
 632 print_messages();