[gitmo/Class-MOP.git] / t / 100_BinaryTree_test.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 68;

BEGIN { 
    use_ok('Class::MOP');    
    use_ok('t::lib::BinaryTree');
}

## ----------------------------------------------------------------------------
## These are all tests which are derived from the Tree::Binary test suite
## ----------------------------------------------------------------------------

## ----------------------------------------------------------------------------
## t/10_Tree_Binary_test.t

can_ok("BinaryTree", 'new');
can_ok("BinaryTree", 'setLeft');
can_ok("BinaryTree", 'setRight');

my $btree = BinaryTree->new("/")
                        ->setLeft(
                            BinaryTree->new("+")
                                        ->setLeft(
                                            BinaryTree->new("2")
                                        )
                                        ->setRight(
                                            BinaryTree->new("2")
                                        )
                        )
                        ->setRight(
                            BinaryTree->new("*")
                                        ->setLeft(
                                            BinaryTree->new("4")
                                        )
                                        ->setRight(
                                            BinaryTree->new("5")
                                        )
                        );
isa_ok($btree, 'BinaryTree');

## informational methods

can_ok($btree, 'isRoot');
ok($btree->isRoot(), '... this is the root');

can_ok($btree, 'isLeaf');
ok(!$btree->isLeaf(), '... this is not a leaf node');
ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');

can_ok($btree, 'hasLeft');
ok($btree->hasLeft(), '... this has a left node');

can_ok($btree, 'hasRight');
ok($btree->hasRight(), '... this has a right node');

## accessors

can_ok($btree, 'getUID');

{
    my $UID = $btree->getUID();
    is(("$btree" =~ /\((.*?)\)$/), $UID, '... our UID is derived from the stringified object');
}

can_ok($btree, 'getNodeValue');
is($btree->getNodeValue(), '/', '... got what we expected');

{
    can_ok($btree, 'getLeft');
    my $left = $btree->getLeft();
    
    isa_ok($left, 'BinaryTree');
    
    is($left->getNodeValue(), '+', '... got what we expected');
    
    can_ok($left, 'getParent');    
    
    my $parent = $left->getParent();
    isa_ok($parent, 'BinaryTree');
    
    is($parent, $btree, '.. got what we expected');    
}

{
    can_ok($btree, 'getRight');
    my $right = $btree->getRight();
    
    isa_ok($right, 'BinaryTree');
    
    is($right->getNodeValue(), '*', '... got what we expected');

    can_ok($right, 'getParent');
    
    my $parent = $right->getParent();
    isa_ok($parent, 'BinaryTree');
    
    is($parent, $btree, '.. got what we expected');    
}

## mutators

can_ok($btree, 'setUID');
$btree->setUID("Our UID for this tree");

is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');

can_ok($btree, 'setNodeValue');
$btree->setNodeValue('*');

is($btree->getNodeValue(), '*', '... got what we expected');


{
    can_ok($btree, 'removeLeft');
    my $left = $btree->removeLeft();
    isa_ok($left, 'BinaryTree');
    
    ok(!$btree->hasLeft(), '... we dont have a left node anymore');
    ok(!$btree->isLeaf(), '... and we are not a leaf node');
     
    $btree->setLeft($left);
    
    ok($btree->hasLeft(), '... we have our left node again');  
    is($btree->getLeft(), $left, '... and it is what we told it to be');
}

{
    # remove left leaf
    my $left_leaf = $btree->getLeft()->removeLeft();
    isa_ok($left_leaf, 'BinaryTree');
    
    ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
    
    ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
    
    $btree->getLeft()->setLeft($left_leaf);
    
    ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');  
    is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
}

{
    can_ok($btree, 'removeRight');
    my $right = $btree->removeRight();
    isa_ok($right, 'BinaryTree');
    
    ok(!$btree->hasRight(), '... we dont have a right node anymore');
    ok(!$btree->isLeaf(), '... and we are not a leaf node');    
    
    $btree->setRight($right);
    
    ok($btree->hasRight(), '... we have our right node again');  
    is($btree->getRight(), $right, '... and it is what we told it to be')  
}

{
    # remove right leaf
    my $right_leaf = $btree->getRight()->removeRight();
    isa_ok($right_leaf, 'BinaryTree');
    
    ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
    
    ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
    
    $btree->getRight()->setRight($right_leaf);
    
    ok($btree->getRight()->hasRight(), '... we have our right leaf node again');  
    is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
}

# some of the recursive informational methods

{

    my $btree = BinaryTree->new("o")
                            ->setLeft(
                                BinaryTree->new("o")
                                    ->setLeft(
                                        BinaryTree->new("o")
                                    )
                                    ->setRight(
                                        BinaryTree->new("o")
                                            ->setLeft(
                                                BinaryTree->new("o")
                                                    ->setLeft(
                                                        BinaryTree->new("o")
                                                            ->setRight(BinaryTree->new("o"))
                                                    )
                                            )
                                    )
                            )
                            ->setRight(
                                BinaryTree->new("o")
                                            ->setLeft(
                                                BinaryTree->new("o")
                                                    ->setRight(
                                                        BinaryTree->new("o")
                                                            ->setLeft(
                                                                BinaryTree->new("o")
                                                            )
                                                            ->setRight(
                                                                BinaryTree->new("o")
                                                            )
                                                    )
                                            )
                                            ->setRight(
                                                BinaryTree->new("o")
                                                    ->setRight(BinaryTree->new("o"))
                                            )
                            );
    isa_ok($btree, 'BinaryTree');
    
    can_ok($btree, 'size');
    cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
    
    can_ok($btree, 'height');
    cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');

}

## ----------------------------------------------------------------------------
## t/13_Tree_Binary_mirror_test.t

sub inOrderTraverse {
    my $tree = shift;
    my @results;
    my $_inOrderTraverse = sub {
        my ($tree, $traversal_function) = @_;
        $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();  
        push @results => $tree->getNodeValue();   
        $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
    };
    $_inOrderTraverse->($tree, $_inOrderTraverse);
    @results;
}

# test it on a simple well balanaced tree
{
    my $btree = BinaryTree->new(4)
                    ->setLeft(
                        BinaryTree->new(2)
                            ->setLeft(
                                BinaryTree->new(1)	
                                )
                            ->setRight(
                                BinaryTree->new(3)
                                )
                        )
                    ->setRight(
                        BinaryTree->new(6)
                            ->setLeft(
                                BinaryTree->new(5)	
                                )
                            ->setRight(
                                BinaryTree->new(7)
                                )
                        );
    isa_ok($btree, 'BinaryTree');
    
    is_deeply(
        [ inOrderTraverse($btree) ],
        [ 1 .. 7 ],
        '... check that our tree starts out correctly');
    
    can_ok($btree, 'mirror');
    $btree->mirror();
    
    is_deeply(
        [ inOrderTraverse($btree) ],
        [ reverse(1 .. 7) ],
        '... check that our tree ends up correctly');
}

# test is on a more chaotic tree
{
    my $btree = BinaryTree->new(4)
                    ->setLeft(
                        BinaryTree->new(20)
                            ->setLeft(
                                BinaryTree->new(1)
                                        ->setRight(
                                            BinaryTree->new(10)  
                                                ->setLeft(
                                                    BinaryTree->new(5)                                        
                                                )                                                                                  
                                        )
                                )
                            ->setRight(
                                BinaryTree->new(3)
                                )
                        )
                    ->setRight(
                        BinaryTree->new(6)
                            ->setLeft(
                                BinaryTree->new(5)	
                                    ->setRight(
                                        BinaryTree->new(7)
                                            ->setLeft(
                                                BinaryTree->new(90)
                                            )  
                                            ->setRight(
                                                BinaryTree->new(91)
                                            )                                                                                    
                                        )                                
                                )
                        );
    isa_ok($btree, 'BinaryTree');
    
    my @results = inOrderTraverse($btree);
    
    $btree->mirror();
    
    is_deeply(
        [ inOrderTraverse($btree) ],
        [ reverse(@results) ],
        '... this should be the reverse of the original');
}
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
c50c603e	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