R/tableTukey.R

In voiceR: Voice Analytics for Social Scientists

#'Create a table for Tukey HSD test results
#'
#' Automatically generates an HTML table with the results of a Tukey HSD test.
#'
#' @param audioData A data.frame generated by the autoExtract() function.
#' @param by A character vector indicating the name of the factor(s).
#' @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 Tukey HSD test results in APA formatting style.
#' @examples
#' tableTukey(testAudioData, by = "Condition", measure = "duration")
#'
#' @importFrom stats aov as.formula TukeyHSD
#' @importFrom stringr str_replace str_split
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableTukey <- 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(length(by) == 0){
    stop("No by values provided.")
  }
  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(!is.numeric(audioData[,measure])){
    stop("Variable selected using measure is not numeric")
  }


  #If no custom name provided for the measure, use the measure name
  if(length(nameMeasure) == 0 || !is.character(nameMeasure)){
    nameMeasure <- measure
  }
  # Generate formula
  formula = as.formula(paste(measure, "~", by))
  #Compute Tukey HSD test
  tukeyData <- TukeyHSD(aov(formula, data = audioData))
  #Create data.frame from results
  tukeyData <- as.data.frame(tukeyData[[by]])
  #Process names
  tukeyData$group1 <- trimws(str_split(rownames(tukeyData), "-", simplify = T)[,1])
  tukeyData$group2 <- trimws(str_split(rownames(tukeyData), "-", simplify = T)[,2])
  rownames(tukeyData) <- str_replace(rownames(tukeyData), "-", " and ")
  #Create empty data.frame for the final table
  descriptionTable <- as.data.frame(matrix(nrow = length(unique(audioData[,by])), ncol = length(unique(audioData[,by]))))
  colnames(descriptionTable) <- unique(audioData[,by])
  rownames(descriptionTable) <- unique(audioData[,by])
  descriptionTable[lower.tri(descriptionTable)] <- " "
  descriptionTable[row(descriptionTable) == col(descriptionTable)] <- "1"
  #Fill the empty data.frame
  for (i in 1:nrow(descriptionTable)) {
    for(j in which(is.na(descriptionTable[i,]))){
      number <- tukeyData[tukeyData$group1 == rownames(descriptionTable)[i] & tukeyData$group2 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j],"diff"]
      number <- str_replace(round(number, 2), "0\\.", ".")
      if(tukeyData[tukeyData$group1 == rownames(descriptionTable)[i] & tukeyData$group2 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j],"p adj"] < 0.05)
        descriptionTable[i, j] <- paste(number, "(*)")
      if(tukeyData[tukeyData$group1 == rownames(descriptionTable)[i] & tukeyData$group2 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j],"p adj"] < 0.01)
        descriptionTable[i, j] <- paste(number, "(**)")
      if(tukeyData[tukeyData$group1 == rownames(descriptionTable)[i] & tukeyData$group2 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j],"p adj"] < 0.001)
        descriptionTable[i, j] <- paste(number, "(***)")
      if(tukeyData[tukeyData$group1 == rownames(descriptionTable)[i] & tukeyData$group2 == colnames(descriptionTable)[j] | tukeyData$group2 == rownames(descriptionTable)[i] & tukeyData$group1 == colnames(descriptionTable)[j],"p adj"] >= 0.05)
        descriptionTable[i, j] <- paste(number, " ")
    }
  }
  #Final postprocessing and conversion into kable extra format
  descriptionTable <- cbind(unique(audioData[,by]), descriptionTable)
  colnames(descriptionTable)[1] <- " "
  rownames(descriptionTable) <- c()
  descriptionTable <- kable_classic(kable(
    descriptionTable,
    format = "html",
    booktabs = TRUE,
    caption = paste0("Figure ", figureNumber, ". Posthoc comparisons using Tukey's HSD Test for ", nameMeasure, " by ", by[1])
  ), full_width = T, html_font = "Cambria")

  descriptionTable <- footnote(descriptionTable, general ="Mean difference shown<br/>* p < .05, ** p < .01, *** p < .001", threeparttable = TRUE, footnote_as_chunk = TRUE, escape = FALSE)
  return(descriptionTable)
}