Closest-pair problem

Using concurrency, the 'simple' routine beats the (supposedly) more efficient one for all but the smallest sets of input.

sub MAIN ($N = 5000) {
    my @points = (^$N).map: { [rand × 20 - 10, rand × 20 - 10] }

    my @candidates = @points.sort(*.[0]).rotor( 10 => -2, :partial).race.map: { closest-pair-simple(@$_) }
    say 'simple ' ~ (@candidates.sort: *.[2]).head(1).gist;
    @candidates    = @points.sort(*.[0]).rotor( 10 => -2, :partial).race.map: { closest-pair(@$_)        }
    say 'real '   ~ (@candidates.sort: *.[2]).head(1).gist;
}

sub dist-squared(@a, @b) { (@a[0] - @b[0])² + (@a[1] - @b[1])² }

sub closest-pair-simple(@points is copy) {
    returnif @points < 2;
    my ($a, $b, $d) = |@points[0,1], dist-squared(|@points[0,1]);
    while @points {
        my \p = pop @points;
        for @points -> \l {
            ($a, $b, $d) = p, l, $_ if $_ < $d given dist-squared(p, l);
        }
    }
    $a, $b, $d.sqrt
}

sub closest-pair(@r) {
    closest-pair-real (@r.sort: *.[0]), (@r.sort: *.[1])
}

sub closest-pair-real(@rx, @ry) {
    return closest-pair-simple(@rx) if @rx ≤ 3;

    my \N  = @rx;
    my \midx = ceiling(N/2) - 1;
    my @PL := @rx[     0 ..  midx];
    my @PR := @rx[midx+1 ..^ N   ];
    my \xm  = @rx[midx;0];
    (.[0] ≤ xm ?? my @yR !! my @yL).push: @$_ for @ry;
    my (\al, \bl, \dL) = closest-pair-real(@PL, @yR);
    my (\ar, \br, \dR) = closest-pair-real(@PR, @yL);
    my ($w1, $w2, $closest) = dR < dL ?? (ar, br, dR) !! (al, bl, dL);
    my @yS = @ry.grep: { (xm - .[0]).abs < $closest }

    for 0 ..^ @yS -> \i {
        for i+1 ..^ @yS -> \k {
            next unless @yS[k;1] - @yS[i;1] < $closest;
            ($w1, $w2, $closest) = |@yS[k, i], $_ if $_ < $closest given dist-squared(|@yS[k, i]).sqrt;
        }
    }
    $w1, $w2, $closest
}

Output:

simple (([-1.1560800527301716 -9.214015073077793] [-1.1570263876019649 -9.213340680530798] 0.0011620477602117762))
  real (([-1.1570263876019649 -9.213340680530798] [-1.1560800527301716 -9.214015073077793] 0.0011620477602117762))

Last updated