Commit | Line | Data |
c50c603e |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
727919c5 |
6 | use Test::More tests => 68; |
c50c603e |
7 | |
8 | BEGIN { |
727919c5 |
9 | use_ok('Class::MOP'); |
c50c603e |
10 | use_ok('t::lib::BinaryTree'); |
11 | } |
12 | |
13 | ## ---------------------------------------------------------------------------- |
14 | ## These are all tests which are derived from the Tree::Binary test suite |
15 | ## ---------------------------------------------------------------------------- |
16 | |
17 | ## ---------------------------------------------------------------------------- |
18 | ## t/10_Tree_Binary_test.t |
19 | |
20 | can_ok("BinaryTree", 'new'); |
21 | can_ok("BinaryTree", 'setLeft'); |
22 | can_ok("BinaryTree", 'setRight'); |
23 | |
24 | my $btree = BinaryTree->new("/") |
25 | ->setLeft( |
26 | BinaryTree->new("+") |
27 | ->setLeft( |
28 | BinaryTree->new("2") |
29 | ) |
30 | ->setRight( |
31 | BinaryTree->new("2") |
32 | ) |
33 | ) |
34 | ->setRight( |
35 | BinaryTree->new("*") |
36 | ->setLeft( |
37 | BinaryTree->new("4") |
38 | ) |
39 | ->setRight( |
40 | BinaryTree->new("5") |
41 | ) |
42 | ); |
43 | isa_ok($btree, 'BinaryTree'); |
44 | |
45 | ## informational methods |
46 | |
47 | can_ok($btree, 'isRoot'); |
48 | ok($btree->isRoot(), '... this is the root'); |
49 | |
50 | can_ok($btree, 'isLeaf'); |
51 | ok(!$btree->isLeaf(), '... this is not a leaf node'); |
52 | ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node'); |
53 | |
54 | can_ok($btree, 'hasLeft'); |
55 | ok($btree->hasLeft(), '... this has a left node'); |
56 | |
57 | can_ok($btree, 'hasRight'); |
58 | ok($btree->hasRight(), '... this has a right node'); |
59 | |
60 | ## accessors |
61 | |
62 | can_ok($btree, 'getUID'); |
63 | |
64 | { |
65 | my $UID = $btree->getUID(); |
66 | is(("$btree" =~ /\((.*?)\)$/), $UID, '... our UID is derived from the stringified object'); |
67 | } |
68 | |
69 | can_ok($btree, 'getNodeValue'); |
70 | is($btree->getNodeValue(), '/', '... got what we expected'); |
71 | |
72 | { |
73 | can_ok($btree, 'getLeft'); |
74 | my $left = $btree->getLeft(); |
75 | |
76 | isa_ok($left, 'BinaryTree'); |
77 | |
78 | is($left->getNodeValue(), '+', '... got what we expected'); |
79 | |
80 | can_ok($left, 'getParent'); |
81 | |
82 | my $parent = $left->getParent(); |
83 | isa_ok($parent, 'BinaryTree'); |
84 | |
85 | is($parent, $btree, '.. got what we expected'); |
86 | } |
87 | |
88 | { |
89 | can_ok($btree, 'getRight'); |
90 | my $right = $btree->getRight(); |
91 | |
92 | isa_ok($right, 'BinaryTree'); |
93 | |
94 | is($right->getNodeValue(), '*', '... got what we expected'); |
95 | |
96 | can_ok($right, 'getParent'); |
97 | |
98 | my $parent = $right->getParent(); |
99 | isa_ok($parent, 'BinaryTree'); |
100 | |
101 | is($parent, $btree, '.. got what we expected'); |
102 | } |
103 | |
104 | ## mutators |
105 | |
106 | can_ok($btree, 'setUID'); |
107 | $btree->setUID("Our UID for this tree"); |
108 | |
109 | is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected'); |
110 | |
111 | can_ok($btree, 'setNodeValue'); |
112 | $btree->setNodeValue('*'); |
113 | |
114 | is($btree->getNodeValue(), '*', '... got what we expected'); |
115 | |
116 | |
117 | { |
118 | can_ok($btree, 'removeLeft'); |
119 | my $left = $btree->removeLeft(); |
120 | isa_ok($left, 'BinaryTree'); |
121 | |
122 | ok(!$btree->hasLeft(), '... we dont have a left node anymore'); |
123 | ok(!$btree->isLeaf(), '... and we are not a leaf node'); |
124 | |
125 | $btree->setLeft($left); |
126 | |
127 | ok($btree->hasLeft(), '... we have our left node again'); |
128 | is($btree->getLeft(), $left, '... and it is what we told it to be'); |
129 | } |
130 | |
131 | { |
132 | # remove left leaf |
133 | my $left_leaf = $btree->getLeft()->removeLeft(); |
134 | isa_ok($left_leaf, 'BinaryTree'); |
135 | |
136 | ok($left_leaf->isLeaf(), '... our left leaf is a leaf'); |
137 | |
138 | ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore'); |
139 | |
140 | $btree->getLeft()->setLeft($left_leaf); |
141 | |
142 | ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again'); |
143 | is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be'); |
144 | } |
145 | |
146 | { |
147 | can_ok($btree, 'removeRight'); |
148 | my $right = $btree->removeRight(); |
149 | isa_ok($right, 'BinaryTree'); |
150 | |
151 | ok(!$btree->hasRight(), '... we dont have a right node anymore'); |
152 | ok(!$btree->isLeaf(), '... and we are not a leaf node'); |
153 | |
154 | $btree->setRight($right); |
155 | |
156 | ok($btree->hasRight(), '... we have our right node again'); |
157 | is($btree->getRight(), $right, '... and it is what we told it to be') |
158 | } |
159 | |
160 | { |
161 | # remove right leaf |
162 | my $right_leaf = $btree->getRight()->removeRight(); |
163 | isa_ok($right_leaf, 'BinaryTree'); |
164 | |
165 | ok($right_leaf->isLeaf(), '... our right leaf is a leaf'); |
166 | |
167 | ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore'); |
168 | |
169 | $btree->getRight()->setRight($right_leaf); |
170 | |
171 | ok($btree->getRight()->hasRight(), '... we have our right leaf node again'); |
172 | is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be'); |
173 | } |
174 | |
175 | # some of the recursive informational methods |
176 | |
177 | { |
178 | |
179 | my $btree = BinaryTree->new("o") |
180 | ->setLeft( |
181 | BinaryTree->new("o") |
182 | ->setLeft( |
183 | BinaryTree->new("o") |
184 | ) |
185 | ->setRight( |
186 | BinaryTree->new("o") |
187 | ->setLeft( |
188 | BinaryTree->new("o") |
189 | ->setLeft( |
190 | BinaryTree->new("o") |
191 | ->setRight(BinaryTree->new("o")) |
192 | ) |
193 | ) |
194 | ) |
195 | ) |
196 | ->setRight( |
197 | BinaryTree->new("o") |
198 | ->setLeft( |
199 | BinaryTree->new("o") |
200 | ->setRight( |
201 | BinaryTree->new("o") |
202 | ->setLeft( |
203 | BinaryTree->new("o") |
204 | ) |
205 | ->setRight( |
206 | BinaryTree->new("o") |
207 | ) |
208 | ) |
209 | ) |
210 | ->setRight( |
211 | BinaryTree->new("o") |
212 | ->setRight(BinaryTree->new("o")) |
213 | ) |
214 | ); |
215 | isa_ok($btree, 'BinaryTree'); |
216 | |
217 | can_ok($btree, 'size'); |
218 | cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree'); |
219 | |
220 | can_ok($btree, 'height'); |
221 | cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall'); |
222 | |
223 | } |
224 | |
225 | ## ---------------------------------------------------------------------------- |
226 | ## t/13_Tree_Binary_mirror_test.t |
227 | |
228 | sub inOrderTraverse { |
229 | my $tree = shift; |
230 | my @results; |
231 | my $_inOrderTraverse = sub { |
232 | my ($tree, $traversal_function) = @_; |
233 | $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft(); |
234 | push @results => $tree->getNodeValue(); |
235 | $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight(); |
236 | }; |
237 | $_inOrderTraverse->($tree, $_inOrderTraverse); |
238 | @results; |
239 | } |
240 | |
241 | # test it on a simple well balanaced tree |
242 | { |
243 | my $btree = BinaryTree->new(4) |
244 | ->setLeft( |
245 | BinaryTree->new(2) |
246 | ->setLeft( |
247 | BinaryTree->new(1) |
248 | ) |
249 | ->setRight( |
250 | BinaryTree->new(3) |
251 | ) |
252 | ) |
253 | ->setRight( |
254 | BinaryTree->new(6) |
255 | ->setLeft( |
256 | BinaryTree->new(5) |
257 | ) |
258 | ->setRight( |
259 | BinaryTree->new(7) |
260 | ) |
261 | ); |
262 | isa_ok($btree, 'BinaryTree'); |
263 | |
264 | is_deeply( |
265 | [ inOrderTraverse($btree) ], |
266 | [ 1 .. 7 ], |
267 | '... check that our tree starts out correctly'); |
268 | |
269 | can_ok($btree, 'mirror'); |
270 | $btree->mirror(); |
271 | |
272 | is_deeply( |
273 | [ inOrderTraverse($btree) ], |
274 | [ reverse(1 .. 7) ], |
275 | '... check that our tree ends up correctly'); |
276 | } |
277 | |
278 | # test is on a more chaotic tree |
279 | { |
280 | my $btree = BinaryTree->new(4) |
281 | ->setLeft( |
282 | BinaryTree->new(20) |
283 | ->setLeft( |
284 | BinaryTree->new(1) |
285 | ->setRight( |
286 | BinaryTree->new(10) |
287 | ->setLeft( |
288 | BinaryTree->new(5) |
289 | ) |
290 | ) |
291 | ) |
292 | ->setRight( |
293 | BinaryTree->new(3) |
294 | ) |
295 | ) |
296 | ->setRight( |
297 | BinaryTree->new(6) |
298 | ->setLeft( |
299 | BinaryTree->new(5) |
300 | ->setRight( |
301 | BinaryTree->new(7) |
302 | ->setLeft( |
303 | BinaryTree->new(90) |
304 | ) |
305 | ->setRight( |
306 | BinaryTree->new(91) |
307 | ) |
308 | ) |
309 | ) |
310 | ); |
311 | isa_ok($btree, 'BinaryTree'); |
312 | |
313 | my @results = inOrderTraverse($btree); |
314 | |
315 | $btree->mirror(); |
316 | |
317 | is_deeply( |
318 | [ inOrderTraverse($btree) ], |
319 | [ reverse(@results) ], |
320 | '... this should be the reverse of the original'); |
321 | } |
322 | |