obitools/ROBITools
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Patch the bug on aggregate when aggregating by samples

Browse Source
This commit is contained in:
Eric Coissac
2018-07-27 22:56:51 +02:00
parent fa77a5d041
commit baf1b1e6fc
1 changed files with 14 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
R/aggregate.R
View File

@@ -12,6 +12,7 @@ aggregate.metabarcoding.data=function(x, by, FUN,...,
default.layer=NULL, default.layer=NULL,
layers=NULL) { layers=NULL) {
uniq.value = function(z) { uniq.value = function(z) {
if (is.null(z) | if (is.null(z) |
@@ -56,19 +57,22 @@ aggregate.metabarcoding.data=function(x, by, FUN,...,
MARGIN=2 MARGIN=2
reads = x@reads reads = x@reads
if (MARGIN==1) { if (MARGIN==1) {
# prepare the aggrevation arguments for the read table # prepare the aggrevation arguments for the read table
# from the function arguments # from the function arguments
dotted = list(...) dotted = list(...)
if (length(dotted) > 0)
if (length(dotted) > 0)
aggr.args = list(reads,by=by,FUN=FUN,...=dotted,simplify=FALSE) aggr.args = list(reads,by=by,FUN=FUN,...=dotted,simplify=FALSE)
else else
aggr.args = list(reads,by=by,FUN=FUN,simplify=FALSE) aggr.args = list(reads,by=by,FUN=FUN,simplify=FALSE)
# Aggregate the read table # Aggregate the read table
ragr = do.call(aggregate,aggr.args) ragr = do.call(aggregate,aggr.args)
# extrat new ids from the aggregated table # extrat new ids from the aggregated table
ncat = length(by) ncat = length(by)
ids = as.character(interaction(ragr[,1:ncat,drop=FALSE])) ids = as.character(interaction(ragr[,1:ncat,drop=FALSE]))
@@ -118,27 +122,28 @@ aggregate.metabarcoding.data=function(x, by, FUN,...,
rownames(lagr)=ids rownames(lagr)=ids
la[[n]]=lagr la[[n]]=lagr
} }
# aggragate the sample table according to the same criteria # aggragate the sample table according to the same criteria
# #
# TODO: We have to take special care of factors in the samples # TODO: We have to take special care of factors in the samples
# data.frame # data.frame
sagr = aggregate(samples(x),by,uniq.value,simplify=FALSE) sagr = aggregate(samples(x),by,uniq.value,simplify=FALSE)
# move the first columns of the resulting data frame (the aggregations # move the first columns of the resulting data frame (the aggregations
# modalities to the last columns of the data.frame # modalities to the last columns of the data.frame
sagr = sagr[,c((ncat+1):(dim(sagr)[2]),1:ncat),drop=FALSE] sagr = sagr[,c((ncat+1):(dim(sagr)[2]),1:ncat),drop=FALSE]
larg = c(lapply(sagr,unlist),list(stringsAsFactors=FALSE)) larg = c(lapply(sagr,unlist),list(stringsAsFactors=FALSE))
sagr = do.call(data.frame,larg) sagr = data.frame(do.call(data.frame,larg))
# set samples ids to the ids computed from modalities # set samples ids to the ids computed from modalities
sagr$id=ids
rownames(sagr)=ids rownames(sagr)=ids
sagr$id=ids
# build the new metabarcoding data instance # build the new metabarcoding data instance
newdata = copy.metabarcoding.data(x,reads=ragr,samples=sagr) newdata = copy.metabarcoding.data(x,reads=ragr,samples=sagr,layers=la)
} }
else { else {
# prepare the aggregation arguments for the read table # prepare the aggregation arguments for the read table