R/tableDunn.R

In voiceR: Voice Analytics for Social Scientists

#' Create a Table for the results of a Dunn's test
#'
#' Automatically generates HTML table with results for Dunn's 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 dependent variable in the output table. If no value is provided, then 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 Dunn's test results in APA formatting style.
#' @examples
#' tableDunn(testAudioData, by = "Condition", measure = "duration")
#'
#' @importFrom stringr str_split str_replace
#' @importFrom stats as.formula
#' @importFrom FSA dunnTest
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableDunn <- 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(!measure %in% colnames(audioData)){
    stop(paste(measure, "not found in audioData"))
  }
  if(sum(!by %in% colnames(audioData)) > 0){
    stop(paste(by[which(!by %in% colnames(audioData))], "not found in audioData"))
  }
  if(!is.numeric(audioData[,measure])){
    stop("Variables selected using measure is not numeric")
  }
  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 no custom name provided for the measure, use the measure name
  if(length(nameMeasure) == 0 || !is.character(nameMeasure)){
    nameMeasure <- measure
  }

  if(length(by) == 0){
    stop("No by argument provided")
  }

  # Generate formula
  formula = as.formula(paste(measure, "~", by))
  #Compute dunn test
  dunnData <- dunnTest(formula, data = audioData)
  #Extract results
  dunnData <- dunnData$res
  #Preprocess group text
  dunnData$group1 <- trimws(str_split(dunnData$Comparison, "-", simplify = T)[,1])
  dunnData$group2 <- trimws(str_split(dunnData$Comparison, "-", simplify = T)[,2])
  #Generate empty description table
  descriptionTable <- as.data.frame(matrix(nrow = length(unique(audioData[,by])), ncol = length(unique(audioData[,by]))))
  #Set column and row names
  colnames(descriptionTable) <- unique(audioData[,by])
  rownames(descriptionTable) <- unique(audioData[,by])
  descriptionTable[lower.tri(descriptionTable)] <- " "
  descriptionTable[row(descriptionTable) == col(descriptionTable)] <- "1"

  #Fill the table
  for (i in 1:nrow(descriptionTable)) {
    for(j in which(is.na(descriptionTable[i,]))){
      number <- dunnData[dunnData$group1 == rownames(descriptionTable)[i] & dunnData$group2 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j],"Z"]
      number <- round(number, 2)
      number <- str_replace(number, "0\\.", ".")

      if(dunnData[dunnData$group1 == rownames(descriptionTable)[i] & dunnData$group2 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j],"P.adj"] < 0.05)
        descriptionTable[i, j] <- paste(number, "(*)")
      if(dunnData[dunnData$group1 == rownames(descriptionTable)[i] & dunnData$group2 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j],"P.adj"] < 0.01)
        descriptionTable[i, j] <- paste(number, "(**)")
      if(dunnData[dunnData$group1 == rownames(descriptionTable)[i] & dunnData$group2 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j],"P.adj"] < 0.001)
        descriptionTable[i, j] <- paste(number, "(***)")
      if(dunnData[dunnData$group1 == rownames(descriptionTable)[i] & dunnData$group2 == colnames(descriptionTable)[j] | dunnData$group2 == rownames(descriptionTable)[i] & dunnData$group1 == colnames(descriptionTable)[j],"P.adj"] >= 0.05)
        descriptionTable[i, j] <- paste(number, " ")
    }
  }

  descriptionTable[descriptionTable < 1 & descriptionTable > -1] <- str_replace(descriptionTable[descriptionTable < 1 & descriptionTable > -1], "0.", ".")
  descriptionTable <- cbind(unique(audioData[,by]), descriptionTable)
  colnames(descriptionTable)[1] <- " "
  rownames(descriptionTable) <- c()
  #Convert table into kable extra format
  descriptionTable <- kable_classic(kable(
    descriptionTable,
    format = "html",
    booktabs = TRUE,
    caption = paste0("Figure ", figureNumber, ". Posthoc comparisons using Dunn's Test for ", nameMeasure, " by ", by[1])
  ), full_width = T, html_font = "Cambria")
  #Add foot note for p values
  descriptionTable <- footnote(descriptionTable, general ="Z value shown<br/>* p < 0.05, ** p < 0.01, *** p < 0.001", threeparttable = TRUE, footnote_as_chunk = TRUE, escape = FALSE)
  return(descriptionTable)
}