Rosetta Code

Closest-pair problem: Difference between revisions

Page Discussion

Closest-pair problem (view source)

Revision as of 16:49, 11 June 2022

214 bytes removed ,  1 year ago
m
→‎{{header|Perl}}: simplify, add output
(→‎{{header|Raku}}: refactored for clarity, 2x speed-increase as a bonus)
m (→‎{{header|Perl}}: simplify, add output)
Line 3,181:
=={{header|Perl}}==
The divide & conquer technique is about 100x faster than the brute-force algorithm.
<lang perl>#!use /usr/bin/perlstrict;
use strictwarnings;
use POSIX qw(ceil);
 
sub dist {
my ($a, $Nb) = @xP_;▼
{
return my sqrt(( $a,->[0] - $b->[0])**2 = @_;+
return sqrt( ($a->[01] - $b->[01])**2 +)
($a->[1] - $b->[1])**2 );▼
}
 
sub closest_pair_simple {
my $ra@points = @{ shift @_ };▼
{
my ($a, $b, $d) = ( $points[0], $points[1], dist($points[0], $points[1]) );
▲ my $ra = shift;
mywhile( @arrpoints =) @$ra;{
my $infp = 1e600pop @points;
return $inf if scalar for my $l (@arrpoints) < 2;{
my ( $a, $b, $d ) = ( my $arr[0],t $arr[1],= dist($arr[0]p, $arr[1])l);
($a, $b, $d) = ($p, $l, $t) if $t < $d; ▼
while( @arr ) {
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 $@r = @{ shift @_ };▼
{
closest_pair_real( my[sort @ay{ $a->[0] <=> $b->[0] } @r], [sort { $a->[1] <=> $b->[1] } @$r;] )▼
▲ my $r = shift;
my @ax = sort { $a->[0] <=> $b->[0] } @$r;
▲ my @ay = sort { $a->[1] <=> $b->[1] } @$r;
return closest_pair_real(\@ax, \@ay);
}
 
sub closest_pair_real {
{
my ($rx, $ry) = @_;
myreturn @xPclosest_pair_simple($rx) =if scalar(@$rx) <= 3;
my @yP = @$ry;
▲ my $N = @xP;
return closest_pair_simple($rx) if scalar(@xP) <= 3;▼
 
my(@yR, $inf@yL, = 1e600@yS);
▲ my $tN = dist(@$p, $l)rx;
my $midx = ceil($N/2)-1;
my $xm@PL = @${$xPrx[ 0 .. $midx]}[0];▼
 
my @PLPR = @xP$rx[0$midx+1 .. $midxN-1];
my @PR$xm = @xP$$rx[$midx+1 .. $N]-1>[0];
$_->[0] <= $xm ? push @yR, $_ : push @yL, $_ for @$ry;
 
▲ my $xm = ${$xP[$midx]}[0];
 
my @yR = ();▼
my @yL = ();
foreach my $p (@yP) {
if ( ${$p}[0] <= $xm ) {
push @yR, $p;
} else {
push @yL, $p;
}
}
 
my ($al, $bl, $dL) = closest_pair_real(\@PL, \@yR);
my ($ar, $br, $dR) = closest_pair_real(\@PR, \@yL);
my ($w1, $w2, $closest) = ($yS[dR > $dL ? ($k]al, $yS[$i]bl, $ddL) if: ($dar, <$br, $closestdR);▼
abs($xm - $_->[0]) < $closest and push @yS, $_ for @$ry;
 
for my ($m1, $m2, $dmin) =i ($al,0 $bl,.. $dL@yS-1); {
($m1, $m2, $dmin) = ($ar,my $br,k $dR) if= $dRi <+ $dL1;
▲ while ( $k <= $#yS and ($ayS[$k]->[1] - $byS[$i]->[1])**2 < $closest ); {
 
my @yS$d = dist($yS[$k], $yS[$i]);
my ( ($w1, $w2, $closest ) = ($m1yS[$k], $m2yS[$i], $dmind) if $d < $closest;▼
foreach my $p (@yP) {
push @yS, $p if abs($xm - ${$p}[0]) < $dmink++;
▲ my @yR = (); }
}
return ( $w1, $w2, $closest);▼
 
if ( @yS ) {
▲ my ( $w1, $w2, $closest ) = ($m1, $m2, $dmin);
foreach my $i (0 .. ($#yS - 1)) {
 
my $k = $i + 1;
while ( ($k <= $#yS) && ( (${$yS[$k]}[1] - ${$yS[$i]}[1]) < $dmin) ) {
my $d = dist($yS[$k], $yS[$i]);
▲ ($w1, $w2, $closest) = ($yS[$k], $yS[$i], $d) if $d < $closest;
$k++;
}
 
}
▲ return ($w1, $w2, $closest);
 
} else {
return ($m1, $m2, $dmin);
}
}
 
my @points = ();▼
 
push @points, [rand(20)-10.0, rand(20)-10] for 1.0].5000;▼
 
printf "%.8f between (%.5f, %.5f), (%.5f, %.5f)\n", $_->[2], @{$$_[0]}, @{$$_[1]}
▲my @points = ();
▲ returnfor [closest_pair_simple($rx\@points)], if scalar[closest_pair(\@xPpoints) ];<= 3;/lang>
my $N = 5000;
{{out}}
 
<pre>0.00259322 between (-1.95541, -4.29695), (-1.95351, -4.29871)
foreach my $i (1..$N) {
0.00259322 between (-1.95541, -4.29695), (-1.95351, -4.29871)</pre>
▲ 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";</lang>
 
=={{header|Phix}}==
SqrtNegInf
2,392

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/109422"