Perl 二叉搜索树

用Perl 的一般方式实现了一个完整的二叉搜索树，有如下功能：

1. 插入，删除，搜索

2. 最大，最小值

3. 某节点的前序节点，后序节点

整个过程中更改了好几次：

1. 增加了parent 属性，可以方便的找到父节点，有利于前序后序节点的查找。

2. 最初节点不是都有left right 属性，只有在有子节点的情况下才出现，后来为了统一所有节点都加上这些属性，没有子节点的情况下置为空undef。

3. 由于Perl 的限制，根节点用$root = { left => undef,right => undef,key => undef,parent => undef } 表示，如果使用$root = undef，则添加节点的时候会出错，所以只能使用一个引用来代替。

附代码：

#second version,advanced data structure with parent
use strict;
use warnings;
use Data::Dumper;

sub tree_empty {
    my ($tree) = @_;
    return !defined $tree->{key};
}

sub tree_insert {
    my ( $tree,$value ) = @_;

    if ( tree_empty($tree) ) {
        $tree->{key} = $value;
    }
    elsif ( $value < $tree->{key} ) {
        if ( $tree->{left} ) {
            tree_insert( $tree->{left},$value );
        }
        else {
            $tree->{left} = {
                left   => undef,right  => undef,key    => $value,parent => $tree,};
        }
    }
    elsif ( $value > $tree->{key} ) {
        if ( $tree->{right} ) {
            tree_insert( $tree->{right},$value );
        }
        else {
            $tree->{right} = {
                left   => undef,};
        }
    }
}

sub build_binary_search_tree {
    my $root = { left => undef,parent => undef };
    for (@_) {
        tree_insert( $root,$_ );
    }
    return $root;
}

sub tree_search {
    my ( $tree,$value ) = @_;

    if ( tree_empty($tree) ) {
        return;
    }
    elsif ( $value < $tree->{key} ) {
        tree_search( $tree->{left},$value );
    }
    elsif ( $value > $tree->{key} ) {
        tree_search( $tree->{right},$value );
    }
    else {
        return $tree;
    }
}

sub tree_min {
    my ($tree) = @_;

    if ( tree_empty($tree) ) {
        return;
    }
    elsif ( $tree->{left} ) {
        tree_min( $tree->{left} );
    }
    else {
        return $tree;
    }
}

sub tree_max {
    my ($tree) = @_;

    if ( tree_empty($tree) ) {
        return;
    }
    elsif ( $tree->{right} ) {
        tree_max( $tree->{right} );
    }
    else {
        return $tree;
    }
}

sub tree_parent {
    my ( $tree,$value ) = @_;

    my $tmp = tree_search( $tree,$value );
    $tmp ? return $tmp->{parent} : return;
}

sub tree_successor {
    my ( $tree,$value );

    if ( !$tmp ) {
        return;
    }
    elsif ( $tmp->{right} ) {
        return tree_min( $tmp->{right} );
    }
    else {
        while ( $tmp->{parent} && $tmp->{parent}->{right} == $tmp ) {
            $tmp = $tmp->{parent};
        }
        return $tmp->{parent};
    }
}

sub tree_predecessor {
    my ( $tree,$value );

    if ( !$tmp ) {
        return;
    }
    elsif ( $tmp->{left} ) {
        return tree_max( $tmp->{left} );
    }
    else {
        while ( $tmp->{parent} && $tmp->{parent}->{left} == $tmp ) {
            $tmp = $tmp->{parent};
        }
        return $tmp->{parent};
    }
}

sub tree_transplant {
    my ($tmp) = @_;

    #not root node
    if ( $tmp->{parent} ) {
        my $pchild = $tmp->{parent}->{key} > $tmp->{key} ? 'left' : 'right';
        #no child
        if ( !$tmp->{left} && !$tmp->{right} ) {
            $tmp->{parent}->{$pchild} = undef;
        }
        #one child,left or right
        elsif ( !$tmp->{left} || !$tmp->{right} ) {
            my $child = $tmp->{left} ? 'left' : 'right';
            
            $tmp->{parent}->{$pchild} = $tmp->{$child};
            $tmp->{$child}->{parent} = $tmp->{parent};
        }
    }
    #this is root node
    else {                                            
        if ( !$tmp->{left} && !$tmp->{right} ) {
            $tmp->{key} = undef;
        }
        elsif ( !$tmp->{left} || !$tmp->{right} ) {
            my $child = $tmp->{left} ? 'left' : 'right';
                        
            $tmp->{$child}->{left}
              ? $tmp->{$child}->{left}->{parent} = $tmp
              : undef;
            $tmp->{$child}->{right}
              ? $tmp->{$child}->{right}->{parent} = $tmp
              : undef;

            #~ if use this,then you should pay attention to squence,or you will get wrong result
            #~ for example,if you have a left child,you must set left value last
            #~ $tmp->{right} = $tmp->{left}->{right};
            #~ $tmp->{key}   = $tmp->{left}->{key};
            #~ $tmp->{left}  = $tmp->{left}->{left};
            @{$tmp}{qw(left key right)} = @{$tmp->{$child}}{qw(left key right)} ;
        }
    }
}

sub tree_delete {
    my ( $tree,$value );

    if ( !$tmp ) {
        return;
    }
    #no child or one child
    elsif ( !$tmp->{left} || !$tmp->{right} ) {
        tree_transplant($tmp);
    }
    #two child
    else {
        my $suc = tree_successor( $tree,$value );

        tree_transplant($suc);
        $tmp->{key} = $suc->{key};
    }
}

#~ my $tree = build_binary_search_tree(qw(8 3 10 1 6 4 7 14 13));
#~ print Dumper $tree;
#~ print Dumper tree_min($tree);
#~ print Dumper tree_max($tree);
#~ print Dumper tree_search($tree,6);
#~ print Dumper tree_parent($tree,6);
#~ print Dumper tree_predecessor($tree,10)->{key};
#~ print Dumper tree_successor($tree,10)->{key};
my $tree = build_binary_search_tree(qw(14  20 18 21 7));
tree_delete( $tree,14);
print Dumper $tree;