#!/usr/bin/perl use strict (qw(vars)); use warnings; use Graph::Undirected; use CommodsDatabase; my $widists= Graph::Undirected->new(); my $wiarchs= Graph::Undirected->new(unionfind => 1); my @wiarchlabels; my %wiisland2node; my %winode2island; my %wiisland2arch; my %winode2lines; my %wiccix2arch; 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. while (<>) { s/\<--.*--\>//g; s/^\s*//; chomp; s/\s+$//; s/\s+/ /g; s/\<\/?(?:b|em)\>//g; s/\{\{Chart\ style\|[^{}]*\}\}//g; next unless m/\{\{/; # only interested in chart template stuff my ($x,$y, $arch,$island,$solid,$dirn); my $nn= sub { return nn_xy($x,$y) }; if (($x,$y,$arch) = m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .* \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) { printf PO "%d,%d arch %s\n", $x,$y,$arch; push @wiarchlabels, [ $x,$y,$arch ]; } elsif (($x,$y,$island) = m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\| ([^| ][^|]*[^| ]) \| .*\}\}$/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+)\| ([-\/\\o]) \| .*\}\}$/xi) { next if $dirn eq 'o'; my ($bx,$by) = ($x,$y); if ($dirn eq '-') { $bx+=2; } elsif ($dirn eq '\\') { $bx++; $by++; } elsif ($dirn eq '/') { $x++; $by++; } else { die; } $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; } elsif ( m/^\{\{ chart\ head \}\}$/xi ) { next; } else { 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');