R/tableKruskal.R

In voiceR: Voice Analytics for Social Scientists

#'Create a table for Kruskal-Wallis test results
#'
#' Automatically generates HTML table with the results of a Kruskal-Wallis 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, original variable name is displayed.
#' @param figureNumber Integer indicating the figure number, used to create the title for the table. Default corresponds to 1.
#' @param InfoTable Logical value indicating the type of table to be reported. If FALSE, a table containing the mean ranks for each group is displayed; if TRUE, a table containing the main results for the Kruskal-Wallis test is displayed. Default corresponds to FALSE.
#' @return HTML table showing Kruskal-Wallis test results in APA formatting style.
#' @examples
#' tableKruskal(testAudioData, by = "Condition", measure = "duration")
#'
#' @importFrom stats as.formula kruskal.test
#' @importFrom stringr str_replace
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableKruskal <- function(audioData, by = c(), measure = "duration", nameMeasure = c(), figureNumber = 1, InfoTable = FALSE){
  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 one of the following measures: duration, voice_breaks_percent, RMS_env, mean_loudness, mean_F0, sd_F0, mean_entropy, or mean_HNR")
  }
  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){
    nameMeasure <- measure
  }

  # Generate formula
  formula = as.formula(paste(measure, "~", by))
  #Compute kruskal test
  kruskalTestData <- kruskal.test(formula, audioData)
  #Get ranks
  audioData$VarRank <- rank(audioData[,measure], ties.method = "average")
  #Generate empty table
  descriptionTable <- data.frame(Names = unique(audioData[,by]), N = rep(NA, length(unique(audioData[,by]))), Ranks = rep(NA, length(unique(audioData[,by]))))
  #Fill table with N and Ranks
  for(i in 1:nrow(descriptionTable)){
    descriptionTable$N[i] <- nrow(audioData[audioData[,by] == descriptionTable$Names[i],])
    descriptionTable$Ranks[i] <-  round(mean(audioData[audioData[,by] == descriptionTable$Names[i],"VarRank"]),2)
  }
  #Fill data with Kruskal test results
  descriptionTable2 <- data.frame(Factor = by, df = kruskalTestData$parameter[1], X2 = round(kruskalTestData$statistic[1], 2), p = round(kruskalTestData$p.value[1], 4))

  #Convert p values into star notation
  descriptionTable2$p[1] <- ifelse(descriptionTable2$p[1] < 0.001, paste(descriptionTable2$p, "(***)"), ifelse(descriptionTable2$p[1] < 0.01, paste(descriptionTable2$p, "(**)"),ifelse(descriptionTable2$p[1] < 0.05, paste(descriptionTable2$p[1], "(*)"), paste(descriptionTable2$p[1], ""))))
  colnames(descriptionTable2)[1] <- " "


  colnames(descriptionTable)[1] <- " "
  descriptionTable2[1,] <- str_replace(descriptionTable2[1,], "0\\.", ".")
  descriptionTable[,3] <- str_replace(descriptionTable[,3], "0\\.", ".")


  #Convert table into kable extra format and If Infotable FALSE show a table containing the mean ranks for each group is displayed, if Infotable is TRUE a table containing the main results for the Kruskal-Wallis test is displayed. Default corresponds to FALSE.
  if(InfoTable){
    descriptionTable <- kable_classic(kable(
      descriptionTable,
      format = "html",
      booktabs = TRUE,
      caption = paste0("Figure ", figureNumber, ". Mean Ranks for ", nameMeasure, " by ", by)
    ), full_width = T, html_font = "Cambria")

  }
  else{
    descriptionTable <- kable_classic(kable(
      descriptionTable2,
      format = "html",
      booktabs = TRUE,
      caption = paste0("Figure ", figureNumber, ". Kruskal Wallis-H test for ", nameMeasure, " by ", by)
    ), full_width = T, html_font = "Cambria")
    descriptionTable <- footnote(descriptionTable, general ="* p < .05, ** p < .01, *** p < .001", threeparttable = TRUE, footnote_as_chunk = TRUE)

  }


  return(descriptionTable)
}