view release on metacpan or  search on metacpan

lib/Bio/NEXUS/Tools/NexModifier.pm  view on Meta::CPAN

   }
}

=head2 selectbytree

 Title   : selectbytree
 Usage   : NA
 Function: select a tree
 Returns : NA
 Args    : NA

=cut

sub selectbytree {
   my ($nexus, $treename) = @_;
   ($treename) or die "ERROR: Need to specify a tree to be selected\n";
   return $nexus->select_tree($treename);
}

=head2 selectbyinode

 Title   : selectbyinode
 Usage   : NA
 Function: select a subtree by specifying its root internal node
 Returns : NA
 Args    : NA

=cut
# 
sub selectbyinode {
   my ($nexus, $nodename, $treename) = @_;
   $nodename or die "ERROR: Need to specify an internal node for subtree\n";

   return $nexus->select_subtree($nodename, $treename);
}

=head2 selectbycolumn

 Title   : selectbycolumn
 Usage   : NA
 Function: select ($command=1) or exclude ($command=0) specified column list or file with list
 Returns : NA
 Args    : NA

=cut
# arguments (column numbers) can be of form: 
# 1) 1-3 4 5 6-10 or 1-3, 4  5, 6-10
# 2) -f <file name> contains numbers in format as examplified in 1)  
sub selectbycolumn {
   my ($nexus, $command, @args) = @_;
   my $args = "@args";
   $args =~ s/title\s*=\s*(\w+)//i;    
   my $title = $1;
#    my $block = $nexus->get_block("characters", $title);

   die "need column numbers" unless $args;

   my $columns;
   if ($args =~ /-f (\S+)/) { # input from file
      my $file = $1;
      $columns = do{ local(@ARGV, $/) = $file; <>};
      $columns =~ s/\n/ /g;
   }else {   # input from command line separated by comma or space
      $columns = $args;
   }

   my @columns = @{ &parse_number($columns) };
   if ($command) {
      return $nexus->select_chars(\@columns, $title);
   }else {
      return $nexus->exclude_chars(\@columns, $title);
   }
}

=head2 selectbysets

 Title   : selectbysets
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut
sub selectbysets {
   my ($nexus, $mode, @setnames) = @_;    
   my @otus;
   die "Provide set names as arguments\n" unless (@setnames);
   for my $setname (@setnames) {
      push(@otus, @{ $nexus->get_block('sets')->get_taxset($setname) } );
   }

   if ( $mode == 1 ) { # "select" mode 
      return $nexus->select_otus(\@otus); 
   } else { # "exclude" mode 
      return $nexus->exclude_otus(\@otus); 
   }
}

=head2 parse_number

 Title   : parse_number
 Usage   : NA
 Function: parse numbers in format "1-3, 4 6 8-10"
 Returns : NA
 Args    : NA

=cut
# 
sub parse_number {
   my $s = unquote( shift );

   if (! $s =~ /^\s*(\d+(-\d+)?)([,\s]\s*\d+(-\d+)?)*\s*$/ ) { 
      die "Invalid number format.  Use 1 or 1-3 or 1, 3, 5-8 or 1 3 5 6-10.\n"; 
   } 
   $s =~ s/^\s+|\s+$//g;
   $s =~ s/,?\s+/,/g;  # use ',' as separator
   my @cols = split(/,/, $s);

   my @arr;
   foreach my $item (@cols) {
      if ($item =~ /-/) { # eg 1-3