R/getFixedEF.onePhase.R

In infoDecompuTE: Information Decomposition of Two-Phase Experiments

##' Get the Fixed Components' coefficients and Efficiency Factors of
##' Single-Phase Experiments.
##' 
##' Calculate coefficients of fixed effects components of EMS and Treatment
##' Efficiency Factors within each stratum in Single-Phase or two-phase
##' experiment.
##' 
##' Constructs a matrix containing the coefficients of the coefficients of
##' fixed effects components of EMS within each stratum. Also calculates and
##' the average efficiency factors of each treatment effect across all strata
##' 
##' Construct a matrix contain the coefficients of the fixed Components and the
##' average efficiency factors of single-phase experiments.
##' 
##' The function uses the efficiency factors generated by \code{getEffFactor}
##' to calculated the coefficients of fixed Effects components of EMS and
##' insert the treatment efficiency factor within each stratum.
##' 
##' The complication arise in giving the row names of the matrix for the source
##' of variation in the ANOVA table.
##' 
##' @param effFactors a list of numeric vector generated by
##' \code{\link{getEffFactor}} function.
##' @param trt.Sca a numeric vector generated by \code{\link{getTrtRep}}
##' function.
##' @param T a list of matrices generated by \code{\link{makeContrMat}}
##' function.
##' @param Rep a numeric matrix generated by \code{\link{getTrtRep}} function.
##' @param table.legend a logical allows users to generate a legend for the
##' variance components of the ANOVA table for large designs. Default is
##' \code{FALSE}, resulting in the use of original treatment factor names.
##' @param decimal a logical allows users to display the coefficients as the
##' decimals. Default is \code{FALSE}, resulting in the use of
##' \code{fractions}.
##' @param digits a integer indicating the number of decimal places. Default is
##' 2, resulting in 2 decimal places.
##' @param list.sep a logical allows users to present the efficiency factors
##' and coefficients of the fixed effects a list of separate matrices.
##' @return A matrix.
##' @author Kevin Chang
##' @export 
##' @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"
##'     
##' rT <- terms(as.formula(paste("~", blk.str, sep = "")), keep.order = TRUE) 
##' blkTerm = attr(rT,"term.labels")
##'      
##' Z <- makeBlkDesMat(design1, blkTerm)
##' 
##' trt.str <- "Trt"              
##' fT <- terms(as.formula(paste("~", trt.str, sep = "")), keep.order = TRUE)  #fixed terms
##' 
##' trtTerm <- attr(fT, "term.labels")
##' effectsMatrix <- attr(fT, "factor")        
##' 
##' T <- makeContrMat(design1, trtTerm, effectsMatrix, contr.vec = NA)
##' 
##' N <- makeOverDesMat(design1, trtTerm)
##' 		
##' Replist = getTrtRep(design1, trtTerm)   
##'  
##' Rep <- Replist$Rep
##' trt.Sca <- Replist$Sca
##'     
##' effFactors = lapply(makeOrthProjectors(Z), function(z) getEffFactor(z, T, N, Rep, trt.Sca))
##' 
##' 
##' effFactors <- effFactors[sort(1:length(effFactors), decreasing=TRUE)]
##' 
##' getFixedEF.onePhase(effFactors = effFactors, trt.Sca = trt.Sca,  T = T, Rep = Rep, 
##' 			table.legend = FALSE, decimal = FALSE, digits = 2, list.sep = TRUE)
##' 
getFixedEF.onePhase <- function(effFactors, trt.Sca, T, Rep, table.legend, decimal, 
    digits, list.sep) {
    
    trt <- numeric(length(trt.Sca) + ncol(Rep))
    names(trt) <- c(names(T), paste("eff", names(T), sep = "."))
    
    for (i in 1:length(effFactors)) {
        trt <- rbind(trt, character(length = length(T) * 2))
        if (grepl("Within", names(effFactors[i]))) {
            rownames(trt)[nrow(trt)] <- paste(names(effFactors[i]), sep = " ")
        } else {
            rownames(trt)[nrow(trt)] <- paste("Between", names(effFactors[i]), sep = " ")
        }
        
        for (j in 1:length(effFactors[[i]][[2]])) {
            if (is.null(effFactors[[i]][[2]][[j]])) 
                next
            
					
			effCoefList = effFactors[[i]][[2]][[j]]
				
			#browser()
				
			if (decimal) {
				char.trt.eff <- round(sapply(effCoefList, function(x) x[1]), digits = digits)
				char.trt <- sapply(effCoefList, function(x) 
					ifelse(length(x)>2,  paste(round(x[2:length(x)], digits = digits), collapse = ","), 
									round(x[2], digits = digits)))
			} else {
				char.trt <- sapply(effCoefList, function(x) 
					ifelse(length(x)>2,  paste(attr(fractions(x[2:length(x)]), "fracs"), collapse = ","), 
										attr(fractions(x[2]), "fracs")))
									
				char.trt.eff <- attr(fractions(sapply(effCoefList, function(x) x[1])), "fracs")
			}
			
            trt.temp <- c(char.trt, char.trt.eff)
            
            trt <- rbind(trt, trt.temp)
            rownames(trt)[nrow(trt)] <- paste("  ", names(effFactors[[i]][[2]][j]), sep = " ")
        }
        
    }
    
    trt <- trt[-1, ]
    
    trt <- noquote(ifelse(trt == "NaN", "", trt))
    trt <- noquote(ifelse(trt == "0", "", trt))
	  
    if(list.sep){
      trt.Fixed = trt[,-grep("^eff", colnames(trt))]
      trt.EF = trt[,grep("^eff", colnames(trt))]
      
      if(length(grep("^eff", colnames(trt))) ==1){
        trt.Fixed = noquote(matrix(trt.Fixed))
        trt.EF = noquote(matrix(trt.EF))
        
        rownames(trt.Fixed) = rownames(trt.EF) = rownames(trt)
        colnames(trt.Fixed) =  colnames(trt)[1]
        colnames(trt.EF) = paste("eff.", colnames(trt)[1], sep = "")
      }
      trt = list(Coef = trt.Fixed, EF = trt.EF)
    }
    
    
    if (table.legend) {
      if(list.sep){
        Legend.EF <- paste(paste(letters[1:(length(colnames(trt.EF)))], colnames(trt.EF), sep = " = "))
        colnames(trt.EF) <- letters[1:(length(colnames(trt.EF)))]
        Legend.Coef <- paste(paste(letters[1:(length(colnames(trt.Fixed)))], colnames(trt.Fixed), sep = " = "))
        colnames(trt.Fixed) <- letters[1:(length(colnames(trt.Fixed)))]
        
        trt <- list(EF = trt.EF, Legend.EF = Legend.EF, Coef = trt.Fixed, Legend.Coef = Legend.Coef)
      } else{
        Legend <- paste(paste(letters[1:(length(colnames(trt)))], colnames(trt), sep = " = "))
        colnames(trt) <- letters[1:(length(colnames(trt)))]
        trt <- list(trt = trt, Legend = Legend)
      }
    }
    
    return(trt)
    
}