R/makeBlkDesMat.R

In infoDecompuTE: Information Decomposition of Two-Phase Experiments

##' 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)
}