X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fyppedia-chart-parser;h=2da027e14829255b308d8e2071e1976285a61c76;hb=bdad24af2d97e3448b671da80bb4247411bafbea;hp=a8b9f2aaa73a0e81126ea576fdbc1af71bc6a7a9;hpb=025ff2df9bba44d431fb1ddb0f0800ea43535725;p=ypp-sc-tools.db-test.git

diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser
index a8b9f2a..2da027e 100755
--- a/yarrg/yppedia-chart-parser
+++ b/yarrg/yppedia-chart-parser
@@ -61,7 +61,7 @@ sub parse_yppedia_map () {
 	if (($x,$y,$arch) =
 	    m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
 		    \'\[\[ [^][\']* \| (\S+)\ archipelago \]\]\'*\}\}$/xi) {
-	    printf DEBUG "%d,%d arch %s\n", $x,$y,$arch;
+	    printf DEBUG "%2d,%-2d arch %s\n", $x,$y,$arch;
 	    push @wiarchlabels, [ $x,$y,$arch ];
 	} elsif (($x,$y,$island) =
 	    m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
@@ -72,7 +72,7 @@ sub parse_yppedia_map () {
 	    $widists->add_vertex($n);
 	    $wiarchs->add_vertex($n);
 #print "\$g->add_vertex('$n');\n";
-	    printf DEBUG "%d,%d island %s\n", $x,$y,$island;
+	    printf DEBUG "%2d,%-2d island %s\n", $x,$y,$island;
 	} elsif (($solid,$x,$y,$dirn) =
 	    m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
 		    ([-\/\\o]) \| .*\}\}$/xi) {
@@ -89,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 DEBUG "%d,%d league %s %s \n", $x,$y,
+	    printf DEBUG "%2d,%-2d league %-6s %s\n", $x,$y,
 	        $solid?'solid':'dotted', $dirn;
 	} elsif (
 	    m/^\{\{ chart\ head \}\}$/xi
@@ -133,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 DEBUG "$delete elide $weight\n";
+	printf DEBUG "%-5s elide %5s %-5s %2d\n", $delete, @neigh, $weight;
     }
 
     # Check that it's connected.
@@ -151,32 +151,36 @@ sub process_yppedia_graphs () {
     # actual distances between all LPs.
     my $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
-#		"%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;
+	    my $cmp= $ccmulti <=> $best_ccmulti
+		||   $best_d2 <=> $d2;
+	    printf DEBUG "%2d,%-2d arch-island-search %5s d2=%4d ccix=%-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;
+	printf DEBUG "%2d,%-2d arch-island-select %-5s d2=%-2d %-10s %s\n",
+	    $ax,$ay, $best_n, $best_d2, $arch, $winode2island{$best_n};
+	my $ccix= $wiarchs->connected_component_by_vertex($best_n);
 	my $desc= join "\n", map {
 	    my $in= $winode2island{$_};
 	    "    LP $_". (defined $in ? ", $in" : "");
@@ -192,6 +196,58 @@ 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.
+
+    # fixme need some hints
+
+    # 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();
+
+    foreach my $sourceccix (0..$#ccs_useful) {
+	next if defined $wiccix2arch{$sourceccix};
+
+	my $sourcecc= $ccs_useful[$sourceccix];
+	my @islandnodes= grep { $winode2island{$_} } @$sourcecc;
+	next unless @islandnodes; # don't care, then
+
+	my $best_dist= 9999999;
+	my $best_target;
+	foreach my $targetccix (0..$#ccs_useful) {
+	    next unless defined $wiccix2arch{$targetccix}; # not helpful
+	    my $targetcc= $ccs_useful[$targetccix];
+	    foreach my $target (@$targetcc) {
+		foreach my $source (@$sourcecc) {
+		    my $target_dist= $wialldists->path_length($target,$source);
+		    next if $target_dist >= $best_dist;
+		    $best_dist= $target_dist;
+		    $best_target= $target;
+		}
+	    }
+	}
+#	die "no possible target ?!" unless defined $best_target;
+#
+#	printf DEBUG "
+#
+#    foreach my $node (sort keys %winode2island) {
+#	my $island= $winode2island{$node};
+#	my $arch= winode2arch($node);
+#	next if defined $arch;
+#	my $ccix= $wiarchs->connected_component_by_vertex($node);
+#	my @cc= $wiarchs->connected_component_by_index($ccix);
+#	@cc= grep { defined $winode2island{$_} } @cc;
+#	# We search for the best:
+#	#      - member of this connected component
+    }
 }
 
 sub winode2arch ($) {
@@ -213,14 +269,12 @@ sub compare_island_lists () {
 	    error("would delete island: $island");
 	    next;
 	}
-	my $ccix= $wiarchs->connected_component_by_vertex($node);
-	my $wiarch= $wiccix2arch{$ccix};
+	my $wiarch= winode2arch($node);
 	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");