X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fyppedia-chart-parser;h=e3150611cb36eb75a6a3eb117e276982ad5aebd0;hb=7328dbd4d2c03d533a20a9bad54bcf89b969ca0f;hp=b3cb1c21c1af5be1b95f5ea681150c43119fa75a;hpb=388d7f33e710e12596423bab99335f88b5480819;p=ypp-sc-tools.web-live.git

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index b3cb1c2..e315061 100755
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -4,28 +4,38 @@ use strict (qw(vars));
 use warnings;
 
 use Graph::Undirected;
-
+use Commods;
 use CommodsDatabase;
 
+my $ocean= 'Midnight';
+
+
 my $widists= Graph::Undirected->new();
 my $wiarchs= Graph::Undirected->new();
 my @wiarchlabels;
 my %wiisland2node;
 my %winode2island;
-my %wiisland2arch;
 my %winode2lines;
 my %wiccix2arch;
+my $wialldists;
 
 my $dbdists= Graph::Undirected->new();
 my %dbisland2arch;
 
-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]); }
+my %msgs;
+sub pmsg ($$) { push @{ $msgs{$_[0]} }, "$_[0]: $_[1]\n"; }
+sub warning ($) { pmsg("warning",$_[0]); }
+sub error   ($) { pmsg("error",  $_[0]); }
+sub change  ($) { pmsg("change", $_[0]); }
+sub print_messages () {
+    foreach my $k (qw(change warning error)) {
+	my $m= $msgs{$k};
+	next unless $m;
+	print sort @$m or die $!;
+    }
+}
 
-if ($ARGV[0] eq '--debug') {
+if (@ARGV && $ARGV[0] eq '--debug') {
     shift @ARGV;
     open DEBUG, ">&STDOUT" or die $!;
     select(DEBUG); $|=1;
@@ -121,7 +131,9 @@ sub parse_database_map () {
 }			 
 
 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);
@@ -137,6 +149,7 @@ sub process_yppedia_graphs () {
     }
 
     # Check that it's connected.
+    #
     foreach my $cc ($widists->connected_components()) {
 	next if 2*@$cc > $widists->vertices();
 	my $m= "disconnected league point(s):";
@@ -147,42 +160,67 @@ sub process_yppedia_graphs () {
 	warning($m);
     }
 
+    # Assign archipelagoes according to the source-info file
+    #
+    foreach my $arch (sort keys %{ $oceans{$ocean} }) {
+	foreach my $islename (sort keys %{ $oceans{$ocean}{$arch} }) {
+	    my $islenode= $wiisland2node{$islename};
+	    defined $islenode or
+		error("island $islename in source-info but not in WP map");
+	    my $ccix= $wiarchs->connected_component_by_vertex($islenode);
+	    my $oldarch= $wiccix2arch{$ccix};
+	    error("island $islename in $arch in source-info".
+		  " connected to $oldarch as well")
+		if defined $oldarch && $oldarch ne $arch;
+	    printf DEBUG "%-5s force-island-arch cc%-2d %-10s %s\n",
+	        $islenode, $ccix, $arch, $islename;
+	    $wiccix2arch{$ccix}= $arch;
+	}
+    }
+
     # Compute all-pairs-shortest-paths on dist, which is the
     # actual distances between all LPs.
-    my $wialldists= $widists->APSP_Floyd_Warshall();
+    #
+    $wialldists= $widists->APSP_Floyd_Warshall();
 
-    # Compute arch's
+    # Assign archipelago labels to groups of islands
+    #
     foreach my $label (@wiarchlabels) {
 	my ($ax,$ay,$arch) = @$label;
-	my $d2best= 9999999;
-	my $best;
+	my $best_ccmulti= -1;
+	my $best_d2= 0;
+	my $best_n;
 #	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 $ccmulti= @cc > 1;
 	    my ($vx,$vy) = split /,/, $vertex;
 	    my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
-#	    printf DEBUG
-#		"%2d,%-2d 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;
+	    my $cmp= $ccmulti <=> $best_ccmulti
+		||   $best_d2 <=> $d2;
+	    printf DEBUG "%2d,%-2d arch-island-search %5s d2=%4d cc%-2d".
+		         " #cc=%2d ccmulti=%d cmp=%2d %s\n",
+	        $ax,$ay, $vertex, $d2, $ccix, scalar(@cc), $ccmulti, $cmp,
+	        $winode2island{$vertex};
+	    next unless $cmp > 0;
+	    $best_n=       $vertex;
+	    $best_d2=      $d2;
+	    $best_ccmulti= $ccmulti;
 	}
-	die 'no island vertices?!' unless defined $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);
+	die 'no island vertices?!' unless defined $best_n;
+	my $ccix= $wiarchs->connected_component_by_vertex($best_n);
+	printf DEBUG
+	    "%2d,%-2d arch-island-select %-5s d2=%4d cc%-2d     %-10s %s\n",
+	    $ax,$ay, $best_n, $ccix, $best_d2, $arch, $winode2island{$best_n};
 	my $desc= join "\n", map {
 	    my $in= $winode2island{$_};
 	    "    LP $_". (defined $in ? ", $in" : "");
 	} sort $wiarchs->connected_component_by_index($ccix);
 
-	if (exists $wiccix2arch{$ccix}) {
+	if (exists $wiccix2arch{$ccix} and $wiccix2arch{$ccix} ne $arch) {
 	    error("archipelago determination failed, wrongly merged:\n".
 		  "    archipelago $arch\n".
 		  "    archipelago $wiccix2arch{$ccix}\n".
@@ -192,6 +230,67 @@ sub process_yppedia_graphs () {
 	$wiccix2arch{$ccix}= $arch;
 #	print "$ccix $arch ::\n$desc\n";
     }
+
+    # Assign islands not labelled above to archipelagoes.
+    #
+    # We do this by, for each connected component (set of islands
+    # linked by purchaseable charts), searching for the nearest other
+    # connected component which has already been assigned an arch.
+    # `Nearest' means shortest distance of unpurchaseable charts, in
+    # leagues.
+    #
+    # we need only consider vertices which weren't `boring intermediate
+    # vertices' (removed during optimisation as being of order 2)
+    my @ccs_useful= map {
+	[ grep { $widists->has_vertex($_) } @$_ ]
+    } $wiarchs->connected_components();
+
+    my @assignments;
+
+    foreach my $sourceccix (0..$#ccs_useful) {
+	next if defined $wiccix2arch{$sourceccix};
+	next unless $ccs_useful[$sourceccix];
+
+	my @sourcecc= $wiarchs->connected_component_by_index($sourceccix);
+	my @islandnodes= grep { $winode2island{$_} } @sourcecc;
+	next unless @islandnodes; # don't care, then
+
+	foreach my $islandnode (@islandnodes) {
+	    printf DEBUG "%-5s arch-join-need cc%-2d             %s\n",
+	        $islandnode, $sourceccix, $winode2island{$islandnode};
+	}
+	my $best_dist= 9999999;
+	my ($best_target, $best_targetccix, $best_source);
+	foreach my $targetccix (0..$#ccs_useful) {
+	    next unless defined $wiccix2arch{$targetccix}; # not helpful
+	    next unless $ccs_useful[$targetccix];
+	    foreach my $target ($wiarchs->
+			 connected_component_by_index($targetccix)) {
+		foreach my $source (@sourcecc) {
+		    my $target_dist= $wialldists->path_length($target,$source);
+		    next unless defined $target_dist;
+		    next if $target_dist >= $best_dist;
+		    $best_dist= $target_dist;
+		    $best_source= $source;
+		    $best_target= $target;
+		    $best_targetccix= $targetccix;
+		}
+	    }
+	}
+	die "no possible target ?!" unless defined $best_target;
+
+	my $arch= $wiccix2arch{$best_targetccix};
+	my $best_island= $winode2island{$best_target};
+	printf DEBUG "%-5s arch-join-to %-5s dist=%2d cc%-2d  %-10s %s\n",
+	    $best_source, $best_target, $best_dist,
+	    $best_targetccix, $arch,
+	    defined($best_island) ? $best_island : "-";
+
+	push @assignments, [ $sourceccix, $arch ];
+    }
+    foreach my $assign (@assignments) {
+	$wiccix2arch{$assign->[0]}= $assign->[1];
+    }
 }
 
 sub winode2arch ($) {
@@ -238,9 +337,35 @@ sub compare_island_lists () {
     }
 }
 
-db_setocean('Midnight');
+sub compare_distances () {
+    foreach my $ia (sort keys %dbisland2arch) {
+	my $na= $wiisland2node{$ia};
+	next unless defined $na;
+	foreach my $ib (sort keys %dbisland2arch) {
+	    next unless $ia le $ib; # do every pair only once
+	    my $nb= $wiisland2node{$ib};
+	    next unless defined $nb;
+	    my $dbdist= $dbdists->get_edge_weight($ia,$ib);
+	    my $widist= $wialldists->path_length($na,$nb);
+	    if (!defined $dbdist) {
+		change(sprintf "define distance %2d for %s..%s",
+		       $widist, $ia,$ib);
+	    } elsif ($dbdist != $widist) {
+		change(sprintf "change distance %2d to %2d for %s..%s",
+		       $dbdist, $widist, $ia,$ib);
+	    }
+	}
+    }
+}
+
+parse_info_serverside();
+db_setocean($ocean);
 db_connect();
 parse_yppedia_map();
 parse_database_map();
 process_yppedia_graphs();
+
 compare_island_lists();
+compare_distances();
+
+print_messages();