R/adjustEffectNames.r

Defines functions adjustEffectNames

Documented in adjustEffectNames

##' Adjust the Effects' Names
##' 
##' Adjust for appropriate syntax describing the effects matching the
##' structural formula.
##' 
##' 
##' @param effectNames a vector of character containing the labels of the
##' treatment or block terms in the model generated by the \code{\link{terms}}.
##' @param effectsMatrix a matrix of variables by terms showing which variables
##' appear in which terms generated by the \code{\link{terms}}.
##' @return A vector of character containing the labels of the terms in the
##' model with appropriate syntax describing the effects.
##' @author Kevin Chang
##' @examples
##' 
##' str.for = "A*(B/E/C)*D"
##' effectsMatrix= attr(terms(as.formula(paste("~", str.for)), keep.order = TRUE) , "factors")
##' effectNames =  attr(terms(as.formula(paste("~", str.for)), keep.order = TRUE) , "term.labels")
##' 
##' adjustEffectNames(effectsMatrix, effectNames) 
##' 
##' @export adjustEffectNames
adjustEffectNames = function(effectsMatrix, effectNames) {
  nEffect = length(effectNames)
  
  for (j in 1:ncol(effectsMatrix)) {
    newEffectNames = ""
    
    temp = effectsMatrix[, j]
    
    temp = c(temp[temp != 0], 0)
   
    for (i in 1:(length(temp))) {
      if (temp[i] == 1 &&   temp[i + 1] == 1) {
        newEffectNames = paste(newEffectNames, names(temp)[i], "*", sep = "")
        
      } else if (temp[i] == 1 &&   temp[i + 1] == 2) {
        newEffectNames = paste(newEffectNames, names(temp)[i], "*", sep = "")
        
      }  else if (i != 1 && temp[i] == 1 && temp[i - 1] == 2) {
        newEffectNames = paste(newEffectNames, names(temp)[i], "]", sep = "")
        
      } else if (temp[i] == 1 && temp[i + 1] == 0) {
        newEffectNames = paste(newEffectNames, names(temp)[i], sep = "")
      } else  if (temp[i] == 2 && temp[(i + 1):length(temp)][1] == 1) {
        newEffectNames = paste(newEffectNames, names(temp)[i], "[", sep = "")
        
      } else  if (temp[i] == 2 && temp[i + 1] == 2) {
        newEffectNames = paste(unique(unlist(strsplit(c(newEffectNames, names(temp)[i]), "[[:punct:]]"))), ".", sep = "")
        
      }
      
      #print(newEffectNames)
    }
    
    effectNames[j] = newEffectNames
  }
  
  return(effectNames)
  
}



# first to break breakets

Try the infoDecompuTE package in your browser

Any scripts or data that you put into this service are public.

infoDecompuTE documentation built on April 14, 2020, 7:08 p.m.