R/SimWarnings.R

In SimDesign: Structure for Organizing Monte Carlo Simulation Designs

#' Extract Simulation Warnings
#'
#' Extractor function in situations where \code{\link{runSimulation}} returned a simulation
#' with detected \code{WARNINGS}.
#'
#' @param obj object returned from \code{\link{runSimulation}} containing an \code{WARNINGS} column
#'
#' @param subset logical; take a subset of the \code{design} object showing only conditions that
#'   returned warnings?
#'
#' @references
#'
#' Chalmers, R. P., & Adkins, M. C.  (2020). Writing Effective and Reliable Monte Carlo Simulations
#' with the SimDesign Package. \code{The Quantitative Methods for Psychology, 16}(4), 248-280.
#' \doi{10.20982/tqmp.16.4.p248}
#'
#' Sigal, M. J., & Chalmers, R. P. (2016). Play it again: Teaching statistics with Monte
#' Carlo simulation. \code{Journal of Statistics Education, 24}(3), 136-156.
#' \doi{10.1080/10691898.2016.1246953}
#'
#' @author Phil Chalmers \email{rphilip.chalmers@@gmail.com}
#'
#' @seealso \code{\link{SimErrors}}, \code{\link{SimExtract}}
#'
#' @export
#'
#' @examples
#'
#' sample_sizes <- c(10, 20)
#' standard_deviations <- 1
#'
#' Design <- createDesign(N1=sample_sizes,
#'                        N2=sample_sizes,
#'                        SD=standard_deviations)
#' Design
#'
#' Generate <- function(condition, fixed_objects){
#'     Attach(condition)
#'     group1 <- rnorm(N1)
#'     group2 <- rnorm(N2, sd=SD)
#'     dat <- data.frame(group = c(rep('g1', N1), rep('g2', N2)),
#'                       DV = c(group1, group2))
#'     dat
#' }
#'
#' # functions to throw warnings
#' fn1 <- function(){
#'   if(sample(c(TRUE, FALSE), 1, prob = c(.1, .9))) warning('Show this warning')
#'   1
#'  }
#'
#' fn2 <- function(){
#'     if(sample(c(TRUE, FALSE), 1, prob = c(.1, .9))) warning('Show a different warning')
#'     1
#' }
#'
#' Analyse <- function(condition, dat, fixed_objects){
#'   if(with(condition, N1 != N2)){
#'     out1 <- fn1()
#'     out2 <- fn2()
#'   }
#'   c(ret = 1)
#' }
#'
#' Summarise <- function(condition, results, fixed_objects) {
#'   ret <- colMeans(results)
#'   ret
#' }
#'
#' # print warning messages and their frequency
#' res <- runSimulation(design=Design, replications=10, generate=Generate,
#'                      analyse=Analyse, summarise=Summarise)
#' res |> select(N1, N2, SD, WARNINGS)
#' SimWarnings(res)
#' SimWarnings(res, subset=FALSE)
#'
#'
SimWarnings <- function(obj, subset=TRUE){
    if(!any(colnames(obj) == 'WARNINGS')) return(dplyr::tibble())
    warnings <- obj$WARNINGS
    pick <- which(warnings > 0)
    ret <- SimExtract(obj, what='warnings')
    if(subset) ret <- ret[pick, ]
    ret
}