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