Nothing
##' Construct Block Design Matrix
##'
##' Construct a binary matrix representing the block design. The rows are
##' corresponding to the observations and the columns are corresponding to the
##' blocks.
##'
##'
##' @param design.df a data frame containing the experimental design. Requires
##' every column be a \code{\link{factor}}.
##' @param blkTerm a vector of character containing the labels of the block
##' terms in the model generated by the \code{\link{terms}}.
##' @return A list of the binary matrices.
##' @author Kevin Chang
##' @seealso \code{\link{terms}}
##' @examples
##'
##'
##' design1 <- local({
##' Ani = as.factor(LETTERS[c(1,2,3,4,
##' 5,6,7,8)])
##' Trt = as.factor(letters[c(1,1,1,1,
##' 2,2,2,2)])
##' data.frame(Ani, Trt, stringsAsFactors = TRUE )
##' })
##'
##' blk.str = "Ani*Trt"
##'
##' rT = terms(as.formula(paste("~", blk.str, sep = "")), keep.order = TRUE)
##'
##' blkTerm = attr(rT,"term.labels")
##' Z = makeBlkDesMat(design1, blkTerm)
##'
##'
##'
##' @export makeBlkDesMat
makeBlkDesMat <- function(design.df, blkTerm) {
isFactorNameNumeric <- function(levels) !as.logical(length(grep("[A-Z]|[a-z]", levels)))
makeDesignMatrix <- function(nRows, design.df, col) {
#browser()
if (grepl(":", col)) {
factor <- as.factor(apply(design.df[, unlist(strsplit(col, ":"))], 1, function(x) paste(x,
collapse = ".")))
} else {
factor <- as.factor(design.df[, col])
}
facName <- col
nCols <- nlevels(factor)
Z <- matrix(0, nrow = nRows, ncol = nCols)
Z[cbind(1:nRows, match(c(factor), 1:nCols))] <- 1
if (isFactorNameNumeric(levels(factor))) {
colNames <- paste(facName, 1:nCols, sep = "")
} else {
colNames <- levels(factor)
}
dimnames(Z) <- list(1:nRows, colNames)
return(Z)
}
n <- length(blkTerm)
nRows <- nrow(design.df)
Z <- list(NULL)
Z[[1]] <- diag(nrow(design.df))
for (i in 2:(n + 1)) {
Z[[i]] <- makeDesignMatrix(nRows = nRows, design.df = design.df, col = blkTerm[i -
1])
}
names(Z) <- c("e", blkTerm)
return(Z)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.