view release on metacpan or  search on metacpan

lib/Bio/MUST/Core/Tree.pm  view on Meta::CPAN

    # TODO: investigate options of Bio::Phylo::Unparsers::Newick

    # update either terminal or internal nodes
    my $tree = $self->tree;
    my @nodes = @{
        $mode == 2 ? $tree->get_entities  :
        $mode == 1 ? $tree->get_internals :
                     $tree->get_terminals
    };

    # Note: old labels are backuped in specified attributes and vice-versa
    # TODO: allow appending acc for terminal nodes?
    for my $node (@nodes) {
        my $label     = $node->get_name;
        my $attribute = $node->get_generic($key);
        $node->set_generic($key => $label);
        $node->set_name($attribute);
    }

    return;
}

lib/Bio/MUST/Core/Tree.pm  view on Meta::CPAN

    close $out;

    return;
}


sub store_tpl {
    my $self    = shift;
    my $outfile = shift;

    # backup and discard branch lengths
    # Note: I have to do that since I cannot clone the tree (Bio::Phylo bug?)
    my @branch_lengths;
    for my $node ( @{ $self->tree->get_entities } ) {
        push @branch_lengths, $node->get_branch_length;
        $node->set_branch_length(undef);
    }

    open my $out, '>', $outfile;

    # output topology

t/tree.t  view on Meta::CPAN

}

# {   # TODO: fix this test as set_root_below adds zero-length branches
#     my $infile = file('test', 'fake-unroot.tpl');
#     my $tree = $class->load($infile);
#         my ($node) = @{ $tree->tree->get_by_regular_expression(
#             -value => 'get_name',
#             -match => qr/Fagus/,
#         ) };
#     $tree->root_tree($node, -1, 1);
#     # should not trigger node metadata backup
#
#     my $exp_file = file('test', 'fake-rootF.tpl');
#     cmp_ok $tree->newick_str, 'eq', $class->load($exp_file)->newick_str,
#         'got expected newick string after rerooting topology on Fagus';
# }

my @exp_rootings = (
    [ 'Canis',          'fake-rootC.tre'  ],
    [ 'Amanita',        'fake-rootA.tre'  ],
    [ 'Elmera',         'fake-rootE.tre'  ],