Perl 閉包模擬類實現二叉樹

在上一篇文章中用函數方式實現了一個二叉樹，本篇用閉包模擬類的方式來重新實現，不同於傳統意義的Perl 類，否則也不用去費力重新實現，本篇用閉包來模擬類的一些行爲，以消息傳遞的方式調用方法。

功能同上一個版本的基本一樣，是用閉包的好處：

1。 模擬類行爲，開放類方法

2。 內部變量不可直接修改，只能通過方法調用獲取或修改值

3。 消息類型多樣，自己可以隨便控制

特點：

1。 每次取得一個節點（增加，刪除，修改）都是一個閉包Node 的返回，可以看作對應的類實例，可通過進一步調用來獲取相應的值

2。 只有兩個模擬類，Node and BNSTree，通篇都是通過這兩個閉包類來進行操作

附代碼以及編寫過程中的一些註釋：

use strict;
use warnings;
use Data::Dumper;

sub Node {
    my $_node = { left => undef, right => undef, key => undef, parent => undef };

    # set multiple value at same time
    my %params = @_;
    map { $_node->{$_} = $params{$_} if defined $params{$_} } keys %$_node;

    # set or get value for each item
    return sub {
        my ( $msg, $value ) = @_;
        if ( exists $_node->{$msg} ) {
            defined $value ? $_node->{$msg} = $value : $_node->{$msg};
        }
        # because cannot set one of attribute of _node to undef, so add one method delete to set to undef
        elsif ( $msg eq 'delete' && $value ) {
            $_node->{$value} = undef;
        }
        else {
            die "Undefined key: $msg";
        }
    }
}

sub BNSTree {
    my $root = undef;

    my $empty = sub {
        return !$root;
    };

    #this is original version for insert, logic is clear but code is too much
    my $insert_old = sub {
        my ($value) = @_;
        if ( $empty->() ) {
            my $node = Node( key => $value );
            return $root = $node;
        }

        my $tmp = $root;
        while ( $value != $tmp->('key') ) {
            if ( $value < $tmp->('key') && $tmp->('left') ) {
                $tmp = $tmp->('left');
            }
            elsif ( $value > $tmp->('key') && $tmp->('right') ) {
                $tmp = $tmp->('right');
            }
            else {
                last;
            }
        }

        if ( $value < $tmp->('key') ) {
            my $node = Node( key => $value, parent => $tmp );
            return $tmp->( left => $node );
        }
        elsif ( $value > $tmp->('key') ) {
            my $node = Node( key => $value, parent => $tmp );
            return $tmp->( right => $node );
        }
        else {
            return $tmp;
        }
    };

    #this is optimized version for insert, almost 1/2 less code than previous and tight
    my $insert = sub {
        my ($value) = @_;
        return $root = Node( key => $value ) if $empty->();

        my $tmp = $root;
        while ( $value != $tmp->('key') ) {
            if ( $value < $tmp->('key') ) {
                $tmp->('left')
                  ? $tmp = $tmp->('left')
                  : return $tmp->( left => Node( key => $value, parent => $tmp ) );
            }
            elsif ( $value > $tmp->('key') ) {
                $tmp->('right')
                  ? $tmp = $tmp->('right')
                  : return $tmp->( right => Node( key => $value, parent => $tmp ) );
            }
            #~ else{ last; }
        }
        return $tmp;
    };

    my $min_max = sub {
        #~ my ($msg) = @_;
        #~ return if $empty->();

        #~ my $tmp = $root;
        #~ while($tmp->($msg)){
        #~ $tmp = $tmp->($msg);
        #~ }
        #~ return $tmp;

        #previous version work for the whole tree, but successor need it, so modify it that can be used by sub-tree min max
        my ( $msg, $tmp_root ) = @_;
        return if !$tmp_root;

        while ( $tmp_root->($msg) ) {
            $tmp_root = $tmp_root->($msg);
        }
        return $tmp_root;
    };

    my $search = sub {
        my ($value) = @_;
        return if $empty->();

        my $tmp = $root;
        while ( $value != $tmp->('key') ) {
            if ( $value < $tmp->('key') ) {
                $tmp->('left') ? $tmp = $tmp->('left') : return;
            }
            elsif ( $value > $tmp->('key') ) {
                $tmp->('right') ? $tmp = $tmp->('right') : return;
            }
            else { last; }
        }
        return $tmp;
    };

    my $successor = sub {
        my ($value) = @_;

        #~ return undef if $empty->();
        my $search_item = $search->($value);
        return if !$search_item;

        if ( $search_item->('right') ) {
       #~ my $tmp = $search_item->('right');
       #~ while($tmp->('left')){
       #~ $tmp = $tmp->('left');
       #~ }
       #~ return $tmp;
       # previous version need expend min function, so modify it use subtree min
            return $min_max->( 'left', $search_item->('right') );
        }

        my $tmp = $search_item;
        while ($tmp->('parent')
            && $tmp->('parent')->('right')
            && $tmp->('parent')->('right') == $tmp )
        {
            $tmp = $tmp->('parent');
        }
        return $tmp->('parent');
    };

    my $predecessor = sub {
        my ($value) = @_;

        #~ return undef if $empty->();
        my $search_item = $search->($value);
        return undef if !$search_item;

        if ( $search_item->('left') ) {
       #~ my $tmp = $search_item->('right');
       #~ while($tmp->('left')){
       #~ $tmp = $tmp->('left');
       #~ }
       #~ return $tmp;
       # previous version need expend min function, so modify it use subtree min
            return $min_max->( 'right', $search_item->('left') );
        }

        my $tmp = $search_item;
        while ($tmp->('parent')
            && $tmp->('parent')->('left')
            && $tmp->('parent')->('left') == $tmp )
        {
            $tmp = $tmp->('parent');
        }
        return $tmp->('parent');
    };

    #go through from upper level to lower level
    my $level_order = sub {
        return if $empty->();

        #~ my $tmp = $root;
        my @stack = ($root);
        while (@stack) {
            my $tmp = shift @stack;
            print $tmp->('key'), ' ';
            push @stack, $tmp->('left')  if $tmp->('left');
            push @stack, $tmp->('right') if $tmp->('right');
        }
    };

    my $in_order = sub {
        return if $empty->();

        my $tmp   = $root;
        my @stack = ();
        while ( $tmp || @stack ) {
            if ($tmp) {
                print $tmp->('key'), ' ';
                push @stack, $tmp;
                $tmp = $tmp->('left');
            }
            else {
                $tmp = pop @stack;

                #~ print $tmp->('key'),' ';
                $tmp = $tmp->('right');
            }
        }
    };

    my $pre_order = sub {
        return if $empty->();

        my $tmp   = $root;
        my @stack = ();
        while ( $tmp || @stack ) {
            if ($tmp) {
                push @stack, $tmp;
                $tmp = $tmp->('left');
            }
            else {
                $tmp = pop @stack;
                print $tmp->('key'), ' ';
                $tmp = $tmp->('right');
            }
        }
    };

    my $suc_order = sub {
        return if $empty->();

        my $tmp   = $root;
        my @stack = ();
        while ( $tmp || @stack ) {
            if ($tmp) {
                push @stack, $tmp;
                $tmp = $tmp->('right');
            }
            else {
                $tmp = pop @stack;
                print $tmp->('key'), ' ';
                $tmp = $tmp->('left');
            }
        }
    };

    my $internal_delete = sub {
        my ($node) = @_;

        if ( $node->('parent') ) {
            my $pchild =
              $node->('parent')->('key') > $node->('key') ? 'left' : 'right';
            if ( !$node->('left') && !$node->('right') ) {
                $node->('parent')->( delete => $pchild );
            }
            elsif ( !$node->('left') || !$node->('right') ) {
                my $child = $node->('left') ? 'left' : 'right';

                $node->('parent')->( $pchild => $node->($child) );
                $node->($child)->( parent => $node->('parent') );
            }
        }
        else {
            if ( !$node->('left') && !$node->('right') ) {
                $root = undef;
            }
            elsif ( !$node->('left') || !$node->('right') ) {
                my $child = $node->('left') ? 'left' : 'right';

                $root = $node->($child);
                $node->($child)->( delete => 'parent' );
            }
        }
    };

    my $delete = sub {
        my ($value) = @_;
        my $tmp = $search->($value);

        if ( !$tmp ) {
            return;
        }
        elsif ( !$tmp->('left') || !$tmp->('right') ) {
            $internal_delete->($tmp);
        }
        else {
            my $suc = $successor->($value);
            $internal_delete->($suc);
            $tmp->( 'key', $suc->('key') );
        }
    };

    #initial binary search tree with more values
    for (@_) {
        $insert->($_);
    }

    return sub {
        my ( $msg, $value ) = @_;
        if ( $msg eq 'empty' ) {
            $empty->();
        }
        elsif ( $msg eq 'insert' ) {
            $insert->($value);
        }
        elsif ( $msg eq 'min' ) {
            $min_max->( 'left', $root );
        }
        elsif ( $msg eq 'max' ) {
            $min_max->( 'right', $root );
        }
        elsif ( $msg eq 'search' ) {
            $search->($value);
        }
        elsif ( $msg eq 'successor' ) {
            $successor->($value);
        }
        elsif ( $msg eq 'predecessor' ) {
            $predecessor->($value);
        }
        elsif ( $msg eq 'print' && $value && $value eq 'pre' ) {
            $pre_order->();
        }
        elsif ( $msg eq 'print' && $value && $value eq 'suc' ) {
            $suc_order->();
        }
        elsif ( $msg eq 'print' ) {
            $in_order->();
        }
        elsif ( $msg eq 'delete' ) {
            $delete->($value);
        }
    }
}

my $a = BNSTree(qw(14  20 18 21 7 ));

$a->( 'delete', 14 );
$a->( parent => undef );
$a->('print');
print "\n";
$a->( 'print', 'pre' );
print "\n";
$a->( 'print', 'suc' );
print "\n";