diff --git a/lib/Geo/Hash.pm b/lib/Geo/Hash.pm index 12a2fe0..e789452 100644 --- a/lib/Geo/Hash.pm +++ b/lib/Geo/Hash.pm @@ -4,6 +4,15 @@ use warnings; use strict; use Carp; +use Exporter 'import'; +our @EXPORT_OK = qw( ADJ_TOP ADJ_RIGHT ADJ_LEFT ADJ_BOTTOM ); +our %EXPORT_TAGS = (adjacent => \@EXPORT_OK); + +use constant ADJ_RIGHT => 0; +use constant ADJ_LEFT => 1; +use constant ADJ_TOP => 2; +use constant ADJ_BOTTOM => 3; + =head1 NAME Geo::Hash - Encode / decode geohash.org locations. @@ -174,6 +183,117 @@ sub decode { return map { _mid( \@int, $_ ) } 0 .. 1; } +=head2 C<< adjacent >> + +Returns the adjacent geohash. C<$where> denotes the direction, so if you +want the block to the right of C<$hash>, you say: + + use Geo::Hash qw(ADJ_RIGHT); + + my $adjacent = $gh->adjacent( $hash, ADJ_RIGHT ); + +=cut + +my @NEIGHBORS = ( + [ "bc01fg45238967deuvhjyznpkmstqrwx", "p0r21436x8zb9dcf5h7kjnmqesgutwvy" ], + [ "238967debc01fg45kmstqrwxuvhjyznp", "14365h7k9dcfesgujnmqp0r2twvyx8zb" ], + [ "p0r21436x8zb9dcf5h7kjnmqesgutwvy", "bc01fg45238967deuvhjyznpkmstqrwx" ], + [ "14365h7k9dcfesgujnmqp0r2twvyx8zb", "238967debc01fg45kmstqrwxuvhjyznp" ] +); + +my @BORDERS = ( + [ "bcfguvyz", "prxz" ], + [ "0145hjnp", "028b" ], + [ "prxz", "bcfguvyz" ], + [ "028b", "0145hjnp" ] +); + +sub adjacent { + my ( $self, $hash, $where ) = @_; + my $hash_len = length $hash; + + croak "PANIC: hash too short!" + unless $hash_len >= 1; + + my $base; + my $last_char; + my $type = $hash_len % 2; + + if ( $hash_len == 1 ) { + $base = ''; + $last_char = $hash; + } + else { + ( $base, $last_char ) = $hash =~ /^(.+)(.)$/; + if ($BORDERS[$where][$type] =~ /$last_char/) { + my $tmp = $self->adjacent($base, $where); + substr($base, 0, length($tmp)) = $tmp; + } + } + return $base . $ENC[ index($NEIGHBORS[$where][$type], $last_char) ]; +} + +=head2 C<< neighbors >> + +Returns the list of neighbors (the blocks surrounding $hash) + + my @list_of_geohashes = $gh->neighbors( $hash, $around, $offset ) + +=cut + +sub neighbors { + my ( $self, $hash, $around, $offset ) = @_; + $around ||= 1; + $offset ||= 0; + + my $last_hash = $hash; + my $i = 1; + while ( $offset-- > 0 ) { + my $top = $self->adjacent( $last_hash, ADJ_TOP ); + my $left = $self->adjacent( $top, ADJ_LEFT ); + $last_hash = $left; + $i++; + } + + my @list; + while ( $around-- > 0 ) { + my $max = 2 * $i - 1; + $last_hash = $self->adjacent( $last_hash, ADJ_TOP ); + push @list, $last_hash; + + for ( 0..( $max - 1 ) ) { + $last_hash = $self->adjacent( $last_hash, ADJ_RIGHT ); + push @list, $last_hash; + } + + for ( 0..$max ) { + $last_hash = $self->adjacent( $last_hash, ADJ_BOTTOM ); + push @list, $last_hash; + } + + for ( 0..$max ) { + $last_hash = $self->adjacent( $last_hash, ADJ_LEFT ); + push @list, $last_hash; + } + + for ( 0..$max ) { + $last_hash = $self->adjacent( $last_hash, ADJ_TOP ); + push @list, $last_hash; + } + $i++; + } + + return @list; +} + +=head1 CONSTANTS + +=head2 ADJ_LEFT, ADJ_RIGHT, ADJ_TOP, ADJ_BOTTOM + +Used to specify the direction in C + +=cut + 1; __END__ diff --git a/t/adjacent.t b/t/adjacent.t new file mode 100644 index 0000000..6641423 --- /dev/null +++ b/t/adjacent.t @@ -0,0 +1,27 @@ +use strict; +use warnings; +use Test::More; +use Geo::Hash qw(:adjacent); + +ok my $gh = Geo::Hash->new; +isa_ok $gh, 'Geo::Hash'; + +# Made these tests by using +# http://blog.masuidrive.jp/wp-content/uploads/2010/01/geohash.html +is $gh->adjacent('xn76gg', ADJ_RIGHT), 'xn76u5'; # RIGHT +is $gh->adjacent('xn76gg', ADJ_LEFT), 'xn76ge'; # LEFT +is $gh->adjacent('xn76gg', ADJ_TOP), 'xn76gu'; # TOP +is $gh->adjacent('xn76gg', ADJ_BOTTOM), 'xn76gf'; # BOTTOM + +is $gh->adjacent('xpst02vt', ADJ_RIGHT), 'xpst02vv'; # RIGHT +is $gh->adjacent('xpst02vt', ADJ_LEFT), 'xpst02vm'; # LEFT +is $gh->adjacent('xpst02vt', ADJ_TOP), 'xpst02vw'; # TOP +is $gh->adjacent('xpst02vt', ADJ_BOTTOM), 'xpst02vs'; # BOTTOM + +# Check edge cases +is $gh->adjacent('00', ADJ_BOTTOM), 'bp'; +is $gh->adjacent('00', ADJ_LEFT) , 'pb'; +is $gh->adjacent('zz', ADJ_TOP) , 'pb'; +is $gh->adjacent('zz', ADJ_RIGHT) , 'bp'; + +done_testing; diff --git a/t/neighbors.t b/t/neighbors.t new file mode 100644 index 0000000..b7a94b1 --- /dev/null +++ b/t/neighbors.t @@ -0,0 +1,39 @@ +use strict; +use warnings; +use Test::More; +use Geo::Hash qw(:adjacent); + +my $gh = Geo::Hash->new; + +{ + my @set = $gh->neighbors('xn76gg'); + my @expect = qw/xn76gu xn76uh xn76u5 xn76u4 xn76gf xn76gd xn76ge xn76gs/; + ok eq_set \@set, \@expect or + diag "got '@set', but expected '@expect'"; +} + +{ + my @set = $gh->neighbors('xpst02vt'); + my @expect = qw/xpst02vw xpst02vy xpst02vv xpst02vu xpst02vs xpst02vk xpst02vm xpst02vq/; + ok eq_set \@set, \@expect or + diag "got '@set', but expected '@expect'"; +} + +{ + my @set = $gh->neighbors('xn76gg', 2); + my @expect = qw/xn76gu xn76uh xn76u5 xn76u4 xn76gf xn76gd xn76ge xn76gs + xn76gv xn76gm xn76gk xn76g7 xn76um xn76u6 xn76g3 xn76g9 + xn76uk xn76u7 xn76gc xn76uj xn76gt xn76g6 xn76u1 xn76u3/; + ok eq_set \@set, \@expect or + diag "got '@set', but expected '@expect'"; +} + +{ + my @set = $gh->neighbors('xn76gg', 1, 1); + my @expect = qw/xn76gv xn76gm xn76gk xn76g7 xn76um xn76u6 xn76g3 xn76g9 + xn76uk xn76u7 xn76gc xn76uj xn76gt xn76g6 xn76u1 xn76u3/; + ok eq_set \@set, \@expect or + diag "got '@set', but expected '@expect'"; +} + +done_testing;