Commit ffa96383 by Eric Coissac

Initial commit

parents
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
/man/
/loopbenchmark.R
/Read-and-delete-me
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
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/>.
# 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)
#' @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,
taxonomy=NULL,taxid=NULL,
sample.margin=NULL,
layers=list()) {
rd = new('metabarcoding.data',
reads=reads,
samples=samples,
motus=motus,
taxonomy=taxonomy,
taxid=taxid,
sample.margin=sample.margin,
layers=layers
)
return(rd)
}
copy.metabarcoding.data = function(data,
reads=NULL,
samples=NULL,motus=NULL,
taxonomy=NULL,taxid=NULL,
sample.margin=NULL,
layers=NULL) {
if (is.null(reads))
reads = data@reads
if (is.null(samples))
samples = data@samples
if (is.null(motus))
motus = data@motus
if (is.null(taxonomy))
taxonomy = data@taxonomy
if (is.null(taxid))
taxid = data@taxid
if (is.null(sample.margin))
sample.margin = data@sample.margin
if (is.null(layers))
layers = data@layers
rd = new('metabarcoding.data',
reads=reads,
samples=samples,
motus=motus,
taxonomy=taxonomy,
taxid=taxid,
sample.margin=sample.margin,
layers=layers
)
return(rd)
}
#' @export
setGeneric('rownames')
#' @export
setMethod("rownames", "metabarcoding.data", function(x, do.NULL = TRUE, prefix = "col") {
return(rownames(x@reads,do.NULL,prefix))
})
#' @export
setGeneric('colnames')
#' @export
setMethod("colnames", "metabarcoding.data", function(x, do.NULL = TRUE, prefix = "col") {
return(colnames(x@reads,do.NULL,prefix))
})
#' A package to manipulate DNA metabarcoding data.
#'
#' This package was written as a following of the OBITools.
#'
#' \tabular{ll}{
#' Package: \tab ROBITools\cr
#' Type: \tab Package\cr
#' Version: \tab 0.1\cr
#' Date: \tab 2013-06-27\cr
#' License: \tab CeCILL 2.0\cr
#' LazyLoad: \tab yes\cr
#'}
#'
#' @name ROBITools-package
#' @aliases ROBITools
#' @docType package
#' @title A package to manipulate DNA metabarcoding data.
#' @author Frederic Boyer
#' @author Aurelie Bonin
#' @author Lucie Zinger
#' @author Eric Coissac
#'
#' @references http://metabarcoding.org/obitools
#'
NA
.onLoad <- function(libname, pkgname) {
packageStartupMessage( "ROBITools package" )
#print(getwd())
}