Found bug in Graph::Undirected

diff --git a/yarrg/test-yppedia-chart b/yarrg/test-yppedia-chart
index 08c3fbf4c83d9426e309aadd40a6a11d3ea26153..fa4059c0ebd9a0be0ab36168bac7bed626aec52e 100644 (file)
--- a/yarrg/test-yppedia-chart
+++ b/yarrg/test-yppedia-chart
@@ -61,12 +61,12 @@
 {{Chart league|28|11|o|gray}}
  <!--Interarches-->
 <!--Jorvik-Turtle-->
-{{Chart league|27|12|\|gold}}
-{{Chart league|28|13|\|gold}}
-{{Chart league|29|14|\|gold}}
-{{Chart league|30|15|\|gold}}
-{{Chart league|31|16|\|gold}}
-{{Chart league|32|17|\|gold}}
+{{Chart league solid|27|12|\|gold}}
+{{Chart league solid|28|13|\|gold}}
+{{Chart league solid|29|14|\|gold}}
+{{Chart league solid|30|15|\|gold}}
+{{Chart league solid|31|16|\|gold}}
+{{Chart league solid|32|17|\|gold}}
 <!--Luthien-Nuptial-->
 {{Chart league|17|11|/|gold}}
 {{Chart league|17|12|\|gold}}

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index 1a90e8482af2234cfb2b068ef87a64b9553593da..068cd1c20e30694e3c56397cb1cbd976e274df82 100755 (executable)
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -5,14 +5,48 @@ use warnings;
 
 use Graph::Undirected;
 
-my $dists= Graph::Undirected->new();
-my $archs= Graph::Undirected->new();
-my @arch_labels;
-my %islandname;
+use CommodsDatabase;
 
-open PO, ">/dev/null" or die $!;
+my $widists= Graph::Undirected->new();
+my $wiarchs= Graph::Undirected->new(unionfind => 1);
+my @wiarchlabels;
+my %wiisland2node;
+my %winode2island;
+my %wiisland2arch;
+my %winode2lines;
+my %wiccix2arch;
 
-sub nn_xy ($$) { return "n$_[0]x$_[1]"; }
+my $dbdists= Graph::Undirected->new();
+my %dbisland2arch;
+
+my $warnings=0;
+sub warning ($) {
+    my ($m) = @_;
+    print STDERR "warning: $m\n";
+    $warnings++;
+}
+my $errors=0;
+sub error ($) {
+    my ($m) = @_;
+    print STDERR "error: $m\n";
+    $errors++;
+}
+
+#open PO, ">/dev/null" or die $!;
+open PO, ">&STDOUT" or die $!;
+select(PO); $|=1;
+select(STDOUT); $|=1;
+
+my $parity;
+sub nn_xy ($$) {
+    my ($x,$y) = @_;
+    my $tp= (0+$x ^ 0+$y) & 1;
+    defined $parity or $parity=$tp;
+    $tp==$parity or warning("line $.: parity error $x,$y is $tp not $parity");
+    my $n= "$_[0],$_[1]";
+    $winode2lines{$n}{$.}++;
+    return $n;
+}
 
 sub parse_yppedia_map () {
     # We don't even bother with tag soup; instead we do line-oriented parsing.
@@ -31,13 +65,15 @@ sub parse_yppedia_map () {
            m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
                    \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) {
            printf PO "%d,%d arch %s\n", $x,$y,$arch;
-           push @arch_labels, [ $x,$y,$arch ];
+           push @wiarchlabels, [ $x,$y,$arch ];
        } elsif (($x,$y,$island) =
            m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
-                   (\S.*\S) \| .*\}\}$/xi) {
-           $islandname{$nn->()}= $island;
-           $dists->add_vertex($nn->());
-           $archs->add_vertex($nn->());
+                   ([^| ][^|]*[^| ]) \| .*\}\}$/xi) {
+           my $n= $nn->();
+           $wiisland2node{$island}= $n;
+           $winode2island{$n}= $island;
+           $widists->add_vertex($n);
+           $wiarchs->add_vertex($n);
            printf PO "%d,%d island %s\n", $x,$y,$island;
        } elsif (($solid,$x,$y,$dirn) =
            m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
@@ -47,11 +83,11 @@ sub parse_yppedia_map () {
            my ($bx,$by) = ($x,$y);
            if ($dirn eq '-') { $bx+=2; }
            elsif ($dirn eq '\\') { $bx++; $by++; }
-           elsif ($dirn eq '/') { $bx--; $by++; }
+           elsif ($dirn eq '/') { $x++; $by++; }
            else { die; }
 
-           $dists->add_edge($nn->(), nn_xy($bx,$by));
-           $archs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
+           $widists->add_weighted_edge($nn->(), nn_xy($bx,$by), 1);
+           $wiarchs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
 
            printf PO "%d,%d league %s %s \n", $x,$y,
                $solid?'solid':'dotted', $dirn;
@@ -60,9 +96,107 @@ sub parse_yppedia_map () {
                 ) {
            next;
        } else {
-           warn "line $.: ignoring incomprehensible: $_\n";
+           warning("line $.: ignoring incomprehensible: $_");
        }
     }
 }
 
+sub parse_database_map () {
+    my ($row,$sth);
+    $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
+    $sth->execute();
+    foreach $row ($sth->fetchrow_hashref) {
+       $dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
+    }
+    $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b
+                               FROM dists
+                               JOIN islands AS a ON dists.aiid==a.islandid
+                               JOIN islands AS b ON dists.biid==b.islandid');
+    $sth->execute();
+    foreach $row ($sth->fetchrow_hashref) {
+       $dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
+    }
+}                       
+
+sub process_yppedia_graphs () {
+    # 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);
+#      print PO "$delete elide $weight\n";
+    }
+
+    # Check that it's connected.
+    foreach my $cc ($widists->connected_components()) {
+       next if 2*@$cc > $widists->vertices();
+       my $m= "disconnected league point(s):";
+       foreach my $n (@$cc) {
+           $m .= "\n    LP $n, def. yppedia line(s): ".
+               join(',', sort keys %{ $winode2lines{$n} });
+       }
+       warning($m);
+    }
+
+    # Compute all-pairs-shortest-paths on dist, which is the
+    # actual distances between all LPs.
+    my $wialldists= $widists->APSP_Floyd_Warshall();
+
+    # Compute arch's
+    foreach my $label (@wiarchlabels) {
+       my ($ax,$ay,$arch) = @$label;
+       my $d2best= 9999999;
+       my $best;
+       foreach my $vertex ($wiarchs->vertices()) {
+           next unless exists $winode2island{$vertex};
+           my ($vx,$vy) = split /,/, $vertex;
+           my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
+           next unless $d2 < $d2best;
+           $best= $vertex;
+           $d2best= $d2;
+       }
+       die 'no island vertices?!' unless defined $best;
+       printf PO "%d,%d arch-select-island %s %s\n",
+           $ax,$ay, $arch, $winode2island{$best};
+       my $ccix= $wiarchs->connected_component_by_vertex($best);
+       my $desc= join "\n", map {
+           my $in= $winode2island{$_};
+           "    LP $_". (defined $in ? ", $in" : "");
+       } sort $wiarchs->connected_component_by_index($ccix);
+
+       if (exists $wiccix2arch{$ccix}) {
+           error("architecture determination failed:\n".
+                 "    archipelago $arch\n".
+                 "    archipelago $wiccix2arch{$ccix}\n".
+                 $desc);
+           next;
+       }
+       $wiccix2arch{$ccix}= $arch;
+       print "$ccix $arch ::\n$desc\n";
+    }
+}
+
+sub compare_island_lists () {
+#    foreach my $island (keys %dbisland2arch) {
+#      next if exists $winode2island
+#      error("
+}
+
+db_setocean('Midnight');
+db_connect();
 parse_yppedia_map();
+parse_database_map();
+process_yppedia_graphs();
+compare_island_lists();
+
+printf "%d %d %d %d\n", $wiarchs->has_edge('32,17','33,18'),
+    $wiarchs->connected_component_by_vertex('32,17'),
+    $wiarchs->connected_component_by_vertex('33,18'),
+    $wiarchs->same_connected_components('32,17','33,18');