1contr.FrF2 <- function (n, contrasts=TRUE) 2{ 3 ## the contrasts option does not do anything but is needed for model.matrix 4 ## to work on objects of this type 5 if (!contrasts) stop("contr.FrF2 not defined for contrasts=FALSE") 6 7 ## CAUTION: for more than 4 levels, levels need to be in correct order 8 ## for the FrF2 structure to hold! 9 if (length(n) <= 1) { 10 if (is.numeric(n) && length(n) == 1 && n > 1) 11 levels <- 1:n 12 else stop("invalid choice for n in contr.blocks") 13 } 14 else levels <- n 15 lenglev <- length(levels) 16 if (!2^round(log2(lenglev))==lenglev) 17 stop("contr.FrF2 requires that the number of levels is a power of 2.") 18 19 ## definition of contrast matrix 20 if (lenglev==2) destxt <- "matrix(c(-1,1),ncol=1)" 21 else { 22 destxt <- "expand.grid(c(-1,1)" 23 for (i in 2:round(log2(lenglev))) 24 destxt <- paste(destxt,",c(-1,1)",sep="") 25 destxt <- paste("as.matrix(",destxt,"))",sep="") 26 } 27 cont <- eval(parse(text=destxt)) 28 cont <- sapply(Yates[1:(lenglev-1)], function(obj) (apply(cont[,obj,drop=FALSE],1,prod))) 29 rownames(cont) <- levels 30 colnames(cont) <- NULL 31 cont 32} 33