Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

recursive creation of attached objects?

by Anonymous Monk
on Sep 14, 2012 at 00:17 UTC ( #993605=perlquestion: print w/replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to make a binary tree object which uses a recursively called new() method to create a tree n nodes deep. The problem is that whenever i try to assign new nodes to the object branch variables from within the object methods it doesn't work, but whenever I assign a node to a branch outside of the object method functions, it works perfectly.

That's probably a bad explanation of the problem, but hopefully my code is self explanatory. For those of you who are going to point me to modules which implement a binary tree, I'm doing this as an excercise in preparation for a larger project involving complex objects and data structures, etc. Thanks for your help, this one's driving me mad.
package bin_tree; #create a new instance of the bin_tree object, taking #$depth as an ar +gument... Create a binary tree, #recursively calling new() in order to create a node with #the desired + depth. sub new{ $class=shift; $depth=shift; #pull the class values and the depth beneath the nod +e desired, 0 for no lower nodes $self={value,a,b}; #make our object as an anonymous hash with keyw +ords but no values yet, that way the a and b keys (our branches) defa +ult evaluate to null $self->{value}=0; print $self->{value},"\n"; #just a debugging statement to try to f +igure out whats going on while ($depth >= 1){ #if we need to get deep, recursively call the + new() method, assigning the created objects to our a and b branches $depth--; $self->{a} = bin_tree->new($depth); #problem is here... the ne +w binary tree node never gets returned $self->{b} = bin_tree->new($depth); print $self->{a},"\n"; #debugging statement, this still evalua +tes to null, even though it should be set as an object reference now } bless $self, $class; #make object return $self; #return object } #5 minute depth test function, recursively runs down the "a" side of a + binary tree, returns the depth eventually sub depth_test{ $self=shift; print $i++,"\n"; if (defined $self->{a}){ $depth=$self->{a}->depth_test(); } return $depth+1; } #try to create a three node deep binary tree $bintree = bin_tree->new(3); print "Before:",$bintree->{a},"\n"; $deep = $bintree->depth_test(); print "Depth:",$deep,"\n"; #prove that new() call is just creating the + first level node) $bintree->{a} = bin_tree->new(); $bintree->{a}->{a} = bin_tree->new(); print "After:",$bintree->{a},"\n"; $deep = $bintree->depth_test(); print "Depth:",$deep,"\n"; #prove that when the code is outside of the + object methods, i can use my technique to build a tree

Replies are listed 'Best First'.
Re: recursive creation of attached objects?
by chromatic (Archbishop) on Sep 14, 2012 at 00:22 UTC

    If those variables really aren't lexicals scoped to your constructor, you're definitely in for a world of hurt when things go recursive.

    Improve your skills with Modern Perl: the free book.

Re: recursive creation of attached objects?
by remiah (Hermit) on Sep 14, 2012 at 04:06 UTC


    You return nothing at recursive call. But, at first, you will see lots of warnings if you put use strict and use warnings for your code...

    It maybe like this.

    { package bin_tree; use strict; use warnings; sub new{ my $class=shift; my $self={value=>undef, a=>undef, b=>undef}; #make our object as a +n anonymous hash with keywords but no values yet, that way the a an $self->{value}=0; bless $self, $class; #make object return $self; #return object } sub populate{ my($self, $depth)=@_; return if(! $depth); $self->{a} = populate( bin_tree->new() , $depth -1 ); $self->{b} = populate( bin_tree->new() , $depth -1 ); return $self; } 1; } #end bin_tree package main; use strict; use warnings; #try to create a three node deep binary tree my $bintree = bin_tree->new(); $bintree->populate(3); use Data::Dumper; print Dumper $bintree;
    Moose has "Recipe 3" for Binary Tree. It is far more advanced.

      Added "depth_test" to your code, and added more lines to main code to make a more interesting structure.

      The "value" can track the origination of each node.

      use strict; use warnings; { package bin_tree; use strict; use warnings; sub new{ my $class=shift; my $self={value=>shift, a=>undef, b=>undef}; $self->{value}||=0; bless $self, $class; return $self; } sub a{ my ($self, $setval) = @_; $setval or return $self->{a}; return $self->{a} = $setval; } sub b{ my ($self, $setval) = @_; $setval or return $self->{b}; return $self->{b} = $setval; } sub populate{ my($self, $depth, $value)=@_; return if(! $depth); $value ||= $self->{value}; $self->a ( populate( bin_tree->new($value) , $depth -1 ) ); $self->b ( populate( bin_tree->new($value) , $depth -1 ) ); return $self; } sub depth{ my ($self, $level)=@_; $level ||= 1; if (defined $self->a()){ return $self->a()->depth($level + 1); } return $level; } 1; } #end bin_tree package main; my $bintree = bin_tree->new('Initial') -> populate(3); use Data::Dumper; print "BEFORE: " ,Dumper ($bintree),"Depth:",$bintree->depth() ,"\n"; $bintree->a()->a()->populate(2,'Firstlevel') -> b( bin_tree->new('sec +ondlevel')); print "After: ", Dumper ($bintree),"Depth:",$bintree->depth(), "\n";
      Update : Minor tweaks - added a() and b() methods. Renamed depth_test(). Changed test structure. populate() allows optional new 'value' param.

                   I hope life isn't a big joke, because I don't get it.

        Thanks for reply

        I learned I can put header to Dumper ouput with

        print "After:", Dumper $bintree,"\n";
        This is not trivial thing for me. This will help me a lot.

Re: recursive creation of attached objects?
by tobyink (Abbot) on Sep 14, 2012 at 08:52 UTC
    use 5.010; use strict; use warnings FATAL => 'all'; { package Tree; use MooseX::Role::Parameterized; use Moose::Util::TypeConstraints qw(union role_type); use Scalar::Does; use List::Util qw(max); parameter child_names => (isa => 'ArrayRef[Str]', required => 1); role { my @child_names = @{ shift->child_names }; # We allow each child to be undef, a string, or another Tree # Strings are arguably a bad idea. Instead we should create # Tree objects with a "payload". (See below.) has $_ => ( is => 'rw', trigger => sub { my ($self, $new, $old) = @_; $old->_clear_parent if does $old, 'Tree'; $new->_set_parent($self) if does $new, 'Tree'; }, isa => union(qw( Undef Str ), role_type('Tree')), ) for @child_names; has parent => ( does => 'Tree', reader => 'parent', writer => '_set_parent', clearer => '_clear_parent', predicate => 'has_parent', ); method mk_balanced => sub { my ($class, $depth) = @_; my $self = $class->new; return $self unless $depth; $self->children( map { $class->mk_balanced($depth - 1) } @child_names ); return $self; }; method is_orphan => sub { not shift->has_parent; }; method child_depth => sub { my $self = shift; return 1 + max map { does($_, 'Tree') ? $_->child_depth : (defined $_ + ? 0 : -1) } $self->children; }; method parent_height => sub { my $self = shift; return 0 if $self->is_orphan; return 1 + $self->parent->parent_height; }; method children => sub { my $self = shift; if (@_) { for (@child_names) { $self->$_(shift); } } return map { $self->$_ } @child_names; }; method has_children => sub { grep defined, shift->children; }; method to_string => sub { my $self = shift; return "(leaf node)" unless $self->has_children; my @child = map { does($_, 'Tree') ? $_->to_string : (defined $_ ? + qq("$_") : '(undef)') } $self->children; # indent by three spaces s/^/ /mg for @child; return join "\n", "(node)", @child; }; } } { package Tree::Binary; use Moose; with Tree => { child_names => [qw( a b )] }; } say "Make a balanced binary tree, 3 layers deep"; my $tree = Tree::Binary->mk_balanced(3); say "Tree depth is ", $tree->child_depth; say $tree->to_string; say "----"; say "Extend one of the leaf nodes"; $tree->b->a->a( Tree::Binary->mk_balanced(2) ); say "Tree depth is ", $tree->child_depth; say $tree->to_string; say "----"; say "Now let's try a ternary tree"; { package Tree::Ternary; use Moose; with Tree => { child_names => [qw( a b c )] }; } my $ternary = Tree::Ternary->mk_balanced(2); say "Tree depth is ", $ternary->child_depth; say $ternary->to_string; say "----"; say "Trees where each node has a payload."; { package Tree::Binary::WithString; use Moose; extends 'Tree::Binary'; has payload => (is => 'rw', isa => 'Str', required => 1); around to_string => sub { my ($orig, $self) = @_; my $string = $self->$orig; $string =~ s/\((.*node)\)/"($1 \"".$self->payload."\")"/e; return $string; }; } my $people = Tree::Binary::WithString->new(payload => 'People'); $people->children( Tree::Binary::WithString->new(payload => 'Men'), Tree::Binary::WithString->new(payload => 'Women'), ); say $people->to_string; say "----";

    updated to add example with payloads

    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
Re: recursive creation of attached objects?
by roboticus (Chancellor) on Sep 14, 2012 at 13:57 UTC

    You might play with this a bit:

    #!/usr/bin/perl use 5.14.0; use warnings; use autodie; use Data::Dumper; my $t = myTree::create_tree(5); print Dumper($t); package myTree; sub create_tree { my $depth = shift; my $object = { left =>$depth ? create_tree($depth-1) : undef, right=>$depth ? create_tree($depth-1) : undef }; return bless $object; }


    When your only tool is a hammer, all problems look like your thumb.

Re: recursive creation of attached objects?
by Marshall (Abbot) on Sep 14, 2012 at 04:18 UTC
    I'm trying to make a binary tree object which uses a recursively called new() method to create a tree n nodes deep

    I would think that the basic interface is wrong. "new" should create a "virgin" tree. There should be another method to add leaves to this tree $bin_tree->add_leaf(...), perhaps? I would not use the "new" method for this purpose.

Re: recursive creation of attached objects?
by sundialsvc4 (Abbot) on Sep 15, 2012 at 16:15 UTC

    Usually, I define the constructor to create an empty, pristine object in its default virginal state, and then I define a second method, say init(), or in this case maybe a property such as depth or a function set_depth(), which is called immediately thereafter.   Sometimes, several related objects are created, then their respective initialization-routines are called in some prescribed sequence.

    The main reason for this is that, once the constructor has finished, whatever variable you are using to store the location of the object in your application, now has a non-undef value ... as it will throughout the remainder of the execution of the program.   If your various objects routinely interact with one another by referencing some kind of global variable set, they can rely upon all of those variables being populated and that the referenced objects exist.   Now, only the constructors are “the odd man out,” unable to rely upon anything other than itself.   Even though in a “purist” sense these sort of things ought not to matter, in my experience no actual software implementation is really that “purist.”   Anyway, it works well for me.

    Furthermore ... even though right now you want the initial state of the object to be “five levels deep,” is that really guaranteed for all time to remain just-so?   If you “wedge” the code to establish tree-depth into the constructor, you might one day regret having done that.   It isn’t good to box yourself in.

    Also...   Sometimes you can create an object that maintains a “sparse” data structure that always appears to be “five levels deep,” but that only stores what is necessary; e.g. what is different from the known default.   The clients of the object would never know or care.   If you’re stipulating a five-level depth because you know to anticipate this as your final-state and you don’t want to burn time on tree-rebalancing, that’s fine too.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://993605]
Approved by matze77
Front-paged by matze77
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (5)
As of 2018-06-24 11:50 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (126 votes). Check out past polls.