Permalink
Browse files

Enfilade (very WIP, to refactor)

this will build on RedBlackFP, which is still pending BinaryFP base role changes,
checking in in very rough state, just for reference.
  • Loading branch information...
Hakim Cassimally
Hakim Cassimally committed May 29, 2011
1 parent 1722290 commit ca0a5bcc0085d4b77c0fd01f1223c88140a3240f
@@ -0,0 +1,50 @@
+package Tree::Enfilade;
+use Moose;
+use Data::Dumper;
+
+has colour => (
+ isa => 'Int',
+ is => 'ro',
+ default => 0,
+);
+
+has disp => (
+ isa => 'Int',
+ is => 'ro',
+ default => 0,
+);
+
+use constant width => 0;
+use constant total_width => 0;
+
+{
+ my $empty;
+ sub empty {
+ $empty //= __PACKAGE__->new()
+ }
+}
+
+# default methods (for Empty)
+sub member { return }
+sub compare { return }
+
+sub insert {
+ my ($self, $data) = @_;
+ my $result = $self->_insert($data);
+ return $result->new( %$result, colour => 0 );
+}
+sub _insert {
+ my ($self, $data) = @_;
+ require Tree::Enfilade::Node;
+ my $result = Tree::Enfilade::Node->new({
+ data => $data,
+ colour => 1,
+ });
+
+ return $result;
+}
+
+sub debug_tree { '' }
+sub leaves { () }
+
+no Moose; __PACKAGE__->meta->make_immutable; 1;
@@ -0,0 +1,160 @@
+package Tree::Enfilade::Node;
+use Moose;
+
+extends 'Tree::Enfilade';
+
+has left => (
+ is => 'ro',
+ isa => 'Tree::Enfilade',
+ default => sub { shift->empty },
+);
+has right => (
+ is => 'ro',
+ isa => 'Tree::Enfilade',
+ default => sub { shift->empty },
+);
+
+has data => ( is => 'ro', isa => 'Str' );
+
+sub width {
+ my $self = shift;
+ return length $self->data;
+}
+sub total_width {
+ my $self = shift;
+
+ return $self->width
+ + $self->left->total_width
+ + $self->right->total_width;
+}
+
+sub descend {
+ my ($self, $dir) = @_;
+ return $self->left if $dir eq 'L';
+ return $self->right if $dir eq 'R';
+ die "Bad direction '$dir'";
+}
+
+sub _insert {
+ my ($self, $data) = @_;
+
+ my $cmp = $self->compare($data)
+ or return $self;
+
+ my $left = $cmp < 0 ? $self->left ->_insert($data) : $self->left;
+ my $right = $cmp > 0 ? $self->right->_insert($data) : $self->right;
+
+ my $result = $self->new(
+ data => $self->data,
+ colour => $self->colour,
+ disp => $left->total_width,
+ )->balance;
+
+ return $result;
+}
+
+sub balance {
+ my ($self) = @_;
+
+ if (! $self->colour) {
+ # if we are black
+
+ TRY: for my $try (qw/ LL LR RL RR /) {
+ my @path;
+ my $root = $self;
+
+ for my $dir (split //, $try) {
+ my $node = $root->descend($dir);
+ next TRY unless $node->colour;
+
+ push @path, {
+ root => $root,
+ node => $node,
+ dir => $dir,
+ };
+ $root = $node;
+ }
+
+ my $grandchild = $path[-1];
+ my $gc_node = $grandchild->{node};
+
+ my @abcd = ($gc_node->left, $gc_node->right);
+ my @xyz = ($gc_node);
+
+ for my $path (reverse @path) {
+ my $dir = $path->{dir};
+ my $root = $path->{root};
+
+ if ($dir eq 'L') {
+ push @xyz, $root;
+ push @abcd, $root->right;
+ }
+ else {
+ unshift @xyz, $root;
+ unshift @abcd, $root->left;
+ }
+ }
+
+ my ($x, $y, $z) = @xyz;
+ my ($A, $B, $C, $D) = @abcd;
+
+ return $self->new(
+ data => $y->data,
+ colour => 1,
+ left => $self->new(
+ data => $x->data,
+ left => $A, right => $B,
+ colour => 0,
+ ),
+ right => $self->new(
+ data => $z->data,
+ left => $C, right => $D,
+ colour => 0,
+ ),
+ );
+ }
+ }
+ return $self;
+}
+
+sub compare {
+ my ($self, $pos) = @_;
+ return -1 if $pos < $
+ return $data cmp $self->data;
+}
+
+sub member {
+ my ($self, $data) = @_;
+
+ my $cmp = $self->compare($data)
+ or return 1;
+
+ return $cmp > 0 ?
+ $self->right->member($data)
+ : $self->left ->member($data);
+}
+
+sub debug_tree {
+ my ($self, $level) = @_;
+ $level ||= 0;
+ my $padding = ' ' x $level;
+
+ my $left = $self->left ->debug_tree($level+1);
+ my $right = $self->right->debug_tree($level+1);
+
+ my $data = $self->data . ' (' . ($self->colour ? 'R' : 'B') . ')';
+ $data = $data ? "$data\n" : '';
+
+ return $left . $padding . $data . $right;
+}
+
+sub leaves {
+ my ($self) = @_;
+ return (
+ $self->left->leaves,
+ $self->data,
+ $self->right->leaves,
+ );
+}
+
+no Moose; __PACKAGE__->meta->make_immutable; 1;

0 comments on commit ca0a5bc

Please sign in to comment.