4fb45bdbdc714dd55e99e11baf31c991c522f278
[gitmo/Class-MOP.git] / t / lib / BinaryTree.pm
1
2 package BinaryTree;
3
4 use strict;
5 use warnings;
6
7 use metaclass;
8
9 our $VERSION = '0.02';
10
11 BinaryTree->meta->add_attribute('$:uid' => (
12     reader  => 'getUID',
13     writer  => 'setUID',
14     default => sub { 
15         my $instance = shift;
16         ("$instance" =~ /\((.*?)\)$/);
17     }
18 ));
19
20 BinaryTree->meta->add_attribute('$:node' => (
21     reader   => 'getNodeValue',
22     writer   => 'setNodeValue',
23     init_arg => ':node'
24 ));
25
26 BinaryTree->meta->add_attribute('$:parent' => (
27     predicate => 'hasParent',
28     reader    => 'getParent',
29     writer    => 'setParent'
30 ));
31
32 BinaryTree->meta->add_attribute('$:left' => (
33     predicate => 'hasLeft',         
34     reader    => 'getLeft',
35     writer => { 
36         'setLeft' => sub {
37             my ($self, $tree) = @_;
38                 $tree->setParent($self) if defined $tree;
39             $self->{'$:left'} = $tree;    
40             $self;                    
41         }
42    },
43 ));
44
45 BinaryTree->meta->add_attribute('$:right' => (
46     predicate => 'hasRight',           
47     reader    => 'getRight',
48     writer => {
49         'setRight' => sub {
50             my ($self, $tree) = @_;   
51                 $tree->setParent($self) if defined $tree;
52             $self->{'$:right'} = $tree;      
53             $self;                    
54         }
55     }
56 ));
57
58 sub new {
59     my $class = shift;
60     $class->meta->new_object(':node' => shift);            
61 }    
62         
63 sub removeLeft {
64     my ($self) = @_;
65     my $left = $self->getLeft();
66     $left->setParent(undef);   
67     $self->setLeft(undef);     
68     return $left;
69 }
70
71 sub removeRight {
72     my ($self) = @_;
73     my $right = $self->getRight;
74     $right->setParent(undef);   
75     $self->setRight(undef);    
76     return $right;
77 }
78              
79 sub isLeaf {
80         my ($self) = @_;
81         return (!$self->hasLeft && !$self->hasRight);
82 }
83
84 sub isRoot {
85         my ($self) = @_;
86         return !$self->hasParent;                    
87 }
88      
89 sub traverse {
90         my ($self, $func) = @_;
91     $func->($self);
92     $self->getLeft->traverse($func)  if $self->hasLeft;    
93     $self->getRight->traverse($func) if $self->hasRight;
94 }
95
96 sub mirror {
97     my ($self) = @_;
98     # swap left for right
99     my $left = $self->getLeft;
100     $self->setLeft($self->getRight());
101     $self->setRight($left);
102     # and recurse
103     $self->getLeft->mirror()  if $self->hasLeft();
104     $self->getRight->mirror() if $self->hasRight();
105     $self;
106 }
107
108 sub size {
109     my ($self) = @_;
110     my $size = 1;
111     $size += $self->getLeft->size()  if $self->hasLeft();
112     $size += $self->getRight->size() if $self->hasRight();    
113     return $size;
114 }
115
116 sub height {
117     my ($self) = @_;
118     my ($left_height, $right_height) = (0, 0);
119     $left_height = $self->getLeft->height()   if $self->hasLeft();
120     $right_height = $self->getRight->height() if $self->hasRight();    
121     return 1 + (($left_height > $right_height) ? $left_height : $right_height);
122 }                      
123
124 1;