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