add SUMMARISE column when needed

Author: philchalmers

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SimDesign
 Title: Structure for Organizing Monte Carlo Simulation Designs
-Version: 2.19.2
+Version: 2.19.3
 Authors@R: c(person("Phil", "Chalmers", email = "[email protected]", role = c("aut", "cre"),
                     comment = c(ORCID="0000-0001-5332-2810")),
              person("Matthew", "Sigal", role = c("ctb")),

NEWS.md

@@ -1,5 +1,11 @@
 # NEWS file for SimDesign
 
+## Changes in SimDesign 2.20
+
+- When `summarise()` returns a `list` this information is now stored in a column
+  `SUMMARISE` in the final simulation object. This replaces the previous
+  `SimExtract()` approach to index the same information
+
 ## Changes in SimDesign 2.19.1
 
 - `print.Design()` gains a `show.IDs` flag to show the internally stored condition

R/SimExtract.R

@@ -16,10 +16,8 @@
 #'   \code{'error_seeds'} and \code{'warning_seeds'}
 #'   to extract the associated \code{.Random.seed} values associated with the ERROR/WARNING messages,
 #'   \code{'results'} to extract the simulation results if the option \code{store_results} was passed to
-#'   \code{\link{runSimulation}}, \code{'filename'} and \code{'save_results_dirname'} for extracting
-#'   the saved file/directory name information (if used),
-#'   and \code{'summarise'} if the \code{\link{Summarise}}
-#'   definition returned a named \code{list} rather than a named numeric vector.
+#'   \code{\link{runSimulation}}, and \code{'filename'} and \code{'save_results_dirname'} for extracting
+#'   the saved file/directory name information (if used)
 #'
 #'   Note that \code{'warning_seeds'} are not stored automatically in
 #'   simulations and require passing \code{store_warning_seeds = TRUE} to \code{\link{runSimulation}}.
@@ -181,16 +179,6 @@ extract_seeds <- function(object){
     ret
 }
 
-extract_summarise <- function(object){
-    extra_info <- attr(object, 'extra_info')
-    Design <- SimExtract(object, 'Design')
-    nms <- apply(Design, 1L, function(x)
-        paste0(colnames(Design), "=", x, collapse = ' ; '))
-    ret <- extra_info$summarise_list
-    names(ret) <- nms
-    ret
-}
-
 fuzzy_reduce <- function(df){
     if(!length(df)) return(df)
     nms <- colnames(df)

R/runSimulation.R

@@ -158,9 +158,9 @@
 #'   each \code{design} condition. Return of this function, in order
 #'   of increasing complexity, should be: a named numeric vector or \code{data.frame}
 #'   with one row, a \code{matrix} or \code{data.frame} with more than one row, and,
-#'   failing these more atomic types, a named \code{list}. For summary objects that
-#'   are not easily appended to the original \code{design} object use
-#'   \code{\link{SimExtract}} with the option \code{what = 'summarise'}.
+#'   failing these more atomic types, a named \code{list}. When a \code{list} is returned
+#'   the final simulation object will contain a column \code{SUMMARISE} containing the
+#'   summary results for each respective condition
 #'
 #'   Note that unlike the Generate and Analyse
 #'   steps, the Summarise portion is not as important to perfectly organize
@@ -1663,10 +1663,14 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
     if(!is.null(Final$REPLICATIONS)) replications <- Final$REPLICATIONS
     Final$SIM_TIME <- Final$ID <- Final$COMPLETED <-
         Final$REPLICATIONS <- Final$REPLICATION <- Final$FATAL_TERMINATION <- NULL
+    SUMMARISE <- if(any(!sapply(summarise_list, is.null))){
+        summarise_list
+    } else rep(NA, nrow(Final))
     Final <- data.frame(Final, FATAL_TERMINATION,
                         REPLICATIONS=replications, SIM_TIME=SIM_TIME,
                         RAM_USED=memory_used,
                         COMPLETED, check.names=FALSE, stringsAsFactors=FALSE)
+    if(!all(is.na(SUMMARISE))) Final$SUMMARISE <- SUMMARISE
     if(all(is.na(Final$FATAL_TERMINATION))) Final$FATAL_TERMINATION <- NULL
     if(is.null(Final$SEED)) Final$SEED <- NA
     if(!is.null(seed)) Final$SEED <- seed
@@ -1718,9 +1722,7 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
                                       error_seeds=dplyr::as_tibble(error_seeds),
                                       warning_seeds=dplyr::as_tibble(warning_seeds),
                                       stored_results = if(store_results) stored_Results_list else NULL,
-                                      summarise_list=summarise_list, Design.ID=Design.ID)
-    if(!is.null(summarise_list[[1L]]) && verbose)
-        message('Note: To extract Summarise() results use SimExtract(., what = \'summarise\')')
+                                      Design.ID=Design.ID)
     if(dummy_run) Final$dummy_run <- NULL
     class(Final) <- c('SimDesign', class(Final))
     if(!is.null(filename)){ #save file

man/SimExtract.Rd

@@ -66,10 +66,27 @@ test_that('SimDesign', {
         return(ret)
     }
 
+    mycollect_list <-  function(condition, results, fixed_objects){
+
+        #find results of interest here
+        nms <- c('welch', 'independent')
+        lessthan.05 <- EDR(results[,nms], alpha = .05)
+
+        # return the results that will be appended to the Design input
+        ret <- list(lessthan.05=lessthan.05, something=42)
+        return(ret)
+    }
+
     Final <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect,
                            replications = 2, parallel=FALSE, save=FALSE, verbose = FALSE)
     expect_is(Final, 'data.frame')
 
+    # list in summarise
+    Final <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect_list,
+                           replications = 2, parallel=FALSE, save=FALSE, verbose = FALSE)
+    expect_is(Final, 'data.frame')
+    expect_is(Final$SUMMARISE, 'list')
+
     mycollect <-  function(condition, results, fixed_objects){
 
         # return the results that will be appended to the Design input