File Coverage

lib/Geo/Coder/Many/Util.pm

Criterion	Covered	Total	%
statement	61	69	88.4
branch	13	30	43.3
condition	5	9	55.5
subroutine	18	18	100.0
pod	5	5	100.0
total	102	131	77.8

package Geo::Coder::Many::Util;

use strict;
use warnings;
use Geo::Distance::XS; # for calculating precision
use List::Util qw( reduce );
use List::MoreUtils qw( any );

our @EXPORT_OK = qw(
    min_precision_filter
    max_precision_picker
    consensus_picker
    country_filter
);
use Exporter;
use base qw(Exporter);

our $VERSION = '0.01';

my $GDXS = Geo::Distance->new;

=head1 NAME

Geo::Coder::Many::Util

=head1 DESCRIPTION

Miscellaneous routines that are convenient for, for example, generating
commonly used callback methods to be used with Geo::Coder::Many.

=head1 SUBROUTINES

=head2 min_precision_filter

Constructs a result filter callback which only passes results which exceed the
specified precision.

=cut

sub min_precision_filter {
    my $precision_cutoff = shift;
    return sub {
        my $result = shift;
        if ( !defined $result->{precision} ) {
            return 0;
        }
        return $result->{precision} >= $precision_cutoff;
    }
}

=head2 country_filter

Constructs a result filter callback which only passes results with the
specified 'country' value.

=cut

sub country_filter {
    my $country_name = shift;
    return sub {
        my $result = shift;
        if ( !exists $result->{country} ) {
            return 0;
        }
        return $result->{country} eq $country_name;
    }
}

=head2 max_precision_picker

A picker callback that requests all available results, and then picks the one
with the highest precision. Note that querying all available geocoders may take
a comparatively long time.

Example:

$GCMU->set_picker_callback( \&max_precision_picker );

=cut

sub max_precision_picker {
    my ($ra_results, $more_available) = @_;

    # If more results are available, request them
    return if $more_available;

    # If we have all of the results, find the best
    return &_find_max_precision($ra_results);
}

=head2 consensus_picker

Returns a picker callback that requires at least 'required_consensus' separate
geocoder results to be within a bounding square of side-length 'nearness'. If
this can be satisfied, the result from that square which has the highest
precision will be returned. Otherwise, asks for more/returns undef.

WARNING: quadratic time in length of @$ra_results - could be improved if
necessary.

Example:

$GCMU->set_picker_callback(
    consensus_picker({nearness => 0.1, required_consensus => 2})
);

=cut

sub consensus_picker {
    my $rh_args = shift;
    my $nearness = $rh_args->{nearness};
    my $required_consensus = $rh_args->{required_consensus};
    return sub {
        my $ra_results = shift;

        for my $result_a (@{$ra_results}) {

            my $lat_a = $result_a->{latitude};
            my $lon_a = $result_a->{longitude};

            # Find all of the other results that are close to this one
            my @consensus = grep {
                _in_box(
                    $lat_a,
                    $lon_a,
                    $nearness,
                    $_->{latitude},
                    $_->{longitude}
                )
            } @$ra_results;

            if ($required_consensus <= @consensus) {
                # If the consensus is sufficiently large, return the result
                # with the highest precision
                return _find_max_precision(\@consensus);
            }

        }

        # No consensus reached
        return;
    };
}

=head2 determine_precision_from_bbox

    my $precision = Geo::Coder::Many::Util->determine_precision_from_bbox({
                       'lon1' => $sw_lon,
                       'lat1' => $sw_lat,
                       'lon2' => $ne_lon,
                       'lat2' => $ne_lat,
                    });

returns a precison between 0 (unknown) and 1 (highly precise) based on
the size of the box supplied

=cut

sub determine_precision_from_bbox {
    my $rh_args = shift || return 0;

    my $distance = $GDXS->distance('kilometer',
                                $rh_args->{lon1}, $rh_args->{lat1} =>
                                $rh_args->{lon2}, $rh_args->{lat2});

    return 0    if (!defined($distance));
    return 1.0  if ($distance <  0.25);
    return 0.9  if ($distance <  0.5);
    return 0.8  if ($distance <  1);
    return 0.7  if ($distance <  5);
    return 0.6  if ($distance <  7.5);
    return 0.5  if ($distance < 10);
    return 0.4  if ($distance < 15);
    return 0.3  if ($distance < 20);
    return 0.2  if ($distance < 25);
    return 0.1;
}

=head1 INTERNAL ROUTINES

=head2 _in_box

Used by consensus_picker - returns true if ($lat, $lon) is inside the square
with centre ($centre_lat, $centre_lon) and side length 2*$half_width.

=cut

sub _in_box {
    my ($centre_lat, $centre_lon, $half_width, $lat, $lon) = @_;

    return $centre_lat - $half_width < $lat
        && $centre_lat + $half_width > $lat
        && $centre_lon - $half_width < $lon
        && $centre_lon + $half_width > $lon;
}

=head2 _find_max_precision

Given a reference to an array of result hashes, returns the one with the
highest precision value

=cut

sub _find_max_precision {
    my $ra_results = shift;
    return reduce {
        ($a->{precision} || 0.0) > ($b->{precision} || 0.0) ? $a : $b
    } @{$ra_results};
}

1;