WIP comparison; better debug

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index 8b5c50828a4e79996f4d20dc1fbc572d3887fd9c..a8b9f2aaa73a0e81126ea576fdbc1af71bc6a7a9 100755 (executable)
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -19,22 +19,19 @@ my %wiccix2arch;
 my $dbdists= Graph::Undirected->new();
 my %dbisland2arch;
 
 my $dbdists= Graph::Undirected->new();
 my %dbisland2arch;
 

-my $warnings=0;
-sub warning ($) {
-    my ($m) = @_;
-    print STDERR "warning: $m\n";
-    $warnings++;
+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]); }
+
+if ($ARGV[0] eq '--debug') {
+    shift @ARGV;
+    open DEBUG, ">&STDOUT" or die $!;
+    select(DEBUG); $|=1;
+} else {
+    open DEBUG, ">/dev/null" or die $!;

 }
 }

-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;
 select(STDOUT); $|=1;
 
 my $parity;


@@ -64,7 +61,7 @@ sub parse_yppedia_map () {
        if (($x,$y,$arch) =
            m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
                    \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) {
        if (($x,$y,$arch) =
            m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
                    \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) {

-           printf PO "%d,%d arch %s\n", $x,$y,$arch;
+           printf DEBUG "%d,%d arch %s\n", $x,$y,$arch;

            push @wiarchlabels, [ $x,$y,$arch ];
        } elsif (($x,$y,$island) =
            m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
            push @wiarchlabels, [ $x,$y,$arch ];
        } elsif (($x,$y,$island) =
            m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|


@@ -75,7 +72,7 @@ sub parse_yppedia_map () {
            $widists->add_vertex($n);
            $wiarchs->add_vertex($n);
 #print "\$g->add_vertex('$n');\n";
            $widists->add_vertex($n);
            $wiarchs->add_vertex($n);
 #print "\$g->add_vertex('$n');\n";

-           printf PO "%d,%d island %s\n", $x,$y,$island;
+           printf DEBUG "%d,%d island %s\n", $x,$y,$island;

        } elsif (($solid,$x,$y,$dirn) =
            m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
                    ([-\/\\o]) \| .*\}\}$/xi) {
        } elsif (($solid,$x,$y,$dirn) =
            m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
                    ([-\/\\o]) \| .*\}\}$/xi) {


@@ -92,7 +89,7 @@ sub parse_yppedia_map () {
            $wiarchs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
 #print "\$g->add_edge('".$nn->()."','".nn_xy($bx,$by)."');\n" if $solid;
 
            $wiarchs->add_edge($nn->(), nn_xy($bx,$by)) if $solid;
 #print "\$g->add_edge('".$nn->()."','".nn_xy($bx,$by)."');\n" if $solid;
 

-           printf PO "%d,%d league %s %s \n", $x,$y,
+           printf DEBUG "%d,%d league %s %s \n", $x,$y,

                $solid?'solid':'dotted', $dirn;
        } elsif (
            m/^\{\{ chart\ head \}\}$/xi
                $solid?'solid':'dotted', $dirn;
        } elsif (
            m/^\{\{ chart\ head \}\}$/xi


@@ -108,7 +105,9 @@ sub parse_database_map () {
     my ($row,$sth);
     $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
     $sth->execute();
     my ($row,$sth);
     $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
     $sth->execute();

-    foreach $row ($sth->fetchrow_hashref) {
+    while ($row= $sth->fetchrow_hashref) {
+       print DEBUG "database-island $row->{'islandname'}".
+                    " $row->{'archipelago'}\n";

        $dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
     }
     $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b
        $dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
     }
     $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b


@@ -116,7 +115,7 @@ sub parse_database_map () {
                                JOIN islands AS a ON dists.aiid==a.islandid
                                JOIN islands AS b ON dists.biid==b.islandid');
     $sth->execute();
                                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) {
+    while ($row= $sth->fetchrow_hashref) {

        $dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
     }
 }                       
        $dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
     }
 }                       


@@ -134,7 +133,7 @@ sub process_yppedia_graphs () {
        map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
        $widists->add_weighted_edge(@neigh, $weight);
        $widists->delete_vertex($delete);
        map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
        $widists->add_weighted_edge(@neigh, $weight);
        $widists->delete_vertex($delete);

-#      print PO "$delete elide $weight\n";
+       print DEBUG "$delete elide $weight\n";

     }
 
     # Check that it's connected.
     }
 
     # Check that it's connected.


@@ -157,17 +156,26 @@ sub process_yppedia_graphs () {
        my ($ax,$ay,$arch) = @$label;
        my $d2best= 9999999;
        my $best;
        my ($ax,$ay,$arch) = @$label;
        my $d2best= 9999999;
        my $best;

+#      print DEBUG "$ax,$ay arch-island-search $arch\n";
+       $ay += 1;  $ax += 2;  # coords are rather to the top left of label

        foreach my $vertex ($wiarchs->vertices()) {
            next unless exists $winode2island{$vertex};
        foreach my $vertex ($wiarchs->vertices()) {
            next unless exists $winode2island{$vertex};

+           my $ccix= $wiarchs->connected_component_by_vertex($vertex);
+           my @cc= $wiarchs->connected_component_by_index($ccix);

            my ($vx,$vy) = split /,/, $vertex;
            my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
            my ($vx,$vy) = split /,/, $vertex;
            my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);

+#          printf DEBUG
+#              "%d,%d arch-island-search %s d2=%d ccix=%d cc=%d %s\n",
+#              $ax,$ay, $vertex, $d2, $ccix, scalar(@cc),
+#              $winode2island{$vertex};
+           next unless @cc > 1;

            next unless $d2 < $d2best;
            $best= $vertex;
            $d2best= $d2;
        }
        die 'no island vertices?!' unless defined $best;
            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};
+       printf DEBUG "%2d,%-2d arch-island-select %5s d2=%-2d %-10s %s\n",
+           $ax,$ay, $best, $d2best, $arch, $winode2island{$best};

        my $ccix= $wiarchs->connected_component_by_vertex($best);
        my $desc= join "\n", map {
            my $in= $winode2island{$_};
        my $ccix= $wiarchs->connected_component_by_vertex($best);
        my $desc= join "\n", map {
            my $in= $winode2island{$_};


@@ -186,10 +194,50 @@ sub process_yppedia_graphs () {
     }
 }
 
     }
 }
 

+sub winode2arch ($) {
+    my ($node) = @_;
+    my $ccix= $wiarchs->connected_component_by_vertex($node);
+    return $wiccix2arch{$ccix};
+}
+sub wiisland2arch ($) {
+    my ($island) = @_;
+    my $node= $wiisland2node{$island};
+    die "$island ?" unless defined $node;
+    return winode2arch($node);
+}
+

 sub compare_island_lists () {
 sub compare_island_lists () {

-#    foreach my $island (keys %dbisland2arch) {
-#      next if exists $winode2island
-#      error("
+    foreach my $island (sort keys %dbisland2arch) {
+       my $node= $wiisland2node{$island};
+       if (!defined $node) {
+           error("would delete island: $island");
+           next;
+       }
+       my $ccix= $wiarchs->connected_component_by_vertex($node);
+       my $wiarch= $wiccix2arch{$ccix};
+       if (!defined $wiarch) {
+           error("island has no arch: $island");
+           next;
+       }
+       my $dbarch= $dbisland2arch{$island};
+       my $wiarch= winode2arch($node);
+       if ($wiarch ne $dbarch) {
+           change("change archipelago from $dbarch to $wiarch".
+                  " for island $island");
+       }
+    }
+    foreach my $island (sort keys %wiisland2node) {
+       my $dbarch= $dbisland2arch{$island};
+       if (!defined $dbarch) {
+           my $wiarch= wiisland2arch($island);
+           if (!defined $wiarch) {
+               error("new island has no arch: $island");
+               next;
+               # We check arches of non-new islands above
+           }
+           change("new island in $wiarch: $island");
+       }
+    }

 }
 
 db_setocean('Midnight');
 }
 
 db_setocean('Midnight');