The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Algorithm::SpatialIndex::MQTreeTest;
use strict;
use warnings;
use Test::More;
use Algorithm::SpatialIndex::Strategy::MedianQuadTree;

sub run {
  my $class = shift;
  my $storage = shift;
  
  my @limits = qw(12 -2 15 7);
  my $index = Algorithm::SpatialIndex->new(
    strategy => 'MedianQuadTree',
    storage  => $storage,
    limit_x_low => $limits[0],
    limit_y_low => $limits[1],
    limit_x_up  => $limits[2],
    limit_y_up  => $limits[3],
    bucket_size => 5,
    @_,
  );

  isa_ok($index, 'Algorithm::SpatialIndex');

  my $strategy = $index->strategy;
  isa_ok($strategy, 'Algorithm::SpatialIndex::Strategy::MedianQuadTree');

  is($strategy->no_of_subnodes, 4, 'MedianQuadTree has four subnodes');
  is_deeply([$strategy->coord_types], [qw(double double double double double double)], 'MedianQuadTree has six coordinates');


  # this is unit testing:
  SCOPE: {
    my $bucket = Algorithm::SpatialIndex::Bucket->new(
      node_id => 1,
      items => [
        [0, 1, 2],
        [1, 5, 1],
        [2, 7, 9],
      ],
    );
    my ($x, $y) = $strategy->_node_split_coords(undef, $bucket, [2, -3, 5, 4]);
    my $eps = 1.e-6;
    cmp_ok($x, '<=', 5+$eps);
    cmp_ok($x, '>=', 5-$eps);
    cmp_ok($y, '<=', 2+$eps);
    cmp_ok($y, '>=', 2-$eps);

    # assert that we have a top node whatever comes
    ok(defined($strategy->top_node_id), 'Have a top node id');
    my $top_node = $index->storage->fetch_node($strategy->top_node_id);
    isa_ok($top_node, 'Algorithm::SpatialIndex::Node');
    is($top_node->id, $strategy->top_node_id, 'Top node has top_node_id...');
    my $xy = $top_node->coords;

    cmp_ok($xy->[0], '<=', $limits[0]+$eps);
    cmp_ok($xy->[0], '>=', $limits[0]-$eps);
    cmp_ok($xy->[1], '<=', $limits[1]+$eps);
    cmp_ok($xy->[1], '>=', $limits[1]-$eps);
    cmp_ok($xy->[2], '<=', $limits[2]+$eps);
    cmp_ok($xy->[2], '>=', $limits[2]-$eps);
    cmp_ok($xy->[3], '<=', $limits[3]+$eps);
    cmp_ok($xy->[3], '>=', $limits[3]-$eps);
  }

  my $scale = 2;
  my $item_id = 0;
  foreach my $x (map {$_/$scale} ($limits[0]+1e-4)*$scale..($limits[2]-1e-4)*$scale) {
    foreach my $y (map {$_/$scale} ($limits[1]+1.e4)*$scale..($limits[3]-1.e-4)*$scale) {
      $index->insert($item_id++, $x, $y);
    }
  }

  foreach my $coords ([0, 0],
                      [100, 100],
                      [-12, 14])
  {
    ok(!defined($strategy->find_node_for(@$coords)), 'Coords outside index have no node');
  }


  #my @limits = qw(12 -2 15 7);
  foreach my $coords ([12, -2],
                      [12, 7],
                      [15, -2],
                      [15, 7],
                      [14.123, 4.09],
                      [13.123, -1.09],
                      [13, 0])
  {
    my $node = $strategy->find_node_for(@$coords);
    # This test is using internal info about the strategy's coordinates
    my $node_coords = $node->coords;
    cmp_ok($node_coords->[Algorithm::SpatialIndex::Strategy::MedianQuadTree::XLOW()],
           '<=', $coords->[0], 'Node lower x boundary okay');
    cmp_ok($node_coords->[Algorithm::SpatialIndex::Strategy::MedianQuadTree::YLOW()],
           '<=', $coords->[1], 'Node lower y boundary okay');
    cmp_ok($node_coords->[Algorithm::SpatialIndex::Strategy::MedianQuadTree::XUP()],
           '>=', $coords->[0], 'Node upper x boundary okay');
    cmp_ok($node_coords->[Algorithm::SpatialIndex::Strategy::MedianQuadTree::YUP()],
           '>=', $coords->[1], 'Node upper y boundary okay');

    ok(defined($index->storage->fetch_bucket($node->id)), 'Node has bucket == leaf');
  }


  #my @limits = qw(12 -2 15 7);
  foreach my $coords ([12, -2, 15, 7],
                      [10, -5, 19, 9],
                      [13, -5, 14, 9],
                      [12.1, 0.1, 13.05, 0.5],
                      )
  {
    my @nodes = $strategy->find_nodes_for(@$coords);
    ok(
      ( 0 == grep {!defined($index->storage->fetch_bucket($_->id))} @nodes ),
      'Node has bucket == leaf'
    );
  }

  #my @limits = qw(12 -2 15 7);
  foreach my $coords ([12, -2, 15, 7],
                      [10, -5, 19, 9],
                      )
  {
    my @items = $index->get_items_in_rect(@$coords);
    is(scalar(@items), $item_id, 'Encompassing coords get all elems');
  }
} # end run

1;