view release on metacpan or  search on metacpan

ext/Tree/lib/Tree.pm  view on Meta::CPAN

method  get_all_siblings ($self:) returns Array {
    (!$self.is_root()) 
        || die "Insufficient Arguments : cannot get siblings to a ROOT tree";
    $self.parent().get_all_children();
}

method add_sibling ($self: Tree $sibling) returns Tree {
    (!$self.is_root()) 
        || die "Insufficient Arguments : cannot add a sibling to a ROOT tree";
    $self.parent().add_child($sibling);
}

method add_siblings ($self: *@siblings) returns Tree {
    (!$self.is_root()) 
        || die "Insufficient Arguments : cannot add siblings to a ROOT tree";
    $self.parent().add_children(@siblings);
}

method insert_siblings ($self: Int $index, *@siblings) returns Tree {
    (!$self.is_root()) 
        || die "Insufficient Arguments : cannot insert siblings to a ROOT tree";
    $self.parent().insert_children($index, @siblings);
}

# insertSibling is really the same as
# insertSiblings, you are just inserting
# and array of one tree
our &Tree::insert_sibling ::= &Tree::insert_siblings;

# I am not permitting the removal of siblings 
# as I think in general it is a bad idea

## ----------------------------------------------------------------------------
## traversal

method traverse ($self: Code $func, Str $traversal_order?) returns Void {
    if !$traversal_order.defined || $traversal_order.lc() eq 'pre_order' {
        $self.pre_order_traverse($func)
    }
    else {
        $self.post_order_traverse($func)
    }
}

method pre_order_traverse ($self: Code $func) returns Void {
    for @!children -> $child is rw {
        $func($child);
        $child.traverse($func);
    }
}

method post_order_traverse ($self: Code $func) returns Void {
    for @!children -> $child is rw {
        $child.traverse($func);
        $func($child);
    }
}

method traverse_iter($self: Str $traversal_order?) returns Code {
    return coro {
        $self.traverse(sub { yield $^node }, $traversal_order);
    };
}

## ----------------------------------------------------------------------------
## utility methods

# NOTE:
# Occasionally one wants to have the 
# depth available for various reasons
# of convience. Sometimes that depth 
# field is not always correct.
# If you create your tree in a top-down
# manner, this is usually not an issue
# since each time you either add a child
# or create a tree you are doing it with 
# a single tree and not a hierarchy.
# If however you are creating your tree
# bottom-up, then you might find that 
# when adding hierarchies of trees, your
# depth fields are all out of whack.
# This is where this method comes into play
# it will recurse down the tree and fix the
# depth fields appropriately.
# This method is called automatically when 
# a subtree is added to a child array
method fix_depth ($self:) returns Void {
    # make sure the tree's depth 
    # is up to date all the way down
    $self.traverse(-> $t {
        $t!set_depth($t.parent().depth() + 1);
    });
}

# NOTE:
# This method is used to fix any height 
# discrepencies which might arise when 
# you remove a sub-tree
method fix_height ($self:) returns Void {
    # we must find the tallest sub-tree
    # and use that to define the height
    my $max_height = 0;
    unless ($self.is_leaf()) {
        for @!children -> $child is rw {
            my $child_height = $child.height();
            $max_height = $child_height if $max_height < $child_height;
        }
    }
    # if there is no change, then we 
    # need not bubble up through the
    # parents
    return if $.height == ($max_height + 1);
    # otherwise ...
    $.height = $max_height + 1;
    # now we need to bubble up through the parents 
    # in order to rectify any issues with height
    $self.parent().fix_height() unless $self.is_root();
}

method fix_width ($self:) {