#' @include 02_class_metabarcoding.data.R NULL #' @export setGeneric("marginalsum", function(data,MARGIN="sample", na.rm = FALSE) { return(standardGeneric("marginalsum")) }) #' Computes marginal sums over read counts. #' #' Method \code{marginalsum} computes marginal sums over read counts of #' a \code{\link{metabarcoding.data}} instance. #' #' @param data The \code{\linkS4class{metabarcoding.data}} instance #' on which marginal sums have to be computed. #' @param MARGIN Indicates if the sums have to be computed across #' samples or motus. #' Allowed values are : #' \itemize{ #' \item{'sample' or 1} for computing sum across samples #' \item{'motu' or 2} for computing sum across motus #' } #' @param na.rm Logical. Should missing values be omitted from the #' calculations? #' #' @return Returns the vector of marginal sums as a \code{numeric} vector #' #' @examples #' # load termite data set from the ROBITools sample data #' data(termes) #' #' # Computes marginal sums per sample #' ssum = marginalsum(termes,MARGIN="sample") #' #' # Computes marginal sums per MOTU #' msum = marginalsum(termes,MARGIN="motu") #' #' @seealso \code{\linkS4class{metabarcoding.data}} #' #' @docType methods #' @rdname marginalsum-methods #' @aliases marginalsum-methods,metabarcoding.data #' @author Aurelie Bonin #' setMethod("marginalsum", "metabarcoding.data", function(data,MARGIN='sample', na.rm = FALSE) { if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = reads(data) if (MARGIN==1) margesum = rowSums(readcount,na.rm=na.rm) else margesum = colSums(readcount,na.rm=na.rm) return(margesum) }) rowSums.metabarcoding.data = function (x, na.rm = FALSE, dims = 1L) { print("coucou") } #' @export setGeneric("normalize", function(data,MARGIN='sample',as.matrix=FALSE) { return(standardGeneric("normalize")) }) #' Normalizes read counts by sample or by MOTU. #' #' Method \code{normalize} computes a normalized read aboundancy matrix #' (relative frequency matrix) of a \code{\link{metabarcoding.data}} instance. #' Normalization can be done according aboundancies per sample or per MOTU. #' #' @param data The \code{\linkS4class{metabarcoding.data}} instance #' on normalisation have to be computed. #' @param MARGIN Indicates if the sums have to be computed across #' samples or motus. #' Allowed values are : #' \itemize{ #' \item{'sample' or 1} for computing sum across samples #' \item{'motu' or 2} for computing sum across motus #' } #' @param as.matrix Logical indicating if the normalized aboundancies #' must be returned as a simple \code{matrix} (TRUE) or as a new #' instance of the \code{\linkS4class{metabarcoding.data}} class #' (FALSE, the default case). #' #' @return Returns a new instance of \code{\linkS4class{metabarcoding.data}} #' or a \code{numeric} matrix according to the \code{return.as.matrix} #' parameter. #' #' @examples #' # load termite data set from the ROBITools sample data #' data(termes) #' #' # Computes normalized aboundancies per sample #' termes.norm = normalize(termes,MARGIN="sample") #' #' # Computes normalized aboundancies per sample and #' # stores the result as a new layer into the thermes #' # structure #' termes$normalized = normalize(termes,MARGIN="sample",as.matrix=TRUE) #' #' @seealso \code{\linkS4class{metabarcoding.data}} #' #' @docType methods #' @rdname normalize-methods #' @aliases normalize-methods,metabarcoding.data #' @author Aurelie Bonin #' setMethod("normalize", "metabarcoding.data", function(data,MARGIN="sample",as.matrix=FALSE) { if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = reads(data) margesum = marginalsum(data,MARGIN,na.rm=TRUE) readcount = sweep(readcount,MARGIN,margesum, FUN="/") if (as.matrix) newdata=readcount else newdata = copy.metabarcoding.data(data,reads=readcount) return(newdata) }) #' @export setGeneric("threshold", function(data,MARGIN="sample",threshold=0.97) { return(standardGeneric("threshold")) }) #' Compute the cumulative threshold of read aboundances. #' #' The method \code{threshold} of the class \code{\linkS4class{metabarcoding.data}} #' computes the thresold to be used for conserving just a part of the global #' signal. This thresold is computed by ranking aboundances by decreasing order. #' The cululative sums of these ranked abondencies are computed and the aboundance #' corresponding to the first sum greater than the threshold is returned as result. #' #' @param data The \code{\linkS4class{metabarcoding.data}} instance #' on normalisation have to be computed. #' @param MARGIN Indicates if the sums have to be computed across #' samples or motus. #' Allowed values are : #' \itemize{ #' \item{'sample' or 1} for computing sum across samples #' \item{'motu' or 2} for computing sum across motus #' } #' @param threshold a numeric value between 0 and 1 indicating which part of #' the signal must be conserved. Default value is setup to #' 0.97 (97% of the total signal). #' #' @return a numeric vector containing the limit aboundancy to consider for #' each sample or each MOTU according to the value of the \code{MARGIN} #' parameter. #' #' @examples #' # load termite data set from the ROBITools sample data #' data(termes) #' #' # computes threshold value to used for keep 95% of #' # the reads per MOTU #' #' t = threshold(termes,MARGIN='motu',threshold=0.95) #' #' @seealso \code{\linkS4class{metabarcoding.data}}, \code{\link{threshold.mask}} #' #' @docType methods #' @rdname threshold-methods #' @aliases threshold-methods,metabarcoding.data #' @author Aurelie Bonin #' setMethod("threshold", "metabarcoding.data", function(data,MARGIN="sample",threshold=0.97) { onethreshold=function(x,threshold) { s = x[order(-x)] cs= cumsum(s) total=cs[length(cs)] if (total > 0) { cs= cs / total cs = cs > threshold t = s[cs][1] } else t=0 return(t) } if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = reads(data) t = apply(readcount,MARGIN,onethreshold,threshold) return(t) }) #' @export setGeneric("threshold.mask", function(data,MARGIN,threshold=0.97,operator='<') { return(standardGeneric("threshold.mask")) }) #' Computes a cumulatif thresold mask for filtering read aboundancies. #' #' The method \code{threshold.mask} of the class \code{\linkS4class{metabarcoding.data}} #' computes a logical matrix of the same size than the read matrix of the data parameter. #' Each cell of this matrix contains a \code{TRUE} or a \code{FALSE} value according to the #' relationship existing between the read abondancy and the corresponding theshold as computed #' by the \code{\link{theshold}} method. #' #' (computed value) = (read aboundancy) operator (threshold value) #' #' for a cell in the result matrix, \code{(read aboundancy)} is extracted from the read layer. #' \code{operator} is a comparaison operator and \code{(threshold value)} is estimated with the #' \code{\link{theshold}} method. #' #' @param data The \code{\linkS4class{metabarcoding.data}} instance #' on normalisation have to be computed. #' @param MARGIN Indicates if the sums have to be computed across #' samples or motus. #' Allowed values are : #' \itemize{ #' \item{'sample' or 1} for computing sum across samples #' \item{'motu' or 2} for computing sum across motus #' } #' @param threshold a numeric value between 0 and 1 indicating which part of #' the signal must be conserved. Default value is setup to #' 0.97 (97% of the total signal). #' @param operator is a logical comparison operator. #' #' @return A logical matrix usable for selecting cell in the read aboundancy matrix. #' #' @seealso \code{\linkS4class{metabarcoding.data}}, \code{\link{threshold.mask}}, \code{\link{threshold}} #' #' @docType methods #' @rdname threshold-mask-methods #' @aliases threshold.mask-methods,metabarcoding.data #' @author Aurelie Bonin #' setMethod("threshold.mask", "metabarcoding.data", function(data,MARGIN,threshold=0.97,operator='<') { if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = reads(data) t = threshold(data,MARGIN,threshold) mask = apply(readcount,c(2,1)[MARGIN],operator,t) if (MARGIN==2) mask = t(mask) return(mask) }) #' @export setGeneric("const.threshold.mask", function(data,MARGIN,threshold=0.01,operator='<') { return(standardGeneric("const.threshold.mask")) }) #' Computes a constant thresold mask for filtering read aboundancies. #' #' The method \code{const.threshold.mask} of the class \code{\linkS4class{metabarcoding.data}} #' computes a logical matrix of the same size than the read matrix of the data parameter. #' Each cell of this matrix contains a \code{TRUE} or a \code{FALSE} value according to the #' relationship existing between the read abondancy and the global theshold. #' #' (computed value) = (normalized read aboundancy) operator (threshold value) #' #' for a cell in the result matrix, \code{(normalized read aboundancy)} is extracted from the read layer #' after normalization. #' \code{operator} is a comparaison operator and \code{(threshold value)} is estimated with the #' \code{\link{theshold}} method. #' #' @param data The \code{\linkS4class{metabarcoding.data}} instance #' on normalisation have to be computed. #' @param MARGIN Indicates if the sums have to be computed across #' samples or motus. #' Allowed values are : #' \itemize{ #' \item{'sample' or 1} for computing sum across samples #' \item{'motu' or 2} for computing sum across motus #' } #' @param threshold a numeric value between 0 and 1 indicating which part of #' the signal must be conserved. Default value is setup to #' 0.01 (1% of the normalized signal). #' @param operator is a logical comparison operator. #' #' @return A logical matrix usable for selecting cell in the read aboundancy matrix. #' #' @seealso \code{\linkS4class{metabarcoding.data}}, \code{\link{threshold.mask}}, \code{\link{normalize}} #' #' @docType methods #' @rdname const-threshold-mask-methods #' @aliases const.threshold.mask-methods,metabarcoding.data #' @author Aurelie Bonin #' setMethod("const.threshold.mask", "metabarcoding.data", function(data,MARGIN,threshold=0.01,operator='<') { if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = normalize(data,MARGIN,as.matrix=TRUE) mask = do.call(operator,list(readcount,threshold)) return(mask) }) #' @export setGeneric("threshold.set", function(data, MARGIN, threshold=0.97, operator='<', value=0, normalize=TRUE, mask.fun=threshold.mask) { return(standardGeneric("threshold.set")) }) setMethod("threshold.set", "metabarcoding.data", function(data, MARGIN, threshold=0.97, operator='<', value=0, normalize=TRUE, mask.fun=threshold.mask) { if (MARGIN == 'sample') MARGIN=1 if (MARGIN == 'motu') MARGIN=2 readcount = reads(data) if (normalize) data = normalize(data,c(2,1)[MARGIN]) mask = mask.fun(data,MARGIN,threshold,operator) readcount[mask] = value newdata = copy.metabarcoding.data(data,reads=readcount) return(newdata) })