1param.design <- function(inner, outer, direction="long", responses=NULL, ...){ 2 if (!"design" %in% class(inner)) 3 stop ("inner must be a design") 4 if (!direction %in% c("long","wide")) stop("direction must be one of long or wide") 5 if (!is.null(responses)) {if (!is.character(responses)) 6 stop("if given, responses must be a character vector of long format response names") 7 responses <- make.names(responses, unique=TRUE) 8 } 9 di <- design.info(inner) 10 if (!di$randomize) warning("inner array should be randomized") 11 if (di$replications>1 | di$repeat.only) 12 stop("inner / outer arrays cannot have replications") 13 if (!"design" %in% class(outer)) 14 if (is.data.frame(outer) | is.matrix(outer) | is.list(outer) | is.array(outer)) 15 stop("outer must be a vector or a data frame of class design") 16 aus <- cross.design(inner, outer, randomize=FALSE) 17 ## modify design.info attribute 18 design.info(aus)$type <- "param" 19 ctypes <- design.info(aus)$cross.types 20 if (all(substr(ctypes,1,4)=="FrF2") | (substr(ctypes[1],1,4)=="FrF2" & substr(ctypes[2],1,6)=="vector" )) 21 design.info(aus)$type <- "FrF2.param" 22 if (!is.null(design.info(aus)$aliased)) names(design.info(aus)$aliased) <- c("inner","outer") 23 design.info(aus)$inner <- factor.names(inner) 24 design.info(aus)$outer <- factor.names(outer) 25 if (!is.null(responses)) response.names(aus) <- responses 26 else response.names(aus) <- NULL 27 if (nrow(outer)>8) 28 warning("Are you sure ?\nA Taguchi inner/outer array with more than 8 runs in the outer array is very unusual") 29 if (direction=="wide") aus <- paramtowide(aus) 30 aus 31}