view release on metacpan or  search on metacpan

lib/Algorithm/Points/MinimumDistance.pm  view on Meta::CPAN

    # Compute the box in which $point lives.
    my @home_box = $self->box($point);

    # $point lives in the region centred on this box, plus all surrounding
    # regions.  Push it into each of these regions.  A region is
    # identified by the box at its centre.
    foreach my $delta ( $self->_offsets ) {
        my @centre = map { $delta->[$_] + $home_box[$_] } (0..$#home_box);
        my $region = $self->region( centre => \@centre );
        push @$region, $point;
    }
}

sub _work_out_distances {
    my $self = shift;
    my $points = $self->{points};

    # Work out which points live in which regions.
    $self->_hash($_) foreach (@$points);

    # For each point, check its distance from every other point inside
    # the region centred on its home box.  All points outside this region
    # are at least a distance 'boxsize' away.
    foreach my $point (@$points) {
        my @box = $self->box($point);
        my $min;
        my $region = $self->region( centre => \@box );
        foreach my $neighbour (@$region) {
            next if $neighbour == $point;    # Reference equality
            my $d = $self->d($point, $neighbour);
            $min = $d if (!defined $min or $d < $min);
        }
        $min ||= $self->{boxsize};
        $self->_store_distance( point => $point, distance => $min );
    }
}

sub _store_distance {
    my ($self, %args) = @_;
    my ($point, $distance) = @args{ qw( point distance ) };
    my $key = join(",", @$point);
    $self->{distances}{$key} = $distance;
}

# Override this for a different metric.
sub d {
    my ($self, $point1, $point2) = @_;
    my $t = 0;
    foreach (0..$#$point1) {
        $t += ($point1->[$_] - $point2->[$_]) ** 2;
    }
    return sqrt($t);
}

=item B<distance>

  my $nn = Algorithm::Points::MinimumDistance->new( ... );
  my $nn_dist = $nn->distance( point => [1, 4] );

Returns the distance between the specified point and its nearest
neighbour.  The point should be one of your original set.  There is no
check that this is the case.  Note that if a point has no particularly
close neighbours, then C<boxsize> will be returned instead.

=cut

sub distance {
    my ($self, %args) = @_;
    my $point = $args{point};
    my $key = join(",", @$point);
    return $self->{distances}{$key};
}

=item B<min_distance>

  my $nn = Algorithm::Points::MinimumDistance->new( ... );
  my $nn_dist = $nn->min_distance;

Returns the minimum nearest-neighbour distance for all points in the set.
Or C<boxsize> if none of the points are close to each other.

=cut

sub min_distance {
    my $self = shift;
    my $dists = $self->{distances};
    my $min;
    foreach my $dist ( values %$dists ) {
        $min = $dist if (!defined $min or $dist < $min);
    }
    return $min;
}

=back

=head1 ALGORITHM

We use the hash as an approximate conservative metric to basically do
clipping of space. A box is one cell of the space defined by the grid
size. A region is a box and all the neighbouring boxes in all directions,
i.e. all the boxes b such that
  d(b, c) <= 1 in the d-infinity metric
Noting that d(b, c) is always an integer in this case.

  +-+-+-+-+-+
  | | | | | |
  +-+-+-+-+-+
  | |x|x|x| |
  +-+-+-+-+-+
  | |x|b|x| |
  +-+-+-+-+-+
  | |x|x|x| |
  +-+-+-+-+-+
  | | | | | |
  +-+-+-+-+-+ 

Now all points outside the region defined by the box b and the
neighbours x can not be within maximum radius $C of any point in box b.

So we reverse the stunt and shove any point in box b into the hash
lists for all boxes b and x so that when testing a point in any box,