Anonymous user
Closest-pair problem: Difference between revisions
perl (the pseudocode was updated after the perl impl)
(modified the pseudocodes (the first slightly); updated a reference) |
(perl (the pseudocode was updated after the perl impl)) |
||
Line 49:
* [http://www.cs.ucsb.edu/~suri/cs235/ClosestPair.pdf Closest Pair (UCBS)]
* [http://classes.cec.wustl.edu/~cse241/handouts/closestpair.pdf Closest pair (WUStL)]
=={{header|Perl}}==
<lang perl>#! /usr/bin/perl
use strict;
use List::Util qw(min);
use POSIX qw(ceil);
sub dist
{
my ( $a, $b) = @_;
return sqrt( (${$a}[0] - @{$b}[0])**2 +
(@{$a}[1] - @{$b}[1])**2 );
}
sub closest_pair_simple
{
my $ra = shift;
my @arr = @$ra;
my $inf = 1e600;
return $inf if (scalar(@arr) < 2);
my ( $a, $b, $d ) = ($arr[0], $arr[1], dist($arr[0], $arr[1]));
while( scalar(@arr) > 0 ) {
my $p = pop @arr;
foreach my $l (@arr) {
my $t = dist($p, $l);
($a, $b, $d) = ($p, $l, $t) if $t < $d;
}
}
return ($a, $b, $d);
}
sub closest_pair
{
my $ra = shift;
my @arr = @$ra;
my $N = @arr;
return closest_pair_simple($ra) if ( scalar(@arr) <= 3 );
my $inf = 1e600;
my @xP = sort { ${$a}[0] <=> ${$b}[0] } @arr;
my $midx = ceil($N/2)-1;
my @PL = @xP[0 .. $midx];
my @PR = @xP[$midx+1 .. $N-1];
my ($al, $bl, $dL) = closest_pair(\@PL);
my ($ar, $br, $dR) = closest_pair(\@PR);
my ($m1, $m2, $dmin) = ($al, $bl, $dL);
($m1, $m2, $dmin) = ($ar, $br, $dR) if ( $dR < $dL );
my $xm = ${$xP[$midx]}[0];
my @S = ();
foreach my $p (@xP) {
push @S, $p if ( abs($xm - ${$p}[0]) < $dmin );
}
my @yP = sort { ${$a}[1] <=> ${$b}[1] } @S;
if ( scalar(@yP) > 0 ) {
my ( $w1, $w2, $closest ) = ($m1, $m2, $dmin);
foreach my $i (0 .. ($#yP - 1)) {
my $k = $i + 1;
while ( ($k <= $#yP) && ( (${$yP[$k]}[1] - ${$yP[$i]}[1]) < $dmin) ) {
my $d = dist($yP[$k], $yP[$i]);
($w1, $w2, $closest) = ($yP[$k], $yP[$i], $d) if ($d < $closest);
$k++;
}
}
return ($w1, $w2, $closest);
} else {
return ($m1, $m2, $dmin);
}
}
my @points = ();
my $N = 5000;
foreach my $i (1..$N) {
push @points, [rand(20)-10.0, rand(20)-10.0];
}
#my ($a, $b, $d) = closest_pair_simple(\@points);
#print "$d\n";
my ($a1, $b1, $d1) = closest_pair(\@points);
print "$d1\n";
exit 0;</lang>
<tt>Time</tt> for the brute-force algorithm gave 40.63user 0.12system 0:41.06elapsed, while the divide&conqueer algorithm gave 0.38user 0.00system 0:00.38elapsed with 5000 points.
=={{header|Smalltalk}}==
| |||