File Coverage

blib/lib/Tree/Binary/Search.pm

Criterion	Covered	Total	%
statement	195	197	98.9
branch	101	112	90.1
condition	21	29	72.4
subroutine	35	35	100.0
pod	18	18	100.0
total	370	391	94.6

package Tree::Binary::Search;

use strict;
use warnings;

use Scalar::Util qw(blessed);

use Tree::Binary::Search::Node;

use constant TRUE  => 1;
use constant FALSE => 0;

use constant EQUAL_TO     =>  0;
use constant LESS_THAN    => -1;
use constant GREATER_THAN =>  1;

our $VERSION = '1.07';

## ----------------------------------------------------------------------------
## Tree::Binary::Search
## ----------------------------------------------------------------------------

### constructor

sub new {
	my ($_class, $root) = @_;
	my $class = ref($_class) || $_class;
	my $binary_search_tree = {};
	bless($binary_search_tree, $class);
	$binary_search_tree->_init($root);
	return $binary_search_tree;
}

### ---------------------------------------------------------------------------
### methods
### ---------------------------------------------------------------------------

## ----------------------------------------------------------------------------
## private methods

sub _init {
	my ($self, $root) = @_;
    $self->{_root} = $root || "Tree::Binary::Search::Node";
    $self->{_comparison_func} = undef;
}

sub _compare {
    my ($self, $current_key, $btree_key) = @_;
    my $result = $self->{_comparison_func}->($btree_key, $current_key);
    # catch non-numeric values here
    # as well as numbers that are not
    # within our acceptable range
    ($result =~ /\d/ && ($result >= LESS_THAN && $result <= GREATER_THAN))
        || die "Bad Value : got a bad value from the comparison function ($result)";
    return $result;
}

## ----------------------------------------------------------------------------
## mutators

sub useStringComparison {
    my ($self) = @_;
    $self->{_comparison_func} = sub { $_[0] cmp $_[1] };
}

sub useNumericComparison {
    my ($self) = @_;
    $self->{_comparison_func} = sub { $_[0] <=> $_[1] };
}

sub setComparisonFunction {
    my ($self, $func) = @_;
    (ref($func) eq "CODE")
        || die "Incorrect Object Type : comparison function is not a function";
    $self->{_comparison_func} = $func;
}

## ----------------------------------------------------------------------------
## accessors

sub getTree {
    my ($self) = @_;
    return $self->{_root};
}

## ----------------------------------------------------------------------------
## informational

sub isEmpty {
    my ($self) = @_;
    return (ref($self->{_root})) ? FALSE : TRUE;
}

## ----------------------------------------------------------------------------
## methods for underlying tree

sub accept {
    my ($self, $visitor) = @_;
    $self->{_root}->accept($visitor);
}

sub size {
    my ($self) = @_;
    return $self->{_root}->size();
}

sub height {
    my ($self) = @_;
    return $self->{_root}->height();
}

sub DESTROY {
    my ($self) = @_;
    # be sure to call call the DESTROY method
    # on the underlying tree to ensure it is
    # cleaned up properly
    ref($self->{_root}) && $self->{_root}->DESTROY();
}

## ----------------------------------------------------------------------------
## search methods

sub insert {
    my ($self, $key, $value) = @_;
    my $btree;
    if (defined $key && defined $value) {
        $btree = $self->{_root}->new($key, $value);
    }
    elsif (!defined $value &&
           (blessed($key) && $key->isa("Tree::Binary::Search::Node"))) {
        $btree = $key;
    }
    else {
        die "Insufficient Arguments : bad arguments to insert";
    }
    # if the root is not a reference, then
    # we dont yet have a root, so ...
    if ($self->isEmpty()) {
        (defined($self->{_comparison_func}))
            || die "Illegal Operation : No comparison function set";
        $self->{_root} = $btree;
    }
    else {
        my $current = $self->{_root};
        while (1) {
            my $comparison = $self->_compare($current->getNodeKey(), $btree->getNodeKey());
            # if it is equal to, then throw
            # an exception since you can insert
            # duplicates
            die "Illegal Operation : you cannot insert a duplicate key" if $comparison == EQUAL_TO;
            # otherwise ...
            if ($comparison == LESS_THAN) {
                # if it is less than, then we need
                # to insert it down the left arm of
                # the tree, unless of course we
                # dont have a left arm, in which case
                # we just make one out of these vaules
                if ($current->hasLeft()) {
                    $current = $current->getLeft();
                    next;
                }
                else {
                    $current->setLeft($btree);
                    last;
                }
            }
            elsif ($comparison == GREATER_THAN) {
                # if it is greater than, then we need
                # to insert it down the right arm of
                # the tree, unless of course we
                # dont have a right arm, in which case
                # we just make one out of these vaules
                if ($current->hasRight()) {
                    $current = $current->getRight();
                }
                else {
                    $current->setRight($btree);
                    last;
                }
            }
        }
    }
}

sub update {
    my ($self, $key, $value) = @_;
    (!$self->isEmpty())
        || die "Illegal Operation : Cannot update without first inserting";
    (defined $key && defined $value)
        || die "Insufficient Arguments : Must supply a key to find and a value to update";
    # now go about inserting
    my $current = $self->{_root};
    while (1) {
        my $comparison = $self->_compare($current->getNodeKey(), $key);
        # if it is equal to 0, then we have
        # found out value, and we update it
        if ($comparison == EQUAL_TO) {
            $current->setNodeValue($value);
            last;
        }
        elsif ($comparison == LESS_THAN) {
            # if it is less than, then we need
            # to ...
            ($current->hasLeft()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getLeft();
            next;
        }
        elsif ($comparison == GREATER_THAN) {
            # if it is greater than, then we need
            # to ...
            ($current->hasRight()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getRight();
            next;
        }
    }
}

sub select : method {
    my ($self, $key) = @_;
    (!$self->isEmpty())
        || die "Illegal Operation : Cannot lookup anything without first inserting";
    (defined $key)
        || die "Insufficient Arguments : Must supply a key to find";

    my $current = $self->{_root};
    while (1) {
        my $comparison = $self->_compare($current->getNodeKey(), $key);
        if ($comparison == EQUAL_TO) {
            # if it is equal to, then we are
            # have found it, so return
            last;
        }
        elsif ($comparison == LESS_THAN) {
            # if it is less than, then we need
            # to look down the left arm of
            # the tree, unless of course we
            # dont have a left arm, in which case
            # we just die
            ($current->hasLeft()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getLeft();
            next;
        }
        elsif ($comparison == GREATER_THAN) {
            # if it is greater than, then we need
            # to look down the right arm of
            # the tree, unless of course we
            # dont have a right arm, in which case
            # we just dies
            ($current->hasRight()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getRight();
            next;
        }
    }
    return $current->getNodeValue();
}

sub exists : method {
    my ($self, $key) = @_;
    (defined $key)
        || die "Insufficient Arguments : Must supply a key to find";
    return FALSE if $self->isEmpty();

    my $current = $self->{_root};
    while (1) {
        my $comparison = $self->_compare($current->getNodeKey(), $key);
        if ($comparison == 0) {
            # if it is equal to, then we are
            # have found it, so return TRUE
            return TRUE;
        }
        elsif ($comparison == -1) {
            # if it is less than, then we need
            # to look down the left arm of
            # the tree, unless of course we
            # dont have a left arm, in which case
            # we just return FALSE
            ($current->hasLeft()) || return FALSE;
            $current = $current->getLeft();
            next;
        }
        elsif ($comparison == 1) {
            # if it is greater than, then we need
            # to look down the right arm of
            # the tree, unless of course we
            # dont have a right arm, in which case
            # we just return FALSE
            ($current->hasRight()) || return FALSE;
            $current = $current->getRight();
            next;
        }
    }
}

sub _max_node {
    my ($self) = @_;
    (!$self->isEmpty())
        || die "Illegal Operation : Cannot get a max without first inserting";
    my $current = $self->{_root};
    $current = $current->getRight() while $current->hasRight();
    return $current;
}

sub _min_node {
    my ($self) = @_;
    (!$self->isEmpty())
        || die "Illegal Operation : Cannot get a min without first inserting";
    my $current = $self->{_root};
    $current = $current->getLeft() while $current->hasLeft();
    return $current;
}

sub max_key {
    my ($self) = @_;
    return $self->_max_node()->getNodeKey();
}

sub min_key {
    my ($self) = @_;
    return $self->_min_node()->getNodeKey();
}

sub max {
    my ($self) = @_;
    return $self->_max_node()->getNodeValue();
}

sub min {
    my ($self) = @_;
    return $self->_min_node()->getNodeValue();
}

## ------------------------------------------------------------------------
## Delete was pretty much lifted from the description in:
## http://www.msu.edu/~pfaffben/avl/libavl.html/Deleting-from-a-BST.html
## ------------------------------------------------------------------------

sub delete : method {
    my ($self, $key) = @_;
    (!$self->isEmpty())
        || die "Illegal Operation : Cannot delete without first inserting";
    (defined($key))
        || die "Insufficient Arguments : you must supply a valid key to lookup in the tree";

    my $current = $self->{_root};
    while (1) {
        my $comparison = $self->_compare($current->getNodeKey(), $key);
        if ($comparison == 0) {
            # if it is equal to,
            if ($current->isLeaf()) {
                # no children at all, then ...
                if ($current->isRoot()) {
                    # if it has no children and is the root
                    # then we need to remove the root, and
                    # replace it with the package name of the
                    # tree the user wants to use
                    $self->{_root} = ref($current);
                    return TRUE;
                }
                else {
                    # otherwise we just want to remove
                    # outselves from the parent
                    $self->_replaceInParent($current);
                    return TRUE;
                }
            }
            else {
                # we know we have at least one child
                # since we are not a leaf node
                if (!$current->hasRight()) {
                    # if we dont have the right, then
                    # we know we have a left (otherwise
                    # we would be a leaf)
                    # remove the left then, then
                    my $left = $current->removeLeft();
                    # remove current from it parent
                    # and replace it with the left
                    $self->_replaceInParent($current, $left);
                    return TRUE;
                }
                # however, if we have a right side, then ...
                else {
                    # remove the right side ...
                    my $right = $current->getRight();
                    # if the right itself has a left then ...
                    if (!$right->hasLeft()) {
                        # remove the right child
                        my $right = $current->removeRight();
                        # set the right child's left (if we have one)
                        $right->setLeft($current->removeLeft()) if $current->hasLeft();
                        # remove current from it parent
                        # and replace it with the right
                        $self->_replaceInParent($current, $right);
                        return TRUE;
                    }
                    else {
			# go to the leftmost node in the right subtree
                        my $inorder_successor = $right;
                        my $current_right;

			do {
                            $current_right = $inorder_successor;
				$inorder_successor = $inorder_successor->getLeft();
			} while ( $inorder_successor->hasLeft() );

                        # now that are here, we can adjust the tree
                        if ($inorder_successor->hasRight()) {
                            $current_right->setLeft($inorder_successor->getRight());
                        }
                        else {
                            $inorder_successor->getParent()->removeLeft();
                        }
                        $inorder_successor->setLeft($current->removeLeft()) if $current->hasLeft();
                        $inorder_successor->setRight($current->removeRight()) if $current->hasRight();
                        $self->_replaceInParent($current, $inorder_successor);
                        return TRUE;
                    }
                }
            }
        }
        elsif ($comparison == -1) {
            # if it is less than, ...
            ($current->hasLeft()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getLeft();
            next;
        }
        elsif ($comparison == 1) {
            # if it is greater than, ...
            ($current->hasRight()) || die "Key Does Not Exist : the key ($key) does not exist in this tree";
            $current = $current->getRight();
            next;
        }
    }
}

# delete helper

sub _replaceInParent {
    my ($self, $tree, $replacement) = @_;
    if ($tree->isRoot()) {
        $replacement->makeRoot();
        $self->{_root} = $replacement;
    }
    else {
        my $parent = $tree->getParent();
        if ($parent->hasLeft() && $parent->getLeft() eq $tree) {
            $parent->removeLeft();
            $parent->setLeft($replacement) if $replacement;
        }
        elsif ($parent->hasRight() && $parent->getRight() eq $tree) {
            $parent->removeRight();
            $parent->setRight($replacement) if $replacement;
        }
    }
}

1;

__END__