R/tableNormality.R

In voiceR: Voice Analytics for Social Scientists

#' Create a table for Shapiro Wilk results
#'
#' This function returns a data.frame containing Shapiro Wilk results by conditions (and dimensions if "includeDimensions" is set to TRUE). Likewise, if "HTMLTable" is set to TRUE, it outputs results as an HTML table in APA style.
#'
#' @param audioData A data.frame generated by the autoExtract() function.
#' @param measure Name of the dependent variable. Default corresponds to duration.
#' @param includeDimensions Logical value indicating if different dimensions should be also included as a factor when testing for normality. Default corresponds to FALSE.
#' @param figureNumber Integer indicating the figure number, used to create the title for the table. Default corresponds to 1.
#' @param nameMeasure Optional string indicating the name to be displayed for the dependent variable in the output table. If no value is provided, the string used for the measure attribute is displayed.
#' @param HTMLTable Logical value indicating if an HTML table should be generated. Default corresponds to FALSE.
#' @return If "HTMLTable" is set to FALSE, this function returns a data.frame with Shapiro-Wilk test results for each condition (if condition column exists) and dimension (if dimension column exists and "includeDimensions" is set to TRUE). Otherwise an HTML table showing test results in APA formatting style is created.
#' @examples
#' tableNormality(testAudioData, measure = "duration")
#'
#' @importFrom stats shapiro.test
#' @importFrom kableExtra kable_classic footnote
#' @importFrom knitr kable
#' @export

tableNormality <- function(audioData, measure = "duration", includeDimensions = FALSE, figureNumber = 1, nameMeasure = c(), HTMLTable = FALSE){
  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(length(audioData))
  if(!is.numeric(audioData[,measure])){
    stop("Variable selected using measure is not numeric")
  }


  #Create empty data.frame
  normalityData <- as.data.frame(matrix(ncol =  ifelse("Condition" %in% colnames(audioData) & includeDimensions, 5, 4), nrow = ifelse("Condition" %in% colnames(audioData) & includeDimensions, nrow(expand.grid(unique(audioData$Condition), unique(audioData$Dimension))) + 1, ifelse("Condition" %in% colnames(audioData), length(unique(audioData$Condition)) + 1, 1))))
  #Set column names
  if("Condition" %in% colnames(audioData) & includeDimensions){
    colnames(normalityData) <- c("Condition", "Dimension", "N", "W", "pValue")
  }else{
    colnames(normalityData) <- c("Condition", "N", "W", "pValue")
  }


  normalityData$Condition[1] <- "General"
  #If dimensions are included and conditions too, generate all possible combinations of conditions and dimensions and check normality for these
  if("Condition" %in% colnames(audioData) & includeDimensions){
    normalityData$Dimension[1] <- "General"
    tempCombinations <- expand.grid(unique(audioData$Condition), unique(audioData$Dimension))
    normalityData[-1,1] <- as.character(tempCombinations[,1])
    normalityData[-1,2] <- as.character(tempCombinations[,2])


    for (row in 2:nrow(normalityData)) {
      normalityData[row,]$N <-  nrow(audioData[audioData$Condition == normalityData$Condition[row] & audioData$Dimension == normalityData$Dimension[row],])

      if(sum(!is.na(audioData[audioData$Condition == normalityData$Condition[row] & audioData$Dimension == normalityData$Dimension[row], measure])) < 3){
        next
      }

      shapiroTest <- shapiro.test(audioData[audioData$Condition == normalityData$Condition[row] & audioData$Dimension == normalityData$Dimension[row], measure])
      normalityData[row,]$W <- round(shapiroTest$statistic, 2)
      normalityData[row,]$pValue <- round(shapiroTest$p.value,3)

    }


  }
  #If only conditions are present, check normality for each condition
  else if("Condition" %in% colnames(audioData)){
    normalityData$Condition[2:nrow(normalityData)] <- as.character(unique(audioData$Condition))

    for (condition in unique(audioData$Condition)) {
      normalityData[normalityData$Condition == condition,]$N <-  nrow(audioData[audioData$Condition == condition,])

      if(length(which(!is.na(audioData[audioData$Condition == condition, measure]))) < 3){
        next
      }

      shapiroTest <- shapiro.test(audioData[audioData$Condition == condition,measure])
      normalityData[normalityData$Condition == condition,]$W <- round(shapiroTest$statistic, 2)
      normalityData[normalityData$Condition == condition,]$pValue <- round(shapiroTest$p.value,3)

    }

  }
  #produce HTMLtable with the results
  if(HTMLTable && length(audioData[!is.na(audioData[,measure]), measure]) > 3){
    if(length(nameMeasure) == 0){
      nameMeasure <- measure
    }

    shapiroTest <- shapiro.test(audioData[,measure])
    normalityData$W[1] <- round(shapiroTest$statistic, 2)
    normalityData$pValue[1] <- round(shapiroTest$p.value,3)
    normalityData$N[1] <-  nrow(audioData)
    colnames(normalityData)[ncol(normalityData)] <- "p"
    descriptionTable2 <- normalityData
    #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"], "")

    normalityData$p <- descriptionTable2$sig
    normalityData <- data.frame(lapply(normalityData, function(x) str_replace_all(x, "0\\.", ".")))


    descriptionTable <- kable_classic(kable(
      normalityData,
      format = "html",
      booktabs = TRUE,
      caption = paste0("Figure ", figureNumber,". Shapiro Wilk Normality Test for ", nameMeasure, " by ", ifelse(includeDimensions, "Condition and Dimension", "Condition") )
    ), full_width = F, html_font = "Cambria")


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

  }
  #produce data.frame with the results
  else{
    if(length(audioData[!is.na(audioData[,measure]), measure]) > 3){
      shapiroTest <- shapiro.test(audioData[,measure])
      normalityData$W[1] <- round(shapiroTest$statistic, 2)
      normalityData$pValue[1] <- round(shapiroTest$p.value,3)
      normalityData$N[1] <-  nrow(audioData)
      return(normalityData)
    } else {
      text <- "Sample size was not big enough to test for normality"
      return(text)
    }
  }


}