miga-base 0.3.0.0 → 0.3.0.1

data/utils/enveomics/Scripts/Aln.cat.rb

@@ -0,0 +1,162 @@
+#!/usr/bin/env ruby
+#
+# @author  Luis M. Rodriguez-R
+# @update  Nov-30-2015
+# @license artistic license 2.0
+#
+
+$:.push File.expand_path(File.dirname(__FILE__) + "/lib")
+require "enveomics_rb/enveomics"
+
+o = {:q=>false, :missing=>"-", :model=>"AUTO", :removeinvar=>false,
+   :undefined=>"-.Xx?"}
+OptionParser.new do |opt|
+   opt.banner = "
+   Concatenates several multiple alignments in FastA format into a single
+   multiple alignment.  The IDs of the sequences (or the ID prefixes, if using
+   --ignore-after) must coincide across files.
+
+   Usage: #{$0} [options] aln1.fa aln2.fa ... > aln.fa".gsub(/^ +/,"")
+   opt.separator ""
+   opt.on("-c", "--coords FILE",
+      "Output file of coordinates in RAxML-compliant format."
+      ){ |v| o[:coords]=v }
+   opt.on("-i", "--ignore-after STRING",
+      "Remove everything in the IDs after the specified string."
+      ){ |v| o[:ignoreafter]=v }
+   opt.on("-I", "--remove-invariable", "Remove invariable sites.",
+      "Note: Invariable sites are defined as columns with only one state and",
+      "undefined characters.  Additional ambiguous characters may exist and",
+      "should be declared using --undefined."){ |v| o[:removeinvar]=v }
+   opt.on("-u", "--missing-char CHAR",
+      "Character denoting missing data. By default: '#{o[:missing]}'.") do |v|
+	 abort "Missing positions can only be denoted by single characters, " +
+	    "offending value: '#{v}'." if v.length != 1
+	 o[:missing]=v
+      end
+   opt.on("-m", "--model STRING",
+      "Name of the model to use if --coords is used. See RAxML's docs; ",
+      "supported values in v8+ include:",
+      "o For DNA alignments:",
+      "  'DNA[F|X]', or 'DNA[F|X]/3' (to estimate rates per codon position,",
+      "  particular notation for this script).",
+      "o General protein alignments:",
+      "  'AUTO' (default in this script), 'DAYHOFF' (1978), 'DCMUT' (MBE 2005;",
+      "  22(2):193-199), 'JTT' (Nat 1992;358:86-89), 'VT' (JCompBiol 2000;",
+      "  7(6):761-776), 'BLOSUM62' (PNAS 1992;89:10915), and 'LG' (MBE 2008;",
+      "  25(7):1307-1320).",
+      "o Specialized protein alignments:",
+      "  'MTREV' (mitochondrial, JME 1996;42(4):459-468), 'WAG' (globular, MBE",
+      "  2001;18(5):691-699), 'RTREV' (retrovirus, JME 2002;55(1):65-73), ",
+      "  'CPREV' (chloroplast, JME 2000;50(4):348-358), and 'MTMAM' (nuclear",
+      "  mammal proteins, JME 1998;46(4):409-418)."){|v| o[:model]=v}
+   opt.on("--undefined STRING",
+      "All characters to be regarded as 'undefined'. It should include all",
+      "ambiguous and missing data chars.  Ignored unless --remove-invariable.",
+      "By default: '#{o[:undefined]}'."){|v| o[:undefined]=v}
+   opt.on("-q", "--quiet", "Run quietly (no STDERR output)."){ o[:q] = TRUE }
+   opt.on("-h", "--help", "Display this screen.") do
+      puts opt
+      exit
+   end
+   opt.separator ""
+end.parse!
+alns = ARGV
+abort "Alignment files are mandatory" if alns.nil? or alns.empty?
+
+##### MAIN:
+begin
+   $stderr.puts "Reading." unless o[:q]
+   a = {}
+   n = alns.size-1
+   lengths = []
+   (0 .. n).each do |i|
+      key = nil
+      File.open(alns[i],"r").each do |ln|
+	 ln.chomp!
+	 if ln =~ /^>(\S+)/
+	    key = $1
+	    key.sub!(/#{o[:ignoreafter]}.*/,"") unless o[:ignoreafter].nil?
+	    a[key] ||= []
+	    a[key][i] = ""
+	 else
+	    abort "#{alns[i]}: Leading line is not a def-line, is this a "+
+	       "valid FastA file?" if key.nil?
+	    ln.gsub!(/\s/,"")
+	    a[key][i] += ln
+	 end
+      end
+      abort "#{alns[i]}: Empty alignment?" if key.nil?
+      lengths[i] = a[key][i].length
+   end
+   if o[:removeinvar]
+      $stderr.puts "Removing invariable sites." unless o[:q]
+      invs = 0
+      (0 .. n).each do |i|
+	 olen = lengths[i]
+	 (0 .. (lengths[i]-1)).each do |pos|
+	    chr = nil
+	    inv = true
+	    a.keys.each do |key|
+	       next if a[key][i].nil?
+	       chr = a[key][i][pos] if
+		  chr.nil? or o[:undefined].chars.include? chr
+	       if chr != a[key][i][pos] and
+		     not o[:undefined].chars.include? a[key][i][pos]
+		  inv = false
+		  break
+	       end
+	    end
+	    if inv
+	       a.keys.each{|key| a[key][i][pos]="!" unless a[key][i].nil?}
+	       lengths[i] -= 1
+	       invs += 1
+	    end
+	 end
+	 a.keys.each{|key| a[key][i].gsub!("!", "") unless a[key][i].nil?}
+      end
+      $stderr.puts "  Removed #{invs} sites." unless o[:q]
+   end
+   $stderr.puts "Concatenating." unless o[:q]
+   a.keys.each do |key|
+      (0 .. n).each do |i|
+	 a[key][i] = (o[:missing] * lengths[i]) if a[key][i].nil?
+      end
+      abort "Inconsistent lengths in '#{key}'
+      exp:#{lengths.join(" ")}
+      obs:#{a[key].map{|i| i.length}.join(" ")}." unless
+	 lengths == a[key].map{|i| i.length}
+      puts ">#{key}", a[key].join("").gsub(/(.{1,60})/, "\\1\n")
+      a.delete(key)
+   end
+   unless o[:coords].nil?
+      $stderr.puts "Generating coordinates." unless o[:q]
+      coords = File.open(o[:coords],"w")
+      s = 0
+      names = (alns.map do |a|
+	 File.basename(a).gsub(/\..*/,"").gsub(/[^A-Za-z0-9_]/,"_")
+      end)
+      (0 .. n).each do |i|
+	 l = lengths[i]
+	 next unless l > 0
+	 names[i] += "_#{i}" while names.count(names[i])>1
+	 if o[:model] =~ /(DNA.?)\/3/
+	    coords.puts "#{$1}, #{names[i]}codon1 = #{s+1}-#{s+l}\\3"
+	    coords.puts "#{$1}, #{names[i]}codon2 = #{s+2}-#{s+l}\\3"
+	    coords.puts "#{$1}, #{names[i]}codon3 = #{s+3}-#{s+l}\\3"
+	 else
+	    coords.puts "#{o[:model]}, #{names[i]} = #{s+1}-#{s+l}"
+	 end
+	 s += l
+      end
+      coords.close
+   end
+   # Save the output matrix
+   $stderr.puts "Done.\n" unless o[:q] 
+rescue => err
+   $stderr.puts "Exception: #{err}\n\n"
+   err.backtrace.each { |l| $stderr.puts l + "\n" }
+   err
+end
+
+

data/utils/enveomics/Scripts/Aln.convert.pl

@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+#
+# @author: Luis M. Rodriguez-R
+# @update: Mar-23-2015
+# @license: artistic license 2.0
+#
+
+use Bio::AlignIO;
+
+my($iformat,$oformat) = @ARGV;
+($iformat and $oformat) or die "
+Usage:
+   $0 in-format out-format < in_file > output_file
+
+   in-format	Input file's format.
+   out-format	Output file's format.
+   in_file	Input file.
+   out_file	Output file.
+
+Example:
+   # Re-format example.fa into Stockholm
+   $0 fasta stockholm < example.fa > example.stk
+
+Supported formats are:
+   bl2seq, clustalw, emboss, fasta, maf, mase, mega,
+   meme, metafasta, msf, nexus, pfam, phylip, po,
+   prodom, psi, selex, stockholm, XMFA, arp
+
+";
+
+$in  = Bio::AlignIO->new(-fh => \*STDIN, -format => $iformat);
+$out = Bio::AlignIO->new(-fh => \*STDOUT, -format => $oformat);
+while ( my $aln = $in->next_aln ) { $out->write_aln($aln) }
+

data/utils/enveomics/Scripts/AlphaDiversity.pl

@@ -0,0 +1,152 @@
+#!/usr/bin/env perl
+
+#
+# @author: Luis M. Rodriguez-R <lmrodriguezr at gmail dot com>
+# @update: Nov-29-2015
+# @license: artistic license 2.0
+#
+
+use warnings;
+use strict;
+use Getopt::Std;
+use List::Util qw/min max sum/;
+
+sub VERSION_MESSAGE(){print "Alpha-diversity indices (enveomics)\n"}
+sub HELP_MESSAGE(){die "
+Description:
+   Takes a table of OTU abundance in one or more samples and calculates the Rao
+   (Q_alpha), Rao-Jost (Q_alpha_eqv), Shannon (Hprime), and inverse Simpson
+   (1_lambda) indices of alpha diversity for each sample.
+   
+   To use it with Qiime OTU Tables, run it as:
+   $0 -i OTU_Table.txt -h
+
+Usage:
+   $0 [opts]
+
+   -i <str>	* Input table (columns:samples, rows:OTUs, first column:OTU
+		names).
+   -r <int>	Number of rows to ignore.  By default: 0.
+   -c <int>	Number of columns to ignore after the first column (i.e.,
+		between the first column, containing the name of the categories,
+		and the first column of abundance values).  By default: 0.
+   -C <int>	Number of columns to ignore at the end of each line.
+		By default: 0.
+   -d <str>	Delimiter.  Supported escaped characters are: \"\\t\"
+		(tabulation), and \"\\0\" (null bit).  By default: \"\\t\".
+   -h		If set, the first row is assumed to have the names of the
+		samples.
+   -D <str>	Distances file.  A squared matrix (or bottom-left half matrix)
+		with the distances between categories (OTUs or functions).  The
+		first column must contain the names of the categories, and it
+		shouldn't have headers.  If not set, all distances are assumed
+		to be one.  Only used for Rao.
+   -R		Do not calculate Rao indices.  This significantly decreases the
+		total running time. Note that Rao indices are highly susceptible
+		to precision errors, and shouldn't be trusted for very big
+		numbers.
+   -q <int>	Estimate the qD index (true diversity order q).  By default: 0.
+   --help	This help message.
+
+   * Mandatory.
+
+"}
+
+# Input arguments
+my %o;
+getopts('i:c:C:d:r:hD:Rq:', \%o);
+
+#$o{B} and (eval("use bignum; 1") or die "Cannot use bignum.\n");
+&HELP_MESSAGE() unless $o{i};
+$o{c} ||= 0;
+$o{C} ||= 0;
+$o{r} ||= 0;
+$o{d} ||= "\\t";
+$o{q} ||= 0;
+
+$o{d}="\t" if $o{d} eq "\\t";
+$o{d}="\0" if $o{d} eq "\\0";
+
+# Distance matrix
+my $D = {};
+if($o{D} and not $o{R}){
+   my @Didx = ();
+   open DIST, "<", $o{D} or die "Cannot read file: $o{D}: $!\n";
+   while(<DIST>){
+      chomp;
+      my @d = split /\t/;
+      my $idx = shift @d;
+      push  @Didx,  $idx;
+      $D->{ $idx } ||= {};
+      $D->{ $idx }->{ $Didx[$_] } = $d[$_] for(0 .. $#d);
+   }
+   close DIST;
+   undef @Didx;
+}
+
+# Abundance matrix
+my @names  = ();
+my @cats   = ();
+my @values = ();
+open TABLE, "<", $o{i} or die "Cannot open file: ".$o{i}.": $!\n";
+<TABLE> for (1 .. $o{r});
+if($o{h}){
+   my $h = <TABLE>;
+   $h or die "Empty table!\n";
+   chomp $h;
+   @names = split $o{d}, $h;
+   shift @names for (0 .. $o{c});
+}
+
+while(<TABLE>){
+   chomp;
+   my @ln = split $o{d};
+   push @cats, shift(@ln);
+   shift @ln for (1 .. $o{c});
+   pop @ln for (1 .. $o{C});
+   push @{$values[$_] ||= []}, $ln[$_] for (0 .. $#ln);
+   push @{$values[$#ln+1]}, sum(@ln);
+}
+close TABLE;
+$names[$#values] = "gamma";
+
+if($o{R}){
+   print "".join($o{d}, qw/Sample Hprime 1_lambda qD/)."\n";
+}else{
+   print "".join($o{d}, qw/Sample Q_alpha Q_alpha_eqv Hprime 1_lambda qD/)."\n";
+}
+for my $i (0 .. $#values){
+   print "".(exists $names[$i] ? $names[$i] : $i).$o{d};
+   my $N = sum @{$values[$i]};
+   my $Q = 0;
+   my $H = 0;
+   my $l = 0;
+   my $qD = 0 unless $o{q}==1;
+   for my $ik (0 .. $#{$values[$i]}){
+      unless($o{R}){
+	 my $Qi = 0;
+	 for my $jk (0 .. $#{$values[$i]}){
+	    my $dij = (!$o{D}) ? 1 : 
+	       exists $D->{ $cats[$ik] }->{ $cats[$jk] } ?
+	       $D->{ $cats[$ik] }->{ $cats[$jk] } :
+	       exists $D->{ $cats[$jk] }->{ $cats[$ik] } ?
+	       $D->{ $cats[$jk] }->{ $cats[$ik] } :
+	       die "Cannot find distance between ".$cats[$ik].
+		  " and ".$cats[$jk].".\n";
+	    $Qi += $dij * ($values[$i]->[$ik]/$N) * ($values[$i]->[$jk]/$N);
+	 }
+	 $Q += $Qi;
+      }
+      my $pi = $N ? $values[$i]->[$ik]/$N : 0;
+      $H  -= $pi * log($pi) if $pi;
+      $l  += $pi**2;
+      $qD += $pi * ($pi**($o{q}-1)) unless $o{q}==1 or not $pi;
+   }
+   $qD = $o{q}==1 ? exp($H) : 1/($qD**(1/($o{q}-1)));
+   if($o{R}){
+      print "".join($o{d}, $H, $l ? 1/$l : "Inf", $qD)."\n";
+   }else{
+      print "".join($o{d}, $Q, ($Q==1 ? "NA" : 1/(1-$Q)), $H, 1/$l, $qD)."\n";
+   }
+}
+

data/utils/enveomics/Scripts/BlastPairwise.AAsubs.pl

@@ -0,0 +1,102 @@
+#!/usr/bin/env perl
+# 
+# @authors Konstantinos Konstantinidis (initial version)
+#          modified to work with the BLASTp 2.2.25+ m0 output by
+#          Despina Tsementzi & Luis M. Rodriguez-R
+# @updated Dec-21-2015
+#
+
+
+$/ = "Lambda     ";
+use strict;
+my %hash_depth;
+
+my @query;
+my @subject;
+my @similarity;
+my $length = "0";
+
+my($cigar_chr, $blast) = @ARGV;
+
+($cigar_chr and $blast) or die "
+.Description:
+   Counts the different AA substitutions in the best hit blast alignments, from
+   a BLASTP pairwise format output (-outfmt 0 in BLAST+, -m 0 in legacy BLAST).
+
+.Usage: $0 cigar_char blast.m0.txt > aa-subs.list
+
+   cigar_char    Use '+' for similar substitutions, use '_' for non similar
+                 substitutions
+   blast.m0.txt  Blast in 'text' format (-outfmt/-m 0).
+   aa-subs.list  A tab-delimited raw file with one substitution per row and
+                 columns:
+                 (1) Name-of-query_Name-of-subject
+		 (2) AA-in-subject
+		 (3) AA-in-query
+		 (4) Total-Align-Length
+
+";
+
+# For each blast result (i.e., for each query)
+open BLAST, "<", $blast or die "Cannot read file: $blast: $!\n";
+while(my $data=<BLAST>) {
+   $data =~ s/\r//g;
+   my ($data_q, @array_matches) = split(/>/,$data);
+   my ($name_query) = ($data_q =~ /Query\= (\S+?)(?:_GENE|\s)/);
+   my ($length_query) = ($data_q =~ /\(([\d,]+) letters/ );
+   ($length_query) = ($data_q =~ /Length=([\d,]+)/) unless $length_query;
+   $length_query =~ tr/,//d;
+   
+   # For each alignment (i.e., for each HSP),
+   # note the "last" at the end of the block,
+   # so only the best match is considered
+   foreach my $data_f (@array_matches) {
+      # Capture statistics
+      my ($length_match) = ($data_f =~ /Identities = \d+\/(\d+)/);
+      my ($identity_match) = ($data_f =~ /Identities = \d+\/\d+ \((\d+)%/);
+      my ($target_name) = ($data_f =~ /^\s?(\S+)/);
+
+      # If the alignment meets minimum requirements
+      if ($length_query >30 && ($length_match/$length_query > 0.7) && $identity_match > 60) {
+	 $data_f =~ tr/ /_/;
+	 my @array = split ("\n", $data_f);
+	 my $blanks = 0;
+	 my $prefix_size = 0;
+
+	 # For each line in the alignment
+	 for my $data_fff (@array) {	
+	    if ($data_fff =~ /(Query[:_]_+\d+_+)([^_]+)/){
+	       # Query lines
+	       $prefix_size = length($1);
+	       $length = length($2);
+	       @query = split (//, $2);
+	    }elsif ($data_fff =~ /^_{11}/){
+	       # Cigar lines
+	       @similarity = split(//, substr($data_fff, $prefix_size, $length));
+	    }elsif ($data_fff =~ /Sbjct[:_]_+\d+_+([^_]+)/){
+	       # Subject lines
+	       @subject = split(//, $1);
+	       # For each alignment column
+	       for(my $i=0; $i <= $length; $i++){
+		  if ($similarity[$i] eq $cigar_chr) {
+		     print "$name_query\_$target_name\t$subject[$i]\t$query[$i]\t$length_match\n";
+		  }
+	       }
+	       undef @query;
+	       undef @similarity;
+	       undef @subject; 
+	    }
+	    
+	    # Remove secondary alignments
+	    if ($data_fff =~ /^$/){
+	       $blanks++;
+	       last if $blanks >= 3;
+	    }else{
+	       $blanks=0;
+	    }
+	 } # for my $data_fff (@array)
+      } # if ($length_query >30 ...
+      last; # <---- So it takes only the best match!
+   } # foreach my $data_f (@array_matches)
+} # while(my $data=<>)
+