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