R/csReport.R

In AngelosPsy/condir: Computation of P Values and Bayes Factors for Conditioning Data

#' Report results of conditioning data
#'
#' @description Report results of data analyses run with the \code{csCompare}.
#' @param csCompareObj a list or data frame returned from
#' the \code{csCompare} function. The object should be of class csCompare.
#' @param csSensitivityObj Sensitivity analysis results returned from the
#' \code{csSensitivity} function.  The object should be of class csSensitivity.
#' @param save If \code{code} argument is set to \code{FALSE} (default), the
#' results are printed on the screen. Otherwise, a '.txt' file with the
#' report is generated.
#' @param fileName The file name of the produced report. The argument is
#' ignored if \code{save} is set to \code{FALSE}.
#' @param alphaLevel The alpha level to be used for determining significant
#' or non-significant results.
#' @param interpretation Should an interpretation of the results be included?
#'  (FALSE). In case of the Bayesian results, the results
#'  are interpreted according to Lee and Wagenmakers (2013).
#' @examples
#' set.seed(1000)
#' tmp <- csCompare(cs1 = rnorm(n = 100, mean = 10),
#' cs2 = rnorm(n = 100, mean = 9))
#' csReport(tmp)
#' @export
csReport <-
  function(csCompareObj = NULL,
           csSensitivityObj = NULL,
           save = FALSE,
           fileName = "report",
           alphaLevel = 0.05,
           interpretation = FALSE) {
    if (is.null(csCompareObj) && is.null(csSensitivityObj)) {
      rep <- "[No report was produced.]"
    }
    
    if (!is.null(csCompareObj)) {
      # Check whether the csCompareObj has been generated by
      # the csCompare function.
      if (!inherits(csCompareObj,  "csCompare")) {
        stop("The csCompareObj is not of class csCompare.")
      } else {
        # Create objects based on the results
        for (i in 1:ncol(csCompareObj$freq.results)) {
          assign(names(csCompareObj$freq.results)[i],
                 csCompareObj$freq.results[[i]])
        }
        for (i in 1:ncol(csCompareObj$bayes.results)) {
          assign(names(csCompareObj$bayes.results)[i],
                 csCompareObj$bayes.results[[i]])
        }
        
        # Solution to 'no visible binding for global variable' note
        t.statistic <- t.statistic
        p.value <- p.value
        rscale <- rscale
        bf10 <- bf10
        bf01 <- bf01
        df <- df
        cohenD <- cohenD
        cohenDM <- cohenDM
        
        # Name CSs
        cs1 <- rownames(csCompareObj$descriptives)[1]
        cs2 <- rownames(csCompareObj$descriptives)[2]
        
        # Define symbol for reporting p value
        r.p.value <- ifelse (p.value < 0.001, "< 0.001",
                             paste(" = ", round(p.value, 3)))
        
        # Change the phrasing when an one sided t-tests was used
        alternative <-  paste(strsplit(as.character(alternative), ".",
                                       fixed = TRUE)[[1]], collapse = " ")
        
        # Change case for method
        method <- tolower(method)
        
        # Correct in case of Welch
        if (grepl("welch", method)) {
          method <- gsub("welch", "Welch", method)
        }
        # Report frequentist results
        repF <- paste0(
          "We performed a ",
          alternative,
          " ",
          method,
          ". The results are t (",
          round(df, 3),
          ") ",
          "= ",
          round(t.statistic, 3),
          ", p ",
          r.p.value,
          ", Cohen's d = ",
          round(cohenD, 3),
          " (",
          cohenDM,
          " effect size)."
        )
        
        if (interpretation) {
          # Report whether there are significant or non-significant results
          paired <-
            ifelse(as.character(method) == "paired t-test", TRUE, FALSE)
          p.val <- as.numeric(as.character(p.value))
          if (paired && p.val < alphaLevel) {
            inter <-
              paste0(
                " These results suggest that there are statistically significant differences between ",
                cs1,
                " and ",
                cs2,
                " for an alpha level of ",
                alphaLevel,
                "."
              )
          } else if (paired && p.val >= alphaLevel) {
            inter <-
              paste0(
                " These results suggest that there are no statistically significant differences between ",
                cs1,
                " and ",
                cs2,
                " for an alpha level of ",
                alphaLevel,
                "."
              )
          } else if (!paired && p.val < alphaLevel) {
            inter <-
              paste0(
                " These results suggest that there are statistically significant between group differences, for an alpha level of ",
                alphaLevel,
                "."
              )
          } else if (!paired && p.val >= alphaLevel) {
            inter <-
              paste0(
                " These results suggest that there are no statistically significant between group differences, for an alpha level of ",
                alphaLevel,
                "."
              )
          }
          
          repF <- paste0(repF, inter, sep = "\n\n")
        }
        # Report Bayesian results
        # Adjust symbol for BF factor
        
        repB <- paste0(
          "\nWe performed a ",
          alternative,
          " Bayesian t-test, with a Cauchy prior, with its width set to ",
          rscale,
          ". The BF01 was: ",
          condir::roundBF(bf01, rscale, BF01 = TRUE),
          ". The BF10 was: ",
          condir::roundBF(bf10, rscale, BF01 = FALSE),
          "."
        )
        
        if (interpretation) {
          # Determine level of evidence for bf10
          if (bf10 > 0 && bf10 < 1) {
            interbf10 <- "no"
          } else if (bf10 >= 1 && bf10 < 3) {
            interbf10 <- "anecdotal"
          } else if (bf10 >= 3 && bf10 < 10) {
            interbf10 <- "substantial"
          } else if (bf10 >= 10 && bf10 < 30) {
            interbf10 <- "strong"
          }  else if (bf10 >= 30 && bf10 < 100) {
            interbf10 <- "very strong"
          }  else if (bf10 > 100) {
            interbf10 <- "decisive"
          }
          
          interbf10 <-
            paste0("The results suggest that there is ",
                   interbf10,
                   " evidence for H1, relative to H0.")
          
          # Determine level of evidence for bf01
          if (bf01 > 0 && bf01 < 1) {
            interbf01 <- "no"
          } else if (bf01 >= 1 && bf10 < 3) {
            interbf01 <- "anecdotal"
          } else if (bf01 >= 3 && bf01 < 10) {
            interbf01 <- "substantial"
          } else if (bf01 >= 10 && bf01 < 30) {
            interbf01 <- "strong"
          }  else if (bf01 >= 30 && bf01 < 100) {
            interbf01 <- "very strong"
          }  else if (bf01 > 100) {
            interbf01 <- "decisive"
          }
          
          interbf01 <-
            paste("The results suggest that there is",
                  interbf01,
                  "evidence for H0, relative to H1.")
          
          repB <- paste(repB, interbf10, interbf01, sep = "\n\n")
        }
        
        repCompare <- paste(repF, repB, collapse = " ")
      }
      
      
    }
    if (!is.null(csSensitivityObj)) {
      # Check whether the csSensitivityObj has been generated by
      # the csSensitivity function.
      if (!inherits(csSensitivityObj, "csSensitivity")) {
        stop("The csSensitivityObj is not of class csSensitivity.")
      } else {
        csSensitivityElement = csSensitivityObj[[1]]
        # Create objects based on the results
        for (i in 1:ncol(csSensitivityElement)) {
          assign(names(csSensitivityElement)[i], csSensitivityElement[, i])
        }
        # Report Sensitivity analysis results
        repB <-
          paste0(
            "We performed a Sensitivity Analysis using the scaling factors: ",
            paste(rscale, collapse = ", "),
            ". The results for BF01 were: ",
            paste(
              mapply(
                condir::roundBF,
                as.numeric(as.character(bf01)),
                rscale,
                BF01 = TRUE
              ),
              collapse = ", "
            ),
            " respectively.",
            " The results for BF10 were: ",
            paste(
              mapply(
                condir::roundBF,
                as.numeric(as.character(bf10)),
                rscale,
                BF01 = FALSE
              ),
              collapse = ", "
            ),
            " respectively."
          )
      }
      repSensitivity <- paste(repB, collapse = " ")
    }
    
    # Check which reports should be exported
    if (!is.null(csCompareObj) && !is.null(csSensitivityObj)) {
      rep <- paste(repCompare, repSensitivity)
    } else if (!is.null(csCompareObj) && is.null(csSensitivityObj)) {
      rep <- repCompare
    } else if (is.null(csCompareObj) && !is.null(csSensitivityObj)) {
      rep <- repSensitivity
    }
    
    # Report outliers
    # csCompare analyses
    if (!is.null(csCompareObj$res.out)) {
      report.outliers <- paste(csReport(csCompareObj$res.out))
      rep <- paste0("Main analyses\n",
                    rep,
                    "\n\n**Outliers report**\n",
                    report.outliers)
    }
    
    # csSensitivity analyses
    if (!is.null(csSensitivityObj$res.out)) {
      csSensOut <- list(csSensitivityObj$res.out)
      attr(csSensOut, "class") <- "csSensitivity"
      report.outliers <- paste(csReport(csSensitivityObj = csSensOut))
      rep <- paste0(
        "Sensitivity analyses\n",
        rep,
        "\n\n**Sensitivity analyses - Outliers report**\n",
        report.outliers
      )
    }
    
    # Save file if that is asked, otherwise print the results on screen.
    # The invisible function at the end makes sure that the results are returned
    # in case the function is assigned to an object's character.
    if (save) {
      cat(rep, file = paste0(fileName, ".txt"))
      cat("Report file saved in the following directory: ", getwd())
    } else {
      cat(rep)
      invisible(rep)
    }
  }