view release on metacpan or  search on metacpan

lib/Tree/BPTree.pm  view on Meta::CPAN

# 	my ($self, $new) = @_;
# 	$$self[-1] = $new if defined $new;
# 	return $$self[-1];
# }
# 
sub first_leaf {
	my ($self) = @_;
	my $current = $self;
	until ($current->isa('Tree::BPTree::Leaf')) {
		$current = $$current[0];
	}
	return $current;
}

sub last_leaf {
	my ($self) = @_;
	my $current = $self;
	until ($current->isa('Tree::BPTree::Leaf')) {
		$current = $$current[-1];
	}
	return $current;
}
# 
# sub nkeys {
# 	my ($self) = @_;
# 	return (scalar(@$self) - 1) / 2;
# }
# 
# sub nvalues {
# 	my ($self) = @_;
# 	return (scalar(@$self) + 1) / 2;
# }
 
# The find operation differs slightly between branch and leaf. See the comment
# near Tree::BPTree::Leaf::find for details.
sub find {
	my ($self, $cmp, $key) = @_;
	my $nkeys = (@$self - 1) / 2;
	for (my $k = 0; $k < $nkeys; $k++) {
		if (&$cmp($key, $self->[($k) * 2 + 1]) < 0) {
			return $k;
		}
	}
	return (@$self + 1) / 2 - 1;
}

sub insert {
	my ($self, $v, $key, $value) = @_;
	splice @$self, $v * 2, 0, $value, $key;
}

sub split {
	my ($self, $n, $cmp, $key) = @_;

	# find the node we're going to insert to; split that node; if it splits
	# either incorporate the split in ourselves or split ourselves if we are
	# full
	my $v = $self->find($cmp, $key);
	my $result = $self->[($v) * 2]->split($n, $cmp, $key);
	if ((@$self + 1) / 2 == $n && defined $result) {
		# We're full and they split, we must split too. The way the split must
		# be handled will depend upon whether this is a Left, Center, or Right
		# split. That is, is the sub-split node pointer on the left side, the
		# middle, or the right. But first, let's go ahead and split the node in
		# half.
		#
		# The way a node can be split depends on the oddness of n. If n is odd
		# (normal looking node split), then we split at index n-1 and give the
		# new node n elements. If n is even, we split at index n and give the
		# new node n-1 elements. The combinatorics of this solution are kind of
		# interesting. In any case, we create the new node complete while
		# leaving the current node with a missing end-pointer.
		my $new_node = Tree::BPTree::Node->new(
			splice @$self, 
			$n - ($n % 2),       # n - 1 for odd or n - 0 for even
			$n - (($n + 1) % 2), # n - 0 for odd or n - 1 for even
		);

		my $root_key;
		if ($v < $n / 2) {
			# This is a left split. We need to clip off the last key, insert the
			# child's new root key and set the pointers on either side to the
			# new root nodes. Finally, return a new root with clipped key
			# pointing to us and the new node.
			$root_key = pop @$self;
			my $i = $self->find($cmp, $result->[1]);
			$self->insert($i, $result->[1], $result->[0]);
			$self->[($i+1) * 2] = $result->[2];

		} elsif ($v > $n / 2) {
			# This is a right split. Same as left in reverse, basically. We do
			# need to first shear of the first pointer to the new node and
			# append it back onto as the last pointer of the first node first.
			push @$self, shift @$new_node;
			$root_key = shift @$new_node;
			my $i = $new_node->find($cmp, $result->[1]);
			$new_node->[($i) * 2] = $result->[2];
			$new_node->insert($i, $result->[1], $result->[0]);
		} else {
			# This is a center split. Here, we append to ourself a new pointer
			# pointing to the new left node. We set the new node's first pointer
			# to the new right node. And we set the new root key to the child's
			# new root key.
			push @$self, $result->[0];
			$new_node->[0] = $result->[2];
			$root_key = $result->[1];
		}

		return Tree::BPTree::Node->new($self, $root_key, $new_node);
	} elsif (defined $result) {
		# We have room to accomodate their split, add the new nodes here.
		# Regular insert will do this in the wrong order.
#		$self->insert($v, $$result[-1]->first_leaf->[1], $$result[-1]);

		# The new node will always be the last node, so we need to insert the
		# key/pointer in reverse order from normal such that the key happens at
		# $i and the value is at $i + 1
		my $i = $self->find($cmp, $key);
		splice @$self, $i * 2 + 1, 0, $$result[-1]->first_leaf->[1], $$result[-1];
		return undef;
	} else {