Initial commit

ROBITools.Rproj

+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: ISO-8859-1
+
+RnwWeave: knitr
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackagePath: ROBITools
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

ROBITools/.gitignore

+/man/
+/loopbenchmark.R
+/Read-and-delete-me

ROBITools/DESCRIPTION

+Package: ROBITools
+Type: Package
+Title: Metabarcoding data biodiversity analysis
+Version: 0.1
+Date: 2012-08-23
+Author: LECA - Laboratoire d'ecologie alpine
+Maintainer: LECA OBITools team <obitools@metabarcoding.org>
+Description: More about what it does (maybe more than one line)
+License: CeCILL v2.0
+LazyLoad: yes
+Roxygen: list(wrap = FALSE)
+Collate:
+    's3objects.R'
+    'ROBITools.R'
+    '02_class_metabarcoding.data.R'
+    'aggregate.R'
+    'choose.taxonomy.R'
+    'contaslayer.R'
+    'distrib.extrapol.R'
+    'experimental.section.R'
+    'export-metabarcoding.R'
+    'read.obitab.R'
+    'import.metabarcoding.R'
+    'import.ngsfilter.R'
+    'layers.metabarcoding.R'
+    'metabarcoding_threshold.R'
+    'mstat.R'
+    'obiclean.R'
+    'pcrslayer.R'
+    'plot.PCRplate.R'
+    'plot.seqinsample.R'
+    'rarefy.R'
+    'read.ngsfilter.R'
+    'read.sumatra.R'
+    'taxoDBtree.R'
+    'taxonomic.resolution.R'
+    'taxonomy_classic_table.R'
+RoxygenNote: 5.0.1

ROBITools/LICENSE-SLRE

+Copyright (c) 2004-2013 Sergey Lyubka <valenok@gmail.com>
+Copyright (c) 2013 Cesanta Software Limited
+All rights reserved
+
+This code is dual-licensed: you can redistribute it and/or modify
+it under the terms of the GNU General Public License version 2 as
+published by the Free Software Foundation. For the terms of this
+license, see <http://www.gnu.org/licenses/>.
+
+You are free to use this code under the terms of the GNU General
+Public License, but WITHOUT ANY WARRANTY; without even the implied
+warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+See the GNU General Public License for more details.
+
+Alternatively, you can license this code under a commercial
+license, as set out in <http://cesanta.com/>.

ROBITools/NAMESPACE

+# Generated by roxygen2: do not edit by hand
+
+S3method(aggregate,metabarcoding.data)
+S3method(plot,PCRplate)
+S3method(plot,seqinsample)
+S3method(summary,taxores)
+export(addS3Class)
+export(colnames)
+export(const.threshold.mask)
+export(contaslayer)
+export(createS3Class)
+export(dbtree)
+export(dist.center.group)
+export(dist.clique.group)
+export(dist.grid)
+export(dm.univariate)
+export(extracts.obiclean)
+export(extracts.obiclean_cluster)
+export(extrapol.freq)
+export(get.classic.taxonomy)
+export(import.metabarcoding.data)
+export(import.ngsfilter.data)
+export(layer.names)
+export(m.bivariate)
+export(m.univariate)
+export(m.univariate.test)
+export(m.weight)
+export(map.extrapol.freq)
+export(marginalsum)
+export(metabarcoding.data)
+export(motus)
+export(normalize)
+export(rarefy)
+export(read.ngsfilter)
+export(read.obitab)
+export(reads)
+export(rmS3Class)
+export(rownames)
+export(samples)
+export(taxo.decider)
+export(threshold)
+export(threshold.mask)
+export(threshold.set)
+exportClasses(metabarcoding.data)
+exportMethods("$")
+exportMethods("$<-")
+exportMethods("[[")
+exportMethods("[[<-")
+exportMethods(colnames)
+exportMethods(rownames)
+import(ROBITaxonomy)
+import(igraph)

ROBITools/R/02_class_metabarcoding.data.R

+#' @include ROBITools.R
+#' @include s3objects.R
+#' @import ROBITaxonomy 
+NULL
+
+require(ROBITaxonomy)
+
+#
+# FOR THE DEVELOPPER : we have to check that the code doesn't relies on the
+#                      fact that the xx@samples$sample column is not always 
+#                      identical to the rownames(xx@samples)
+
+setClassUnion("characterOrNULL",c("character","NULL"))
+setClassUnion("matrixOrfactorL",c("matrix","factor"))
+
+#
+# We specialize data.frame in two subclasses motus.frame and samples.frame
+# for this we add to function insuring the type checking and the cast from
+# data.frame
+#
+
+is.motus.frame= function(x) any(class(x)=="motus.frame")
+is.samples.frame= function(x) any(class(x)=="samples.frame")
+
+as.motus.frame= function(x) {
+  if (! is.data.frame(x))
+    stop("only cast from data.frame is allowed")
+  if (! is.motus.frame(x))
+    x = addS3Class(x,"motus.frame")
+  
+  return(x)
+}
+
+
+as.samples.frame= function(x) {
+  if (! is.data.frame(x))
+    stop("only cast from data.frame is allowed")
+  if (! is.samples.frame(x))
+    x = addS3Class(x,"samples.frame")
+  return(x)
+}
+
+samples.frame=as.samples.frame
+motus.frame=as.motus.frame
+
+as.factor.or.matrix = function(x) {
+  if (is.matrix(x))
+    return(x)
+  
+  if (is.factor(x)){
+    if (length(dim(x))!=2)
+      stop('Just factor with two dimensions are allowed')
+    return(x)
+  }
+  
+  if (!is.data.frame(x))
+    stop('Just matrix, 2D factor and data.frame can be casted')
+  
+  tps   = sapply(x,class)
+  allna = sapply(x, function(y) all(is.na(y)))
+  
+  if (all(tps==tps[[1]] | allna)) {
+    tps = tps[[1]] 
+  }
+  else
+    stop('all the column of the data.frame must have the same type')
+
+  tps = tps[[1]]
+  
+  x = as.matrix(x)
+  dx = dim(x)
+  if (tps=='factor')
+    x = factor(x)
+    dim(x)=dx
+  
+  return(x)
+}
+
+#' DNA metabarcoding experiment description class
+#' 
+#' A S4 class describing a DNA metabarcoding experiment. It groups
+#' three data frames describing samples, motus and occurrences of 
+#' MOTUs per sample
+#'
+#'@section Slots: 
+#'  \describe{
+#'    \item{\code{reads}:}{Matrix of class \code{"numeric"},  
+#'                         containing the counts of reads per samples
+#'                         \itemize{
+#'                           \item{1 samples per line}
+#'                           \item{1 sequence per column}
+#'                         }
+#'                        }
+#'                        
+#'    \item{\code{samples}:}{Object of class \code{"data.frame"}, describing samples
+#'                         \itemize{
+#'                           \item{1 samples per line}
+#'                           \item{1 property per column}
+#'                         }
+#'                       }
+#'                       
+#'    \item{\code{motus}:}{Object of class \code{"data.frame"}, describing MOTUs (sequences)
+#'                         \itemize{
+#'                           \item{1 MOTU per line}
+#'                           \item{1 property per column}
+#'                         }
+#'                       }
+#'                       
+#'    \item{\code{layers}:}{Object of class \code{"list"}, containing a set of data layers 
+#'                          linking motus and samples. Each element of the list is a matrix
+#'                          of the same size than the \code{read} slot with
+#'                         \itemize{
+#'                           \item{1 samples per line}
+#'                           \item{1 sequence per column}
+#'                         }
+#'                       }
+#'        
+#'    \item{\code{scount}:}{Object of class \code{"integer"}, containing the count of sample}             
+#'        
+#'    \item{\code{mcount}:}{Object of class \code{"integer"}, containing the count of MOTUs}             
+#'        
+#'    \item{\code{sample.margin}:}{Vector of class \code{"numeric"},  describing the total count of 
+#'                          sequence per sample. By default this slot is set by applying sum
+#'                         to the reads data.frame lines}             
+#'
+#'    \item{\code{taxonomy}:}{Object of class \code{"taxonomy.obitools"}, linking the DNA metabarcoding
+#'                            experiment to a taxonomy}             
+#'        
+#'    \item{\code{taxid}:}{Vector of class \code{"character"}, list of MOTUs' attributes to manage as taxid}             
+#'  }
+#'
+#' @seealso \code{\link{taxonomy.obitools}},
+#' @name metabarcoding.data
+#' @rdname metabarcoding-data-class
+#' @keywords DNA metabarcoding
+#' @author Eric Coissac
+#' @exportClass metabarcoding.data
+
+setClass("metabarcoding.data",
+		
+		
+		#
+		# Attribute declaration
+		#
+		
+		 representation(reads         = "matrix", 
+						        samples       = "data.frame",
+  		  		        motus         = "data.frame",
+        						layers        = "list",
+    				        scount        = "integer",
+        						mcount        = "integer",
+ 				 		        sample.margin = "numeric",
+ 						        taxonomy      = "obitools.taxonomyOrNULL",
+						        taxid         = "characterOrNULL"
+						),
+				
+		#
+		# Check object structure 
+		#
+				
+		validity = function(object) { 
+			
+						## object : nom reserve !
+			
+			#
+			# Check that reads / samples and motus data.frames
+			# have compatible sizes
+			#
+			#   reads line count   = samples line count
+			#   reads column count = motus   line count
+			
+			rsize = dim(object@reads)
+			ssize = dim(object@samples)
+			msize = dim(object@motus)
+			csize = length(object@sample.margin)
+			
+			if (rsize[1] != ssize[1] & 
+				rsize[2] != msize[1] &
+				rsize[1] != csize)
+				return(FALSE)
+			
+			
+			# if no layer, object is ok
+			
+			if (length(object@layers)==0)
+				return(TRUE)
+			
+			# otherwise we check the size of each layer as we
+			# did for reads
+			
+			return(! any(sapply(object@layers, 
+					   function(l) any(dim(l)!=c(ssize[1],msize[1])))))
+			
+		}
+)
+
+
+
+#
+#' metabarcoding.data constructor
+#' 
+#' @docType methods
+#' @rdname initialize-methods
+#' @aliases initialize-methods,metabarcoding.data
+setMethod("initialize",
+		  "metabarcoding.data",
+			function(.Object, reads,samples,motus,
+					          taxonomy=NULL,taxid=NULL,
+							  sample.margin=NA,
+							  layers=list()) {
+        
+        rn = rownames(reads)
+        cn = colnames(reads)
+        
+				.Object@reads   <- reads
+        
+				# .Object@samples <- as.samples.frame(samples)
+        .Object@samples <- samples
+        row.names(.Object@samples) = rn
+        
+				#.Object@motus   <- as.motus.frame(motus)
+        .Object@motus   <- motus
+        row.names(.Object@motus) = cn
+        
+        
+        # Set colnames and rownames to each layers
+        layers = lapply(layers, function(x) {colnames(x)=cn 
+                                             rownames(x)=rn 
+                                             return(x)})
+		.Object@layers   <- layers
+        				
+				# Precompute sample count and motu count
+				
+		.Object@scount = dim(.Object@samples)[1]
+		.Object@mcount = dim(.Object@motus)[1]
+				
+		.Object@taxonomy = taxonomy
+		.Object@taxid = taxid
+				
+		if (is.null(sample.margin))
+			.Object@sample.margin = rowSums(reads)
+		else
+			.Object@sample.margin = sample.margin
+        
+        names(.Object@sample.margin) = rn
+				
+		validObject(.Object) ## valide l'objet
+        
+		return(.Object)
+		})
+
+
+#
+# metabarcoding.data getters
+#
+
+#' @export
+setGeneric("reads", function(obj) {
+			return(standardGeneric("reads"))
+		})
+
+#' Extracts the matrix describing MOTUs abondances
+#' 
+#' Extract the the matrix describing MOTUs abondances (read counts) 
+#' from a \code{\link{metabarcoding.data}} instance.
+#' 
+#' @param   obj a \code{\link{metabarcoding.data}} instance
+#' @return  a matrix containing data about reads 
+#' 
+#' @examples
+#' # load termite data set from the ROBITools sample data
+#' data(termes)
+#' 
+#' # Extract the matrix describing MOTUs abondances
+#' d = reads(termes)
+#' 
+#' head(d)
+#' 
+#' @seealso \code{\link{metabarcoding.data}},
+#'          \code{\link{motus}}, \code{\link{samples}}
+#'          
+#' @docType methods
+#' @rdname read-methods
+#' @aliases read-methods,metabarcoding.data
+#' @author Eric Coissac
+#' 
+setMethod("reads", "metabarcoding.data", function(obj) {
+			return(obj@reads)
+		})
+
+
+# get samples data.frames
+
+#' @export
+setGeneric("samples", function(obj) {
+			return(standardGeneric("samples"))
+		})
+
+#' Extracts the samples description data.frame
+#' 
+#' Extract the sample description data.frame from a 
+#' \code{\link{metabarcoding.data}} instance.
+#' 
+#' @param   obj a \code{\link{metabarcoding.data}} instance
+#' @return  a data.frame containing data about sample 
+#' 
+#' @examples
+#' # load termite data set from the ROBITools sample data
+#' data(termes)
+#' 
+#' # Extract the data frame describing samples
+#' d = samples(termes)
+#' 
+#' head(d)
+#' 
+#' @seealso \code{\link{metabarcoding.data}},
+#'          \code{\link{motus}}, \code{\link{reads}}
+#'          
+#' @docType methods
+#' @rdname samples-methods
+#' @aliases samples-methods,metabarcoding.data
+#' @author Eric Coissac
+#' 
+setMethod("samples", "metabarcoding.data", function(obj) {
+			return(obj@samples)
+		})
+
+
+#' @export
+setGeneric("motus", function(obj) {
+			return(standardGeneric("motus"))
+		})
+
+#' Extracts the MOTU descriptions \code{data.frame}
+#' 
+#' Extract the MOTUs description \code{data.frame} from a 
+#' \code{\link{metabarcoding.data}} instance.
+#' 
+#' @param   obj a \code{\link{metabarcoding.data}} instance
+#' @return  a data.frame containing data about MOTU 
+#' 
+#' @examples
+#' # load termite data set from the ROBITools sample data
+#' data(termes)
+#' 
+#' # Extract the data.frame describing MOTUs
+#' d = motus(termes)
+#' 
+#' head(d)
+#' 
+#' @seealso \code{\link{metabarcoding.data}},
+#'          \code{\link{reads}}, \code{\link{samples}}
+#'          
+#' @docType methods
+#' @rdname motu-methods
+#' @aliases motu-methods,metabarcoding.data
+#' 
+setMethod("motus", "metabarcoding.data", function(obj) {
+			return(obj@motus)
+		})
+
+
+# get sample count 
+
+setGeneric("sample.count", function(obj) {
+			return(standardGeneric("sample.count"))
+		})
+
+setMethod("sample.count", "metabarcoding.data", function(obj) {
+			return(obj@scount)
+		})
+
+# get motu count 
+
+setGeneric("motu.count", function(obj) {
+			return(standardGeneric("motu.count"))
+		})
+
+setMethod("motu.count", "metabarcoding.data", function(obj) {
+			return(obj@mcount)
+		})
+
+# dim method
+
+setMethod("dim", "metabarcoding.data", function(x) {
+			return(c(x@scount,x@mcount))
+		})
+
+
+setMethod('[', "metabarcoding.data", function(x,i=NULL,j=NULL,...,drop=TRUE) {
+			
+      # special case if samples are not specified (dimension 1)
+			if (!hasArg(i))
+				i = 1:x@scount
+			
+			# special case if motus are not specified (dimension 2)
+			if (!hasArg(j))
+				j = 1:x@mcount
+
+      # special case if the layer attribut is specified
+			args = list(...)
+			
+			if (!is.null(args$layer))
+          return(x[[args$layer]][i,j])	
+      
+      #####################
+      #
+      # normal case 
+      #
+			  
+			r = x@reads[i,j,drop=FALSE]
+      
+			if (sum(dim(r) > 1)==2 | ! drop)
+			{
+        
+        # we do the selection on the motus and samples description data.frame
+        
+				m = x@motus[j,,drop=FALSE]
+				s = x@samples[i,,drop=FALSE]
+        
+        # we do the selection on each layers
+        l = lapply(x@layers,function(l) l[i,j,drop=FALSE])
+        
+				newdata = copy.metabarcoding.data(x, reads=r, samples=s, motus=m, layers=l)
+			}
+			else
+			{
+				newdata = as.numeric(x@reads[i,j])
+			}
+			
+			return(newdata)
+			
+		})
+
+setMethod('[<-', "metabarcoding.data",
+          function (x, i, j, ..., value) {
+            if (!hasArg(i))
+              i = 1:x@scount
+            
+            if (!hasArg(j))
+              j = 1:x@mcount
+            
+            args = list(...)
+            
+            if (is.null(args$layer))
+              x@reads[i, j]=value
+            else
+              
+              x[[args$layer]][i,j]=value
+            
+            return(x)
+          })
+
+	
+
+#################################################
+#
+# User interface function to create 
+# metabarcoding.data objects
+#
+#################################################
+
+#'@export
+metabarcoding.data = function(reads,samples,motus,