test fixes to match remove args

philchalmers · Jul 25, 2024 · f244278 · f244278
1 parent e01a9a0
commit f244278
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 27 deletions.
diff --git a/R/SimCollect.R b/R/SimCollect.R
@@ -183,9 +183,13 @@ SimCollect <- function(files = NULL, filename = NULL,
     if(length(unique(sapply(readin, ncol))) > 1L)
         stop('Number of columns in the replications not equal')
     Design.ID <- sapply(readin, \(x) SimExtract(x, 'Design.ID'))
-    if(is.matrix(Design.ID))
-        Design.ID <- Design.ID[,1L, drop=TRUE]
-    unique.set.index <- unique(Design.ID)
+    if(is.matrix(Design.ID)){
+        set.index <- rep(1L, ncol(Design.ID))
+        Design.ID <- Design.ID[,1]
+    } else {
+        set.index <- Design.ID
+    }
+    unique.set.index <- unique(set.index)
     full_out <- vector('list', length(unique.set.index))
     readin.old <- readin
     errors.old <- errors
@@ -196,9 +200,9 @@ SimCollect <- function(files = NULL, filename = NULL,
     warnings_info <- lapply(readin.old, \(x) SimExtract(x, 'warnings',
                                                         append=FALSE, fuzzy=FALSE))
     for(j in unique.set.index){
-        readin <- readin.old[which(j == Design.ID)]
-        errors <- errors.old[which(j == Design.ID)]
-        warnings <- warnings.old[which(j == Design.ID)]
+        readin <- readin.old[which(j == set.index)]
+        errors <- errors.old[which(j == set.index)]
+        warnings <- warnings.old[which(j == set.index)]
         try_errors <- as.data.frame(matrix(0L, nrow(readin[[1L]]), length(nms)))
         caught_warnings <- as.data.frame(matrix(0L, nrow(readin[[1L]]), length(nms)))
         names(try_errors) <- nms

diff --git a/tests/tests/test-02-aggregate.R b/tests/tests/test-02-aggregate.R
@@ -107,18 +107,18 @@ test_that('aggregate', {
     expect_true(is.null(SimExtract(Final, 'results')))
     SimClean(dir()[grepl('\\.rds', dir())])
 
-    tmp <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect,
-                         replications = 2, parallel=FALSE, save_results = TRUE, verbose = FALSE)
-    tmp2 <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect,
-                         replications = 2, parallel=FALSE, save_results = TRUE,
-                         verbose = FALSE)
-
-    dirs <- c(SimExtract(tmp, 'save_results_dirname'),
-              SimExtract(tmp2, 'save_results_dirname'))
-    SimCollect(dirs = dirs)
-    row1 <- readRDS('SimDesign_aggregate_results/results-row-1.rds')
-    expect_equal(nrow(row1$results), 4L)
-    SimClean(dirs = c(dirs, "SimDesign_aggregate_results"))
+    # tmp <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect,
+    #                      replications = 2, parallel=FALSE, save_results = TRUE, verbose = FALSE)
+    # tmp2 <- runSimulation(Design, generate=mysim, analyse=mycompute, summarise=mycollect,
+    #                      replications = 2, parallel=FALSE, save_results = TRUE,
+    #                      verbose = FALSE)
+
+    # dirs <- c(SimExtract(tmp, 'save_results_dirname'),
+    #           SimExtract(tmp2, 'save_results_dirname'))
+    # SimCollect(dirs = dirs)
+    # row1 <- readRDS('SimDesign_aggregate_results/results-row-1.rds')
+    # expect_equal(nrow(row1$results), 4L)
+    # SimClean(dirs = c(dirs, "SimDesign_aggregate_results"))
 
     # seeds
     # TODO this fails, but it shouldn't be used anyway
@@ -170,7 +170,7 @@ test_that('aggregate', {
     SimClean(dir()[grepl('\\.rds', dir())])
 
     #results
-    tmp <- runSimulation(rbind(Design, Design), generate=mysim, analyse=mycompute, summarise=mycollect, verbose=FALSE,
+    tmp <- runSimulation(expandDesign(Design, 2), generate=mysim, analyse=mycompute, summarise=mycollect, verbose=FALSE,
                          replications = 2, parallel=FALSE, save_results = TRUE, max_errors = Inf)
     compname = Sys.info()["nodename"]
     DIR <- paste0("SimDesign-results_", compname)
@@ -187,6 +187,7 @@ test_that('aggregate', {
     expect_is(row1to5, 'list')
     expect_equal(length(row1to5), 5)
     SimClean(results = TRUE)
+    # SimClean(dirs=DIR)
 
     # reSummarise test
     mycomputeGood <- function(condition, dat, fixed_objects){
@@ -245,10 +246,11 @@ test_that('aggregate', {
                              generate=mygenerate, analyse=mycompute3, summarise=mycollect,
                              parallel=FALSE, save_results = TRUE, verbose = FALSE,
                              save_details = list(save_results_dirname = 'dir3'))
-    SimCollect(dirs = c('dir1', 'dir2', 'dir3'))
-    expect_true(dir.exists('SimDesign_aggregate_results'))
-    expect_equal(6, nrow(readRDS('SimDesign_aggregate_results/results-row-1.rds')$results))
-    SimClean(dirs = c('SimDesign_aggregate_results','dir1', 'dir2', 'dir3'))
+    # SimCollect(dirs = c('dir1', 'dir2', 'dir3'))
+    # expect_true(dir.exists('SimDesign_aggregate_results'))
+    # expect_equal(6, nrow(readRDS('SimDesign_aggregate_results/results-row-1.rds')$results))
+    # SimClean(dirs = c('SimDesign_aggregate_results','dir1', 'dir2', 'dir3'))
+    SimClean(dirs = c('dir1', 'dir2', 'dir3'))
 
     mycompute <- function(condition, dat, fixed_objects){
         if(sample(c(FALSE, TRUE), 1, prob = c(.9, .1))) stop('error')
@@ -265,10 +267,11 @@ test_that('aggregate', {
                              generate=mygenerate, analyse=mycompute, summarise=mycollect,
                              parallel=FALSE, save_results = TRUE, verbose = FALSE,
                              save_details = list(save_results_dirname = 'dir2'))
-    SimCollect(dirs = c('dir1', 'dir2'))
-    expect_true(dir.exists('SimDesign_aggregate_results'))
-    expect_equal(4, length(readRDS('SimDesign_aggregate_results/results-row-1.rds')$results))
-    SimClean(dirs = c('SimDesign_aggregate_results','dir1', 'dir2'))
+    # SimCollect(dirs = c('dir1', 'dir2'))
+    # expect_true(dir.exists('SimDesign_aggregate_results'))
+    # expect_equal(4, length(readRDS('SimDesign_aggregate_results/results-row-1.rds')$results))
+    # SimClean(dirs = c('SimDesign_aggregate_results','dir1', 'dir2'))
+    SimClean(dirs = c('dir1', 'dir2'))
 
     ## warning and other information
     mysim_ew <- function(condition, fixed_objects){