t/lib/BinaryTree.pm

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