t/100_BinaryTree_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 68;
   7
   8 BEGIN {
   9     use_ok('Class::MOP');
  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