From: Ian Jackson Date: Fri, 21 Aug 2009 16:31:51 +0000 (+0100) Subject: WIP comparison; better debug X-Git-Tag: 3.4~155^2~2 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=commitdiff_plain;h=025ff2df9bba44d431fb1ddb0f0800ea43535725;ds=sidebyside WIP comparison; better debug --- diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser index 8b5c508..a8b9f2a 100755 --- a/yarrg/yppedia-chart-parser +++ b/yarrg/yppedia-chart-parser @@ -19,22 +19,19 @@ my %wiccix2arch; 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; @@ -64,7 +61,7 @@ sub parse_yppedia_map () { 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+)\| @@ -75,7 +72,7 @@ sub parse_yppedia_map () { $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) { @@ -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; - 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 @@ -108,7 +105,9 @@ sub parse_database_map () { 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 @@ -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(); - foreach $row ($sth->fetchrow_hashref) { + while ($row= $sth->fetchrow_hashref) { $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); -# print PO "$delete elide $weight\n"; + print DEBUG "$delete elide $weight\n"; } # Check that it's connected. @@ -157,17 +156,26 @@ sub process_yppedia_graphs () { 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}; + 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); +# 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; - 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{$_}; @@ -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 () { -# 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');