1contr.XuWu <- 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.XuWu not defined for contrasts=FALSE")
6
7    ## function to calculate orthogonal normalized contrasts
8    ## that satisfy the XuWu normalization
9    ##      Xu and Wu call these orthonormal
10    ##      however, this is confusing
11    ## These are based on Helmert contrasts
12    if (length(n) <= 1L) {
13        if (is.numeric(n) && length(n) == 1L && n > 1L)
14            levels <- seq_len(n)
15        else stop("not enough degrees of freedom to define contrasts")
16    }
17    else levels <- n
18    levels <- as.character(levels)
19        n <- length(levels)
20        cont <- array(-1, c(n, n - 1L), list(levels, NULL))
21        for (j in 1:(n-1))
22        cont[1:j, j] <- - sqrt(n/(j*(j+1)))
23        cont[col(cont) <= row(cont) - 2L] <- 0
24        cont[col(cont) == row(cont) - 1L] <- sqrt(n*seq_len(n - 1L)/(1+seq_len(n - 1L)))
25        colnames(cont) <- NULL
26   cont
27}
28
29contr.XuWuPoly <- function (n, contrasts=TRUE)
30{
31    ## the contrasts option does not do anything but is needed for model.matrix
32    ## to work on objects of this type
33
34    if (!contrasts) stop("contr.XuWuPoly not defined for contrasts=FALSE")
35
36    ## function to calculate orthogonal normalized contrasts
37    ## that satisfy the XuWu normalization
38    ##      Xu and Wu call these orthonormal
39    ##      however, this is confusing
40    ## here based on polynomial contrasts
41    cont <- contr.poly(n)
42    cont * sqrt(nrow(cont))
43}
44