Bio-MUST-Core
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
bin/prune-tree.pl view on Meta::CPAN
#!/usr/bin/env perl
# PODNAME: prune-tree.pl
# ABSTRACT: Prune tips from TREE files based on id lists
use Modern::Perl '2011';
use autodie;
use File::Basename;
use Getopt::Euclid qw(:vars);
use Smart::Comments;
use Try::Tiny;
use Bio::MUST::Core;
use Bio::MUST::Core::Utils qw(change_suffix insert_suffix secure_outfile);
use aliased 'Bio::MUST::Core::IdList';
use aliased 'Bio::MUST::Core::Tree';
my $method = $ARGV_from_must ? 'load_lis' : 'load';
IDL:
for my $infile (@ARGV_infiles) {
### Processing: $infile
my $list = IdList->$method($infile);
$infile =~ s/$_//xms for @ARGV_in_strip;
# load Tree (either reference tree or tree associated to idl)
my $trefile = $ARGV_ref_tree // change_suffix($infile, '.tre');
my $tree;
try { $tree = Tree->load($trefile) }
catch { warn "Warning: cannot load '$trefile' as a Tree; skipping!\n" };
next IDL unless $tree;
### Pruning tips in: $trefile
# optionally negate list
$list = $list->negative_list($tree) if $ARGV_negate_list;
# prune tree
$tree->tree->keep_tips( [ map { $_->foreign_id } $list->all_seq_ids ] );
# create suffix named after filename
my $outfile = $trefile;
if ($ARGV_ref_tree) {
my ($filename) = fileparse($infile, qr{\.[^.]*}xms);
$outfile = insert_suffix($outfile, "-$filename");
}
$outfile = secure_outfile($outfile, $ARGV_out_suffix);
### Output tree in: $outfile
$tree->store($outfile);
}
# TODO: generalize the --ref-tree approach to other programs as this allows
# a dual use (multiple infiles with or without explicit derived file)
__END__
=pod
=head1 NAME
prune-tree.pl - Prune tips from TREE files based on id lists
=head1 VERSION
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.516 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )