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