R/tableSimpleMainEffects.R

In voiceR: Voice Analytics for Social Scientists

#' Create a table for simple main effects analysis
#'
#' Automatically generates an HTML table with the results of a simple main effects analysis.
#'
#' @param audioData A data.frame generated by the autoExtract() function.
#' @param by A character vector indicating the name of the factors. Note: it requires two factors.
#' @param measure Name of the dependent variable.
#' @param nameMeasure Optional string to rename the dependent variable in the output table. If no value is provided, the original variable name is displayed.
#' @param figureNumber Integer indicating the figure number, used to create the title for the table. Default corresponds to 1.
#' @return HTML table showing simple main effects analysis results in APA formatting style.
#' @examples
#' tableSimpleMainEffects(testAudioData, by = c("Condition", "Dimension"), measure = "duration")
#'
#' @importFrom stats aov as.formula
#' @importFrom phia testInteractions
#' @importFrom stringr str_replace_all
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableSimpleMainEffects <- function(audioData, by = c(), measure = "duration", nameMeasure = c(), figureNumber = 1){
  by <- as.vector(by)
  if(!is.data.frame(audioData)) stop("audioData should be a data.frame produced by autoExtract")
  if(length(measure) != 1 && !measure %in% colnames(audioData)) {
    stop("measure should be present on audioData")
  }
  if(sum(!by %in% colnames(audioData)) > 0){
    stop(paste(by[which(!by %in% colnames(audioData))], "not found in audioData"))
  }

  # If by does not have length equal to 2 throw error
  if(length(by) != 2){
    stop("Incorrect Number of by elements. It should contain 2.")
  }
  if(!(all(apply(audioData[, tolower(colnames(audioData)) %in% tolower(by), drop = FALSE], 2, is.factor)) || all(apply(audioData[, tolower(colnames(audioData)) %in% tolower(by), drop = FALSE], 2, is.character)))){
    stop("Variables selected using by are not factors")
  }
  if(length(by) == 0){
    stop("No by values provided.")
  }
  if(!is.numeric(audioData[,measure])){
    stop("Variables selected using measure is not numeric")
  }


  if(length(nameMeasure) == 0 || !is.character(nameMeasure)){
    nameMeasure <- measure
  }
  # Generate formula
  formula = as.formula(paste(measure, "~", by[1], "*", by[2]))
  audioData[,by[1]] <- as.factor(audioData[,by[1]])
  audioData[,by[2]] <- as.factor(audioData[,by[2]])
  #Compute two way anova
  res.aov2 <- aov(formula, audioData)
  #Test interactions
  SimpleMainEffectsTable <- testInteractions(res.aov2, fixed = by[1], across = by[2])
  #Name table columns
  namesColumns <- vector(mode = "character", length = length(unique(audioData[, by[2]])) - 1)
  for(i in 2:length(unique(audioData[, by[2]]))){
    namesColumns[i - 1] <- paste0("Mean difference <br/>(", unique(audioData[, by[2]])[1], " - ", unique(audioData[, by[2]])[i], ")")
  }

  colnames(SimpleMainEffectsTable)[1:(length(unique(audioData[, by[2]])) - 1)] <- namesColumns
  #Fill table and rename remaining columns
  SimpleMainEffectsTable[,1:(length(unique(audioData[, by[2]])) - 1)] <- round(SimpleMainEffectsTable[,1:(length(unique(audioData[, by[2]])) - 1)], 2)
  colnames(SimpleMainEffectsTable)[(length(unique(audioData[, by[2]]))):ncol(SimpleMainEffectsTable)] <- c("df", "SS", "F", "p")

  SimpleMainEffectsTable <- cbind(rownames(SimpleMainEffectsTable), SimpleMainEffectsTable)
  colnames(SimpleMainEffectsTable)[1] <- by[1]
  rownames(SimpleMainEffectsTable) <- c()
  SimpleMainEffectsTable[,c("SS", "F")] <- round(SimpleMainEffectsTable[,c("SS", "F")],2)
  SimpleMainEffectsTable$p <- round(SimpleMainEffectsTable$p, 3)
  SimpleMainEffectsTable[nrow(SimpleMainEffectsTable),which(is.na(SimpleMainEffectsTable[nrow(SimpleMainEffectsTable),]))] <- " "

  descriptionTable2 <- SimpleMainEffectsTable[1:(nrow(SimpleMainEffectsTable)-1),]
  #Convert p values into star notation
  if(length(descriptionTable2[descriptionTable2$p < 0.05, "p"]) > 0)
    descriptionTable2[descriptionTable2$p < 0.05, "sig"] <- paste(descriptionTable2[descriptionTable2$p < 0.05, "p"], "(*)")
  if(length(descriptionTable2[descriptionTable2$p < 0.01, "p"]) > 0)
    descriptionTable2[descriptionTable2$p < 0.01, "sig"] <- paste(descriptionTable2[descriptionTable2$p < 0.01, "p"], "(**)")
  if(length(descriptionTable2[descriptionTable2$p < 0.001, "p"]) > 0)
    descriptionTable2[descriptionTable2$p < 0.001, "sig"] <- paste(descriptionTable2[descriptionTable2$p < 0.001, "p"], "(***)")
  if(length(descriptionTable2[descriptionTable2$p >= 0.05, "p"]) > 0)
    descriptionTable2[descriptionTable2$p >= 0.05, "sig"] <- paste(descriptionTable2[descriptionTable2$p >= 0.05, "p"], " ")

  SimpleMainEffectsTable[1:(nrow(SimpleMainEffectsTable)-1),]$p <- descriptionTable2$sig
  columnNames <- colnames(SimpleMainEffectsTable)
  rowNames <- SimpleMainEffectsTable[,1]
  SimpleMainEffectsTable <- data.frame(lapply(SimpleMainEffectsTable, function(x) str_replace_all(x, "0\\.", ".")))
  colnames(SimpleMainEffectsTable) <- columnNames
  SimpleMainEffectsTable[,1] <- rowNames
  #Convert table into kable extra
  descriptionTable <- kable_classic(kable(
    SimpleMainEffectsTable,
    format = "html",
    booktabs = TRUE,
    escape = FALSE,
    caption = paste0("Figure ", figureNumber, ". Simple Main effects for ", nameMeasure, " by ", paste(by[1], "and", by[2]))
  ), full_width = F, html_font = "Cambria")

  descriptionTable <- footnote(descriptionTable, general ="* p < .05, ** p < .01, *** p < .001", threeparttable = TRUE, footnote_as_chunk = TRUE)
  return(descriptionTable)
}