manage list returns in runArraySimulation (see #42)

philchalmers · Nov 29, 2024 · d6d78f1 · d6d78f1
1 parent f69e477
commit d6d78f1
Show file tree

Hide file tree

Showing 4 changed files with 72 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: SimDesign
 Title: Structure for Organizing Monte Carlo Simulation Designs
-Version: 2.17.3
+Version: 2.17.4
 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")),

diff --git a/R/SimCollect.R b/R/SimCollect.R
@@ -278,9 +278,16 @@ SimCollect <- function(dir=NULL, files = NULL, filename = NULL,
             warnings_info <- add_cbind(warnings_info)
     } else {
         out <- do.call(rbind, full_out)
-        if(has_stored_results)
-            extra_info1$stored_results <- dplyr::bind_rows(
-                lapply(full_out, \(x) attr(x, 'extra_info')$stored_results))
+        if(has_stored_results){
+            tmp <- attr(full_out[[1]], 'extra_info')$stored_results
+            if(is(tmp, 'tbl_df')){
+                extra_info1$stored_results <- dplyr::bind_rows(
+                    lapply(full_out, \(x) attr(x, 'extra_info')$stored_results))
+            } else {
+                extra_info1$stored_results <- do.call(c,
+                    lapply(full_out, \(x) attr(x, 'extra_info')$stored_results))
+            }
+        }
         if(error_details)
             errors_info <- dplyr::bind_rows(errors_info)
         if(warning_details)

diff --git a/R/runArraySimulation.R b/R/runArraySimulation.R
@@ -347,8 +347,14 @@ runArraySimulation <- function(design, ..., replications,
            (!is.null(dots$store_results) && isTRUE(dots$store_results)))){
             results <- SimExtract(ret, 'results')
             condition <- attr(design, 'Design.ID')
-            results <- dplyr::mutate(results, arrayID=arrayID, .before=1L)
-            results <- dplyr::mutate(results, condition=condition[row], .before=1L)
+            if(is(results, 'tbl_df')){
+                results <- dplyr::mutate(results, arrayID=arrayID, .before=1L)
+                results <- dplyr::mutate(results, condition=condition[row], .before=1L)
+            } else {
+                results <- lapply(results,
+                                  \(x) c(arrayID=arrayID, condition=condition[row], x))
+                names(results) <- NULL
+            }
             attr(ret, "extra_info")$stored_results <- results
         }
         filename.u <- unique_filename(filename[i], safe=TRUE, verbose=FALSE)

diff --git a/tests/tests/test-03-array.R b/tests/tests/test-03-array.R
@@ -151,5 +151,58 @@ test_that('array', {
     setwd('..')
     SimClean(dirs='sim/')
 
+    #####################
+
+    # list return
+    Analyse_list <- function(condition, dat, fixed_objects) {
+        list(a=1:2, b=3:4)
+    }
+
+    Summarise_list <- function(condition, results, fixed_objects) {
+        42
+    }
+
+    arrayID <- 1
+
+    runArraySimulation(design=Design5, replications=10,
+                       generate=Generate, analyse=Analyse_list,
+                       summarise=Summarise_list, iseed=iseed, arrayID=arrayID,
+                       dirname='sim', filename='condition') |> invisible()
+    res <- readRDS("sim/condition-1.rds")
+    results <- SimExtract(res, 'results')
+    expect_true(is.list(results))
+    SimClean(dirs="sim/")
+
+    # emulate the arrayID distribution, storing all results in a 'sim/' folder
+    dir.create('sim/')
+
+    # Emulate distribution to nrow(Design5) = 15 independent job arrays
+    sapply(1:nrow(Design5), \(arrayID)
+           runArraySimulation(design=Design5, replications=10,
+                              generate=Generate, analyse=Analyse_list,
+                              summarise=Summarise_list, iseed=iseed, arrayID=arrayID,
+                              dirname='sim', filename='condition')) |> invisible()
+
+    files <- dir('sim/')
+    expect_true(all(files %in% paste0('condition-', 1:nrow(Design5), '.rds')))
+
+    setwd('sim')
+    condition14 <- readRDS('condition-14.rds')
+    results <- SimExtract(condition14, 'results')
+    expect_equal(results[[1]]$condition, 3)
+    expect_equal(results[[1]]$arrayID, 14)
+
+    # aggregate simulation results into single file
+    final <- SimCollect(files=dir())
+    so <- summary(final)
+    expect_equal(so$ncores, 15L)
+    results <- SimResults(final)
+
+    expect_equal(final$REPLICATIONS, c(50, 50, 50))
+    expect_equal(length(results), 150)
+
+    setwd('..')
+    SimClean(dirs='sim/')
+
 })