view release on metacpan or  search on metacpan

lib/Bio/BPWrapper/TreeManipulations.pm  view on Meta::CPAN

	}
    }    
    $tr->set_root_node($rootnode);
    return $tr;
}


sub reorder_by_ref {
    die "reference node id missing\n" unless $opts{'ref'};
    my $id = 0;
    &_flip_if_not_in_top_clade($rootnode, $opts{'ref'}, \$id);
    $print_tree = 1;
}

sub _flip_if_not_in_top_clade { # by resetting creation_id & sortby option of each_Descendent
    my ($nd, $ref, $refid) = @_;
    $nd->_creation_id($$refid++);
#    print STDERR $nd->internal_id(), ":\t";
    if ($nd->is_Leaf()) {
#	print STDERR "\n";
	return }
    my @des = $nd->each_Descendent();
    my @des_reordered;
    for (my $i=0; $i<=$#des; $i++) {
	my $in_des = 0;

lib/Bio/BPWrapper/TreeManipulations.pm  view on Meta::CPAN

	    push @des_reordered, $des[$i];
	}
    }
    foreach (@des_reordered) {
	$_->_creation_id($$refid++);
#	print STDERR $_->internal_id(), ";";
    }
#    print STDERR "\n";
    my @des_new = $nd->each_Descendent('creation'); # key sort function!!
    foreach my $de (@des_new) {
	&_flip_if_not_in_top_clade($de, $opts{'ref'}, $refid);
    }
}


# trim a node to a single OTU representative if all branch lengths of its descendant OTUs <= $cut
sub trim_tips {
    die "Usage: $0 --trim-tips <num>\n" unless $opts{'trim-tips'};
    my $cut = $opts{'trim-tips'};

    my @trim_nodes;