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