t/001_cmop/lib/BinaryTree.pm

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