t/lib/BinaryTree.pm

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