R/tableSchreirer.R

In voiceR: Voice Analytics for Social Scientists

#' Create a table for the Scheirer-Ray-Hare test results
#'
#' Automatically generates an HTML table with the results for Scheirer-Ray-Hare 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 Scheirer-Ray-Hare test results in APA formatting style.
#' @examples
#' tableSchreirer(testAudioData, by = c("Condition", "Dimension"), measure = "duration")
#'
#' @importFrom stats as.formula
#' @importFrom rcompanion scheirerRayHare
#' @importFrom stringr str_replace_all
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableSchreirer <- 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
  }

  # If by does not have length equal to 2 throw error
  if(length(by) != 2){
    stop("Error, incorrect by argument. By should have length of 2.")
  }

  # Generate formula
  formula = as.formula(paste(measure, "~", by[1], "*", by[2]))
  #Compute Scheirer Ray hare test
  SchreirerTestData <- scheirerRayHare(formula, audioData, verbose = FALSE)
  #Generate table with the results
  descriptionTable <- data.frame(Source = rownames(SchreirerTestData), df = SchreirerTestData$Df, SS = round(SchreirerTestData$`Sum Sq`,2), MS = round(SchreirerTestData$`Sum Sq`/SchreirerTestData$Df, 2), H = round(SchreirerTestData$H, 2), p = round(SchreirerTestData$p.value, 3))
  descriptionTable2 <- descriptionTable[1:3,]
  #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"], "")

  descriptionTable[1:3,]$p <- descriptionTable2$sig
  #Format the table for final output
  descriptionTable <- rbind(descriptionTable, c("Total", sum(descriptionTable[,2]), sum(descriptionTable[,3]), NA, NA, NA))
  descriptionTable$Source[3] <- "Interaction"
  descriptionTable[2,which(is.na(descriptionTable[2,]))] <- " "
  descriptionTable[3,which(is.na(descriptionTable[3,]))] <- " "
  descriptionTable[4,which(is.na(descriptionTable[4,]))] <- " "
  descriptionTable[5,which(is.na(descriptionTable[5,]))] <- " "
  columnNames <- colnames(descriptionTable)
  rowNames <- descriptionTable[,1]
  descriptionTable <- data.frame(lapply(descriptionTable, function(x) str_replace_all(x, "0\\.", ".")))
  colnames(descriptionTable) <- columnNames
  descriptionTable[,1] <- rowNames

  descriptionTable <- kable_classic(kable(
    descriptionTable,
    format = "html",
    booktabs = TRUE,
    caption = paste0("Figure ", figureNumber, ". Scheirer-Ray-Hare test of ", 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)
}