package StupidTree; use CLR::Tree::Binary; @ISA = qw(CLR::Tree::Binary); use strict; # Redefinable functions. # First returns the info fields of the node, second the structure fields. sub FIELDS () {qw /key value/;} sub CHILDS () {qw /left right succ prev/;} # 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}; } # Replace the value corresponding to the given key. sub replace ($$$) { my $self = shift; my $key = shift; my $value = shift; my $node = $self->_tree_fetch($key); if ($node) { $node->{value} = $value; } else { $self->insert($key, $value); } return $value; } # 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); } # $tree -> insert (key, value); # value == undef is fine. sub insert { my $self = shift; my ($key, $value) = @_; my $is_new; if ( $self -> is_empty || $self->eq($key) ) { $self ->{key} = $key; $self ->{value} = $value; $self ->{left} = $self -> new (); $self ->{right} = $self -> new (); $self ->{prev} = $self -> new (); $self ->{succ} = $self -> new (); return $self; } # Recurse. my $newNode = $self->{$self->lt($key) ? 'left' : 'right'}->insert($key, $value); if ( ref $newNode ) { if ($self->{left} == $newNode) { $self->{prev}->{succ} = $newNode if $self->{prev}; $newNode->{succ} = $self; $newNode->{prev} = $self->{prev}; $self->{prev} = $newNode; } else { # $self->{right} == $newNode $self->{succ}->{prev} = $newNode if $self->{succ}; $newNode->{prev} = $self; $newNode->{succ} = $self->{succ}; $self->{succ} = $newNode; } } return 1; } sub _tree_successor { my $self = shift; my ($key) = @_; # Return a leaf if tree is empty. return $self if $self -> is_empty (); return $key ? $self->_tree_fetch($key)->{succ} : $self->{succ}; } sub _tree_predecessor ($$) { my $self = shift; my ($key) = @_; my $pred; # Return a leaf if tree is empty. return $self if $self -> is_empty (); return $key ? $self->_tree_fetch($key)->{prev} : $self->{prev}; } sub CMP { shift; (shift) cmp (shift) } 1;