view release on metacpan or  search on metacpan

bin/subs-forest.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: subs-forest.pl
# ABSTRACT: Subsample forest (multiple trees) files (and restore ids)

use Modern::Perl '2011';
use autodie;

use Getopt::Euclid qw(:vars);
use Smart::Comments;

use Bio::MUST::Core;
use Bio::MUST::Core::Utils qw(change_suffix secure_outfile);
use aliased 'Bio::MUST::Core::IdMapper';
use aliased 'Bio::MUST::Core::Tree::Forest';


for my $infile (@ARGV_infiles) {

    ### Processing: $infile
    my $forest = Forest->load($infile);

    $infile =~ s/$_//xms for @ARGV_in_strip;

    if ($ARGV_map_ids) {
        my $idmfile = change_suffix($infile, '.idm');
        my $idm = IdMapper->load($idmfile);
        ### Restoring seq ids from: $idmfile
        $forest->restore_ids($idm);
    }

    if (%ARGV_x) {
        my ($burnin, $every, $until) = @ARGV_x{ qw(burnin every until) };
        $until = $forest->count_trees
            if !$until || $until > $forest->count_trees;
        die "<burnin> ($burnin) larger than <until> ($until); aborting!\n"
            if $burnin > $until;
        ### Subsampling using: "-x $burnin $every $until"

        my @trees;
        for (my $i = $burnin; $i < $until ; $i += $every) {
            push @trees, $forest->get_tree($i);
        }
        $forest = Forest->new( trees => \@trees );
    }

    my $outfile = secure_outfile($infile, $ARGV_out_suffix);
    $forest->store($outfile);
}

__END__

=pod

=head1 NAME

subs-forest.pl - Subsample forest (multiple trees) files (and restore ids)

=head1 VERSION

version 0.240390

=head1 USAGE

    subs-forest.pl <infiles> [optional arguments]