The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Geo::ShapeFile::Shape::Index;
#use 5.010;  #  not yet
use strict;
use warnings;
use POSIX qw /floor/;
use Carp;
use autovivification;

our $VERSION = '2.62';

#  should also handle X cells
sub new {
    my ($class, $n, $x_min, $y_min, $x_max, $y_max) = @_;

    my $self = bless {}, $class;

    $n ||= 10;  #  need a better default?
    $n   = int $n;
    die 'Number of blocks must be positive and >=1'
      if $n <= 0;

    my $y_range = abs ($y_max - $y_min);
    my $y_tol   = $y_range / 1000;
    $y_range   += 2 * $y_tol;
    $y_min     -= $y_tol;
    $y_max     += $y_tol;

    my $block_ht = $y_range / $n;

    $self->{x_min} = $x_min;
    $self->{y_min} = $y_min;
    $self->{x_max} = $x_max;
    $self->{y_max} = $y_max;
    $self->{y_res} = $block_ht;
    $self->{y_n}   = $n;
    $self->{x_n}   = 1;

    my %blocks;
    my $y = $y_min;
    foreach my $i (1 .. $n) {
        my $key = $self->snap_to_index($x_min, $y);  #  index by lower left
        $blocks{$key} = [];
        $y += $block_ht;
    }
    $self->{containers} = \%blocks;

    return $self;
}

sub get_x_min {$_[0]->{x_min}}
sub get_x_max {$_[0]->{x_max}}
sub get_y_min {$_[0]->{y_min}}
sub get_y_max {$_[0]->{y_max}}
sub get_y_res {$_[0]->{y_res}}

#  return an anonymous array if we are out of the index bounds
sub _get_container_ref {
    my ($self, $id) = @_;

    no autovivification;

    my $containers = $self->{containers};
    my $container  = $containers->{$id} || [];

    return $container;
};

#  need to handle X coords as well
sub snap_to_index {
    my ($self, $x, $y) = @_;

    #my $x_min = $self->get_x_min;
    my $y_min = $self->get_y_min;
    my $y_res = $self->get_y_res;

    #  take the floor, but add a small tolerance to
    #  avoid precision issues with snapping
    my $partial = ($y - $y_min) / $y_res;
    my $y_block = floor ($partial * 1.001);

    return wantarray ? (0, $y_block) : "0:$y_block";
}

#  inserts into whichever blocks overlap the bounding box
sub insert {
    my ($self, $item, @bbox) = @_;

    my @index_id1 = $self->snap_to_index (@bbox[0, 1]);
    my @index_id2 = $self->snap_to_index (@bbox[2, 3]);

    my $insert_count = 0;
    foreach my $y ($index_id1[1] .. $index_id2[1]) {
        my $index_id  = "0:$y";  #  hackish
        my $container = $self->_get_container_ref ($index_id);
        push @$container, $item;
        $insert_count++;
    }

    return $insert_count;
}

#  $storage ref arg is for Tree::R compat - still needed?
sub query_point {
    my ($self, $x, $y, $storage_ref) = @_;

    my $index_id  = $self->snap_to_index ($x, $y);
    my $container = $self->_get_container_ref ($index_id);

    if ($storage_ref) {
        push @$storage_ref, @$container;
    }

    return wantarray ? @$container : [@$container];
}


1;

__END__
=head1 NAME

Geo::ShapeFile::Shape - Geo::ShapeFile utility class.

=head1 SYNOPSIS

  use Geo::ShapeFile::Shape::Index;

  my $index = Geo::ShapeFile::Shape->new;
  #  $pt1 and $pt2 are point objects in this example.  
  my $segment = [$pt1, $pt2];  #  example of something to pack into the index.
  my @bbox = ($x_min, $y_min, $x_max, $y_max);
  $index->insert($segment, @bbox);


=head1 ABSTRACT

  This is a utility class for L<Geo::ShapeFile> that indexes shape objects.

=head1 DESCRIPTION

This is a 2-d block-based index class for Geo::ShapeFile::Shape objects.
It probably has more generic applications, of course.

It uses a flat 2-d structure comprising a series of blocks of full width
which slice the shape along the y-axis (it should really also use blocks
along the x axis).

The index coordinates are simply the number of blocks across and up
from the minimum coordinate specified in the new() call.  These are stoed as
strings jpoined by a colon, so 0:0 is the lower left.
Negative block coordinates can occur if data are added which fall outside the
speficied bounds.  This should not affect the index, though, as it is merely
a relative offset.

It is used internally by Geo::ShapeFile::Shape, so look there for examples.  
The method names are adapted from Tree::R to make transition easier during development,
albeit the argument have morphed so it is not a drop-in replacement. 


=head2 EXPORT

None by default.

=head1 METHODS

=over 4

=item new($n_blocks_y, @bbox)

Creates a new Geo::ShapeFile::Shape::Index objectand returns it.

$n_blocks_y is the number of blocks along the y-axis.
@bbox is the bounding box the index represents (x_min, y_min, x_max, y_max).

=item insert($item, $min_x, $min_y, $max_x, $max_y)

Adds item $item to the blocks which overlap with the specified bounds.
Returns the number of blocks the item was added to.

=item query_point($x, $y)

Returns an array of objects on the block contains point $x,$y.
Returns an arrayref in scalar context.


=item get_x_max() get_x_min() get_y_max() get_y_min()

Bounds of the index, as set in the call to ->new().
There is no guarantee they are the bounds of the data, as
data outside the original bounds can be indexed.

=item get_y_res()

Block resolution along the y-axis.

=item snap_to_index ($x, $y)

Returns the index key associated with point $x,$y.
Does not check if it is outside the bounds of the index,
so negative index values are possible.


=back

=head1 REPORTING BUGS

Please send any bugs, suggestions, or feature requests to
  L<https://github.com/shawnlaffan/Geo-ShapeFile/issues>.

=head1 SEE ALSO

L<Geo::ShapeFile::Shape>

=head1 AUTHOR

Shawn Laffan, E<lt>shawnlaffan@gmail.comE<gt>


=head1 COPYRIGHT AND LICENSE

Copyright 2014 by Shawn Laffan

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut