view release on metacpan or  search on metacpan

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

    );
}



sub tax_filter {
    my $self = shift;
    my $list = shift;

    return Filter->new( tax => $self, _specs => $list );
}



sub tax_criterion {
    my $self = shift;
    my $args = shift;

    $args->{tax_filter} = $self->tax_filter( $args->{tax_filter} );

    return Criterion->new($args);
}



sub tax_category {
    my $self = shift;
    my $args = shift;

    $args->{criteria} = [
        map { $self->tax_criterion($_) } @{ $args->{criteria} }
    ];

    return Category->new($args);
}


# Classifier/Labeler/ColorScheme factory methods


sub tax_classifier {
    my $self = shift;
    my $args = shift;

    $args->{categories} = [
        map { $self->tax_category($_) } @{ $args->{categories} }
    ];

    return Classifier->new($args);
}

# example of input HashRef for tax_classifier
# 'min', 'max' and 'description' keys are both optional
# categories => [
#                 {
#                   criteria => [
#                                 {
#                                   max => undef,
#                                   min => 1,
#                                   tax_filter => [
#                                                   '+Latimeria'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Protopterus'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Danio',
#                                                   '+Oreochromis'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Xenopus'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Anolis',
#                                                   '+Gallus',
#                                                   '+Meleagris',
#                                                   '+Taeniopygia'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Mammalia'
#                                                 ]
#                                 }
#                               ],
#                   description => 'strict species sampling',
#                   label => 'strict'
#                 },
#                 {
#                   criteria => [
#                                 {
#                                   tax_filter => [
#                                                   '+Latimeria'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Protopterus'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Danio',
#                                                   '+Oreochromis'
#                                                 ]
#                                 },
#                                 {
#                                   tax_filter => [
#                                                   '+Amphibia',
#                                                   '+Amniota'
#                                                 ]
#                                 }
#                               ],
#                   description => 'loose species sampling',
#                   label => 'loose'
#                 }
#               ]



sub tax_labeler_from_systematic_frame {
    my $self   = shift;
    my $infile = shift;

    # Thursday 26 November 2015 at 15 hours 21
    # ((((((Crenarchaeota:371:88:-1,Korarchaeota:371:72:-1)a:15:80:-1,...)Tree of Life:3:16:-1;

    # ensure that we get a parseable tree from the .fra file
    # by considering only line 2 and turning all funny 'branch lengths' to 1
    my @lines = file($infile)->slurp;
    (my $newick_str = pop @lines) =~ s/(?: :-?(\d+) ){3}/:1/xmsg;

    # parse tree using Bio::Phylo
    # Note: keep whitespace because tip labels are not between quotes
    my $tree = parse(
        -format => 'newick',
        -string => $newick_str,
        -keep_whitespace => 1,
    )->first;

    # extract tip labels
    my @labels = map { $_->get_name } @{ $tree->get_terminals };

    # build classifier from labels
    return $self->tax_labeler_from_list( \@labels );
}



sub tax_labeler_from_list {
    my $self = shift;
    my $list = shift;