package NTree;

# This is a basic module implementing a binary search tree.
# For a description of binary search trees, see:
#   Thomas H. Corman, Charles E. Leiserson and Ronald L. Rivest:
#   "Introduction to Algorithms". MIT Press/McGraw-Hill, 1990.
#   Chapter 13.

# Trees are unbalanced; this package is assumed to be a basic 
# package; balanced trees can inherit this and mask the appropriate
# functions (insert/delete will often be enough).

# Public methods:
#   new ():                  create an empty tree.
#   insert (key):            insert key.
#   delete (key):            delete a key.
#   is_empty ():             true if tree is empty.
#   query (key):             true if key exists.
#   range_query (from, to):  return all keys in range.
#   keys ():                 return all keys.
#   maximum ():              return maximum of the tree.
#   minimum ():              return minimum of the tree.
#   successor (key):         return smallest key larger than the query key.
#   predecessor (key):       return largest key smaller than the query key.

# Keys are assumed to be numeric. To deal with keys of different types,
# the function CMP can be masked. CMP takes three arguments, the object
# itself, and two arguments. It should return -1, 0, 1 in the same way
# <=> and cmp do.

use strict;
use Carp;

# Redefinable functions. 
# First returns the info fields of the node, second the structure fields.
sub FIELDS () {qw /key value/;}
sub NODES  () {qw /left right/;}

# Create a node.
# Probably not a good idea to mask.
sub new ($;$) {
    my $proto = shift;
    my $class = ref ($proto) || $proto;
    my $copy  = shift;

    my $self  = bless {}, $class;

    if ($copy && ref $proto) {
        map {$self->{$_} = $proto->{$_};} keys %$proto;
    }
    else {
        map {$self->{$_} = undef;} $self->FIELDS (), $self->NODES ();
    }

    $self->initialize ($copy) unless $copy;

    $self;
}

# Further setup of the node. Maskable.
sub initialize ($) {}

# Tree modifying functions.

# $status = $tree->insert (key);
sub insert ($$$) {
    my $self  = shift;
    my $key   = shift;
    my $value = shift;

    if ($self->is_empty ()) {
        $self->{key}   = $key;
        $self->{value} = $value;
        $self->{left}  = $self->new ();
        $self->{right} = $self->new ();
        return 1;
    }

    return 0 if $self->eq ($key);
    $self->{$self->lt ($key) ? "left" : "right"}->insert ($key);
}

# $status = $tree->delete (key);
sub delete ($$) {
    my $self = shift;
    my $key  = shift;

    return 0 if $self->is_empty ();   # Key isn't there.

    # If unequal, go into recursion.
    return $self->{left} ->delete ($key) if $self->lt ($key);
    return $self->{right}->delete ($key) if $self->gt ($key);

    # So now we have to delete this node.
    # Easy cases, we only have one kid.
    if ($self->{left} ->is_empty ()) {
        $self->_copy ($self->{right});
        return 1;
    }
    if ($self->{right} ->is_empty ()) {
        $self->_copy ($self->{left});
        return 1;
    }

    # Else, both subtrees are filled. Find the minimum of the right subtree.
    my $min = $self->{right}->_tree_minimum ();

    # Copy the content, but not the structure.
    $self->_copy_fields ($min);

    # Delete the minimum from right subtree.
    # We could have called $min->delete (), but this allows
    # for a cleaner "cleanup from recursion" when masked.
    $self->{right}->delete ($min->{key});

    1;
}

# Query functions.

# Return true if the tree is empty.
# $empty = $tree->is_empty ();
sub is_empty ($) {!defined shift->{key};}

# Return whether a key exists.
# $exists = $tree->query (key);
sub query ($$) {
    my $self = shift;
    my $key  = shift;

    return 0 if $self->is_empty ();
    return 1 if $self->eq ($key);

    $self->{$self->lt ($key) ? "left" : "right"}->query ($key);
}

# Return the value corresponding to the given key.
sub fetch ($$) {
    my $self = shift;
    my $key  = shift;
    my $tree = $self->_tree_fetch($key);
    return $tree && $tree->{value};
}


# Return keys in a range.
# @keys = $tree->range_query (from, to);
# from == undef -> -infinity.
# to   == undef -> +infinity.
sub range_query ($$$) {
    my $self = shift;
    my $from = shift;
    my $to   = shift;

    return () if $self->is_empty ();
    my @out  = ();
    if (!defined $from || $self->lt ($from)) {
        push @out, $self->{left}->range_query ($from, $to);
    }
    if ((!defined $from || $self->le ($from)) &&
        (!defined $to   || $self->ge ($to))) {
        push @out, $self->{key};
    }
    if (!defined $to   || $self->gt ($to)) {
        push @out, $self->{right}->range_query ($from, $to);
    }

    @out;
}

# Return all the keys of a tree. 
# This is a redundant function, $tree->range_query (undef, undef)
# does the same.
# @keys = $trees->keys ();
sub keys ($) {
    my $self   = shift;

    return () if $self->is_empty ();

   ($self->{left} ->keys (), $self->{key}, $self->{right}->keys ());
}

# Maximum and minimum of a tree.
# $max = $tree->maximum ();
# $min = $tree->minimum ();
sub maximum ($) {shift->_tree_maximum ()->{key};}
sub minimum ($) {shift->_tree_minimum ()->{key};}

# Successor and predecessor of keys (don't need to be present).
# $succ = $tree->successor (key);
# $pred = $tree->predecessor (key);
sub successor   ($$) {shift->_tree_successor   (shift)->{key};}
sub predecessor ($$) {shift->_tree_predecessor (shift)->{key};}

# Compare values with keys. 
# If you want some other order, mask this function:
sub CMP ($$$) {shift; (shift) <=> (shift);}

# Internal functions:
# PRECONDITION for all these functions: !$self->is_empty ();
sub lt   ($$) {my $self = shift; $self->CMP (shift, $self->{key}) <  0;}
sub le   ($$) {my $self = shift; $self->CMP (shift, $self->{key}) <= 0;}
sub eq   ($$) {my $self = shift; $self->CMP (shift, $self->{key}) == 0;}
sub ge   ($$) {my $self = shift; $self->CMP (shift, $self->{key}) >= 0;}
sub gt   ($$) {my $self = shift; $self->CMP (shift, $self->{key}) >  0;}
sub cmp  ($$) {my $self = shift; $self->CMP (shift, $self->{key});}

# Internal functions. Functions starting with _tree return trees.
# Return the maximum of a tree.
sub _tree_maximum ($) {
    my $self = shift;
    return $self if $self->is_empty ();   # Empty trees don't have maxima.
    $self->{right}->is_empty () ? $self
                                    : $self->{right}->_tree_maximum ();
}

# Return the minimum of a tree.
sub _tree_minimum ($) {
    my $self = shift;
    return $self if $self->is_empty ();   # Empty trees don't have minima.
    $self->{left}->is_empty ()  ? $self
                                    : $self->{left}->_tree_minimum ();
}

# Return the successor of a key.
sub _tree_successor ($$) {
    my $self = shift;
    my $key  = shift;

    # Return a leaf if tree is empty.
    return $self if $self->is_empty ();

    # If $key is larger or equal, go into recursion on the right subtree.
    return $self->{right}->_tree_successor ($key) if $self->ge ($key);

    my $succ;
    # If $key is smaller, find the successor in the left subtree (may fail).
    $succ = $self->{left}->_tree_successor ($key) if $self->lt ($key);

    # If left tree didn't find an answer, return self.
    $succ->is_empty () ? $self : $succ;
}

# Return the predecessor of a key.
sub _tree_predecessor ($$) {
    my $self = shift;
    my $key  = shift;

    # Return a leaf if tree is empty.
    return $self if $self->is_empty ();

    # If $key is smaller or equal, go into recursion on the left subtree.
    return $self->{left}->_tree_predecessor ($key) if $self->le ($key);

    my $pred;
    # If $key is larger, find the predecessor in the right subtree (may fail).
    $pred = $self->{right}->_tree_predecessor ($key) if $self->gt ($key);

    # If right tree didn't find an answer, return self.
    $pred->is_empty () ? $self : $pred;
}

# Return the tree corresponding to the given key.
sub _tree_fetch ($$) {
    my $self = shift;
    my $key  = shift;

    return undef   if $self->is_empty ();
    return $self   if $self->eq ($key);

    $self->{$self->lt ($key) ? "left" : "right"}->_tree_fetch($key);
} 

# Copy the content of a node to me.
sub _copy_fields ($$) {
    my $self  = shift;
    my $other = shift;

    map {$self->{$_} = $other->{$_};} $self->FIELDS ();
}

# Copy the content of a node to me.
sub _copy_kids ($$) {
    my $self  = shift;
    my $other = shift;

    map {$self->{$_} = $other->{$_};} $self->NODES ();
}

# Copy the content of a node to me.
sub _copy ($$) {
    my $self  = shift;
    my $other = shift;
    $self->_copy_fields ($other);
    $self->_copy_kids   ($other);
}

1;