R/getFixedEF.twoPhase.R

In infoDecompuTE: Information Decomposition of Two-Phase Experiments

##' Get the Fixed Components' coefficients and Efficiency Factors of
##' Two-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 
getFixedEF.twoPhase <- 
  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 = "."))
    noindent <- FALSE
    # browser()
    
    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 if (names(effFactors[i]) == "") {
            trt <- trt[-(nrow(trt)), ]
            noindent <- TRUE
        } else {
            rownames(trt)[nrow(trt)] <- paste("Between", names(effFactors[i]), sep = " ")
        }
        
        for (k in 1:length(effFactors[[i]])) {
            trt <- rbind(trt, character(length = length(T) * 2))
            if (grepl("Within", names(effFactors[[i]][k])) && length(effFactors[[i]]) == 
                1) {
                trt <- trt[-(nrow(trt)), ]
                noindent <- TRUE
            } else if (grepl("Within", names(effFactors[[i]][k]))) {
                if (noindent) {
                  rownames(trt)[nrow(trt)] <- names(effFactors[[i]][k])
                } else {
                  rownames(trt)[nrow(trt)] <- paste("  ", names(effFactors[[i]][k]), 
                    sep = " ")
                }
            } else {
                if (noindent) {
                  rownames(trt)[nrow(trt)] <- paste("Between", names(effFactors[[i]][k]), 
                    sep = " ")
                } else {
                  rownames(trt)[nrow(trt)] <- paste("   Between", names(effFactors[[i]][k]), 
                    sep = " ")
                }
            }
            
            for (j in 1:length(effFactors[[i]][[k]][[2]])) {
                if (is.null(effFactors[[i]][[k]][[2]][[j]])) 
                  next
                
				effCoefList = effFactors[[i]][[k]][[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)
                
                if (noindent) {
                  rownames(trt)[nrow(trt)] <- paste("  ", names(effFactors[[i]][[k]][[2]][j]), 
                    sep = " ")
                } else {
                  rownames(trt)[nrow(trt)] <- paste("     ", names(effFactors[[i]][[k]][[2]][j]), 
                    sep = " ")
                }
            }
            
        }
        noindent <- FALSE
    }
    
    
    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)
    
}