view release on metacpan or  search on metacpan

lib/Algorithm/SpatialIndex/Strategy/OctTree.pm  view on Meta::CPAN

  $self->{max_depth}   = $index->max_depth   if not defined $self->max_depth;

  $self->{top_node_id} = $storage->get_option('top_node_id');
  if (not defined $self->top_node_id) {
    # create a new top node and its bucket
    my $node = Algorithm::SpatialIndex::Node->new(
      coords => [
        $index->limit_x_low, $index->limit_y_low, $index->limit_z_low,
        $index->limit_x_up, $index->limit_y_up, $index->limit_z_up,
        undef, undef, undef,
      ],
      subnode_ids => [],
    );
    $self->{top_node_id} = $storage->store_node($node);
    $self->_make_bucket_for_node($node, $storage);
  }

  $self->{total_width} = $index->limit_x_up - $index->limit_x_low;
}

sub insert {
  my ($self, $id, $x, $y, $z) = @_;
  my $storage = $self->{storage}; # hash access due to hot path
  my $top_node = $storage->fetch_node($self->{top_node_id}); # hash access due to hot path
  return $self->_insert($id, $x, $y, $z, $top_node, $storage);
}

SCOPE: {
  no warnings 'recursion';
  sub _insert {
    my ($self, $id, $x, $y, $z, $node, $storage) = @_;
    my $nxyz = $node->coords;
    my $subnodes = $node->subnode_ids;

    # If we have a bucket, we are the last level of nodes
    SCOPE: {
      my $bucket = $storage->fetch_bucket($node->id);
      if (defined $bucket) {
        my $items = $bucket->items;
        if (@$items < $self->{bucket_size}) {
          # sufficient space in bucket. Insert and return
          push @{$items}, [$id, $x, $y, $z];
          $storage->store_bucket($bucket);
          return();
        }
        # check whether we've reached the maximum depth of the tree
        # and ignore bucket size if necessary
        # ( total width / local width ) = 2^( depth )
        elsif ($nxyz->[XUP] - $nxyz->[XLOW] <= 0.
               or log($self->total_width / ($nxyz->[XUP]-$nxyz->[XLOW])) / log(2) >= $self->max_depth)
        {
          # bucket at the maximum depth. Insert and return
          push @{$items}, [$id, $x, $y];
          $storage->store_bucket($bucket);
          return();
        }
        else {
          # bucket full, need to add new layer of nodes and split the bucket
          $self->_split_node($node, $bucket);
          # refresh data that will have changed:
          $node = $storage->fetch_node($node->id); # has updated subnode ids
          $subnodes = $node->subnode_ids;
          # Now we just continue with the normal subnode checking below:
        }
      }
    } # end scope

    my $subnode_index;
    if ($x <= $nxyz->[XSPLIT]) {
      if ($y <= $nxyz->[YSPLIT]) {
        if ($z <= $nxyz->[ZSPLIT]) { $subnode_index = MMM_NODE }
        else                       { $subnode_index = MMP_NODE }
      }
      else { # $y > ysplit
        if ($z <= $nxyz->[ZSPLIT]) { $subnode_index = MPM_NODE }
        else                       { $subnode_index = MPP_NODE }
      }
    }
    else { # $x > xsplit
      if ($y <= $nxyz->[YSPLIT]) {
        if ($z <= $nxyz->[ZSPLIT]) { $subnode_index = PMM_NODE }
        else                       { $subnode_index = PMP_NODE }
      }
      else { # $y > ysplit
        if ($z <= $nxyz->[ZSPLIT]) { $subnode_index = PPM_NODE }
        else                       { $subnode_index = PPP_NODE }
      }
    }

    if (not defined $subnodes->[$subnode_index]) {
      die("Cannot find subnode $subnode_index if node id=".$node->id);
    }
    else {
      my $subnode = $storage->fetch_node($subnodes->[$subnode_index]);
      die("Need node '" .$subnodes->[$subnode_index] . '", but it is not in storage!')
        if not defined $subnode;
      return $self->_insert($id, $x, $y, $z, $subnode, $storage);
    }
  }
} # end SCOPE

sub _node_split_coords {
  # args: $self, $node, $bucket, $coords
  my $c = $_[3];
  return(
    ($c->[XLOW]+$c->[XUP])/2,
    ($c->[YLOW]+$c->[YUP])/2,
    ($c->[ZLOW]+$c->[ZUP])/2,
  );
}


# Splits the given node into four new nodes of equal
# size and assigns the items
sub _split_node {
  my $self        = shift;
  my $parent_node = shift;
  my $bucket      = shift; # just for speed, can be taken from parent_node

  my $storage = $self->storage;
  my $parent_node_id = $parent_node->id;