From 249ad8d9f4408bbbf541b37f6779adadb9236e3a Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 20 Aug 2009 18:55:47 +0100 Subject: [PATCH] Found bug in Graph::Undirected --- yarrg/test-yppedia-chart | 12 +-- yarrg/yppedia-chart-parser | 164 +++++++++++++++++++++++++++++++++---- 2 files changed, 155 insertions(+), 21 deletions(-) diff --git a/yarrg/test-yppedia-chart b/yarrg/test-yppedia-chart index 08c3fbf..fa4059c 100644 --- a/yarrg/test-yppedia-chart +++ b/yarrg/test-yppedia-chart @@ -61,12 +61,12 @@ {{Chart league|28|11|o|gray}} -{{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}} {{Chart league|17|11|/|gold}} {{Chart league|17|12|\|gold}} diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser index 1a90e84..068cd1c 100755 --- 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'); -- 2.30.2