#!/usr/bin/perl use strict; sub pord { my ($a,$b) = @_; return $a < $b ? "$a-$b" : "$b-$a"; } sub len { my ($n, $h) = @_; my $total = 0; for my $z (keys %$h) { my ($a,$b) = split('-', $z); my ($x1,$y1) = @{$$n[$a]}; my ($x2,$y2) = @{$$n[$b]}; my $x = ($x2-$x1); my $y = ($y2-$y1); $total += sqrt($x*$x+$y*$y); } return $total; } sub connects { my ($n, $h) = @_; my $len = @$n; my $aa = [map {0} (1..$len)]; sub dfs { my ($n, $a) = @_; $$a[$n] = 1; for my $x (0..($len-1)) { if (!$$a[$x] && 1==$$h{pord($n,$x)}) { dfs($x, $a); } } } dfs(0, $aa); return ($$aa[0] && $$aa[1] && $$aa[2] && $$aa[3] && $$aa[4] && $$aa[5]); } sub random { my @a; my $r = 2+int(rand(6)); for(1..$r) { push(@a, [int(rand(800)),int(rand(300))]); } return @a; } my (@best, @latest, %bestn, %latestn, $bestscore, $latestscore); my @fixed = ([0,0], [0,300],[400,0],[400,300],[800,0],[800,300]); my $c = 0; $bestscore = 2**32; while (1) { @latest = random(); %latestn = (); my @test = (@fixed, @latest); my $len = @test; until (connects(\@test, \%latestn)) { $latestn{pord(int(rand $len), int(rand $len))} = 1; } $latestscore = len(\@test, \%latestn); my $tostring = $c++ .": $latestscore: " . join(";", map {join(",",@$_)} @latest) . ": " . join(";", map {s/\-/,/;$_} keys %latestn); if ($latestscore < $bestscore) { print "$tostring\n"; @best = @latest; %bestn = %latestn; $bestscore = $latestscore; } }