1aggregate.design <- function(x, ..., by=NULL, response=NULL, FUN="mean", postfix=NULL, replace=TRUE){ 2 if (!"design" %in% class(x)) stop("x must be of class design") 3 di <- design.info(x) 4 if (is.null(di$responselist) & is.null(by)) 5 stop("x must be a wide design (repeated measurements or parameter design), or by must be specified") 6 if (is.null(di$responselist) & !is.null(by)) 7 return(aggregate.data.frame(x, by, FUN, ...)) 8 9 ## from here on, treatment of wide designs 10 if (is.null(postfix)){ 11 if (is.character(FUN)) postfix <- FUN 12 else postfix <- make.names(deparse(substitute(FUN))) 13 } 14 if (is.character(FUN) & length(FUN)>1) 15 stop("aggregate.design can only handle one function at a time") 16 if (is.null(postfix)) postfix <- FUN 17 if (!(is.character(postfix) & length(postfix)==1)) 18 stop("postfix must be a character string") 19 FUN <- match.fun(FUN) 20 if (is.null(response)) response <- names(di$responselist) 21 if (!is.character(response)) stop("response must be a character vector of response names") 22 if (!length(setdiff(response, colnames(di$responselist)))==0) 23 stop("invalid response name(s)") 24 aus <- x 25 for (i in 1:length(response)){ 26 assign(paste(response[i],postfix,sep="."), apply(x[,di$responselist[,response[i]]],1,FUN)) 27 aus <- eval(parse(text=paste("add.response(aus,", paste(response[i],postfix,sep="."),", replace=replace)"))) 28 } 29 #modified 30 Jan 2011; not useful to remove all responses 30 di$response.names <- setdiff(design.info(aus)$response.names, unlist(di$responselist)) 31 design.info(aus) <- di 32 aus 33}