R/makeOverDesMat.R

In kcha193/infoDecompuTE: Information Decomposition of Two-Phase Experiments

##' Construct the Overall Treatment or Block design Matrix
##' 
##' Construct the treatment or block matrix of the smallest unit based from the
##' experimental design.
##' 
##' The main purpose this matrix is used in information decomposition. For the
##' factorial experiment, this matrix is typically the treatment design matrix
##' associated with the interaction effects, because the interaction effects
##' are the smallest unit for the treatment effects.
##' 
##' For the two-phase experiments, the same method of information decomposition
##' is used for the block effects of Phase 1 experiment in the stratum defined
##' from the block structure of the Phase 2 experiment. Hence, the block design
##' matrix of the smallest unit for the block effects of Phase 1 experiment can
##' also be constructed using this function.
##' 
##' @param design.df a data frame containing the experimental design. Requires
##' every column be a \code{\link{factor}}.
##' @param effectNames a vector of character containing the labels of the
##' treatment or block terms in the model generated by the \code{\link{terms}}.
##' @return A matrix where the rows correspond to the observation and columns
##' correspond to the overall combination of the treatment factors or the block
##' factors of the Phase 1 experiment.
##' @author Kevin Chang
##' @references John J, Williams E (1987). \emph{Cyclic and computer generated
##' Designs}. Second edition. Chapman & Hall.
##' @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 )
##' })
##' 
##' trt.str = "Trt"
##'   
##' fT = terms(as.formula(paste("~", trt.str, sep = "")), keep.order = TRUE) 
##' 
##' trtTerm = attr(fT,"term.labels")
##' effectsMatrix = attr(fT,"factor") 
##'     
##' makeOverDesMat(design1, trtTerm)
##'        
##' 
##' 
##' @export makeOverDesMat
makeOverDesMat <- function(design.df, effectNames) {
    
    if (length(effectNames) == 1 && !any(grepl("[[:punct:]]", effectNames))) {
        incident <- design.df[, effectNames]
        nLevels <- levels(design.df[, effectNames])
    } else if (any(grepl("[[:punct:]]", effectNames))) {
        uniqueTrtCols <- unique(unlist(strsplit(effectNames, "[[:punct:]]+")))
        
        incident <- as.factor(apply(design.df[, uniqueTrtCols], 1, function(x) paste(x, 
            collapse = ".")))
         #nLevels = sort(unique(incident))
        nLevels <- sort(levels(interaction(design.df[, uniqueTrtCols])))
        
    } else {
        incident <- as.factor(apply(design.df[, effectNames], 1, function(x) paste(x, 
            collapse = ".")))
        nLevels <- sort(levels(interaction(design.df[, effectNames])))
		#nLevels = sort(unique(incident))
    }
    
    N <- matrix(0, nrow = nrow(design.df), ncol = length(nLevels))
    N[cbind(1:nrow(design.df), match(incident, nLevels))] <- 1
    
    return(N)
}