merge qs2 branch; closes #84

Author: philchalmers

R/SimCheck.R

@@ -54,7 +54,7 @@ SimCheck <- function(dir = NULL, files = NULL, min = 1L, max = NULL){
     files <- paste0(dir, files)
     filename <- strsplit(files[1], '-')[[1L]][1L]
     if(is.null(max)){
-        tmp <- readRDS(files[1])
+        tmp <- qs2::qd_read(files[1])
         max <- attr(tmp, 'extra_info')$number_of_conditions
     }
     minmax <- min:max

R/SimClean.R

@@ -5,8 +5,7 @@
 #' Monte Carlo simulation (e.g., remove files and folders which contained bugs/biased results).
 #'
 #' @param ... one or more character objects indicating which files to remove. Used to remove
-#'   \code{.rds} files which were saved with \code{\link{saveRDS}} or when
-#'   using the \code{filename} input to \code{\link{runSimulation}}
+#'   temp files that were saved, or for removing specific file names
 #'
 #' @param dirs a character vector indicating which directories to remove
 #'

R/SimCollect.R

@@ -243,7 +243,7 @@ SimCollect <- function(dir=NULL, files = NULL, filename = NULL, simobj=NULL,
     readin <- vector('list', length(filenames))
     for(i in 1:length(filenames)){
         if(i %in% print_when) cat(".")
-        tmp <- try(readRDS(filenames[i]), TRUE)
+        tmp <- SimRead(filenames[i])
         if(is(tmp, 'try-error'))
             stop(c('Could not read file ', filenames[i]))
         readin[[i]] <- if(!is.null(select) && length(select) == 1L &&

R/SimResults.R

@@ -105,7 +105,7 @@ SimResults <- function(obj, which, prefix = "results-row", wd = getwd(),
     stored_Results_list <- vector('list', length(which))
     for(i in seq_len(length(which))){
         pick <- which(files$file_num == which[i])
-        stored_Results_list[[i]] <- readRDS(files$files[pick])
+        stored_Results_list[[i]] <- qs2::qd_read(files$files[pick])
     }
     design <- SimExtract(obj, 'design')
     if(is(stored_Results_list[[1L]]$results, 'data.frame') ||

R/analysis.R

@@ -185,10 +185,11 @@ Analysis <- function(Functions, condition, condition.row, replications, fixed_ob
     if(summarise_asis || store_results){
         tabled_results <- toTabledResults(results)
         if(save_results){
+            browser()
             tmp <- ifelse(is.null(save_results_filename), 'results-row', save_results_filename)
             tmpfilename <- paste0(save_results_dirname,
-                                  sprintf('/%s', tmp), ID, '.rds')
-            saveRDS(list(condition=condition, results=tabled_results),
+                                  sprintf('/%s', tmp), ID)
+            qs2::qd_save(list(condition=condition, results=tabled_results),
                     file.path(save_results_out_rootdir, tmpfilename))
         }
         if(summarise_asis) return(tabled_results)
@@ -224,10 +225,10 @@ Analysis <- function(Functions, condition, condition.row, replications, fixed_ob
     if(save_results){
         tmp <- ifelse(is.null(save_results_filename), 'results-row', save_results_filename)
         tmpfilename <- paste0(save_results_dirname,
-                              sprintf('/%s', tmp), ID, '.rds')
+                              sprintf('/%s', tmp), ID)
         tmpcondition <- condition
         tmpcondition$ID <- NULL
-        saveRDS(list(condition=tmpcondition, results=results, errors=try_errors,
+        qs2::qd_save(list(condition=tmpcondition, results=results, errors=try_errors,
                      error_seeds=try_error_seeds,
                      warnings=warnings, warning_seeds=warning_message_seeds),
                 file.path(save_results_out_rootdir, tmpfilename))

R/reSummarise.R

@@ -157,7 +157,7 @@ reSummarise <- function(summarise, dir = NULL, files = NULL, results = NULL, Des
 
     for(i in 1L:length(files)){
         if(read_files){
-            inp <- readRDS(files[i])
+            inp <- SimRead(files[i])
             conditions[[i]] <- inp$condition
             summ <- if(nargs == 3)
                 try(summarise(condition=inp$condition, results=inp$results,

R/runArraySimulation.R

@@ -168,7 +168,7 @@
 #' res <- runArraySimulation(design=Design, replications=50,
 #'                       generate=Generate, analyse=Analyse,
 #'                       summarise=Summarise, arrayID=arrayID,
-#'                       iseed=iseed, filename='mysim') # saved as 'mysim-1.rds'
+#'                       iseed=iseed, filename='mysim') # saved as 'mysim-1'
 #' res
 #' SimResults(res) # condition and replication count stored
 #'

R/util.R

@@ -12,22 +12,23 @@ parent_env_fun <- function(level=2){
     ret
 }
 
-unique_filename <- function(filename, safe = TRUE, verbose = TRUE){
+unique_filename <- function(filename, safe = TRUE, verbose = TRUE,
+                            ext = '.rds'){
     if(!is.null(filename) && safe){ #save file
         filename <- gsub('.rds', "", filename)
         filename0 <- filename
         count <- 1L
         # create a new file name if old one exists, and throw warning
         while(TRUE){
-            filename <- paste0(filename, '.rds')
+            filename <- paste0(filename, ext)
             if(file.exists(filename)){
                 filename <- paste0(filename0, '-', count)
                 count <- count + 1L
             } else break
         }
         if(count > 1L)
             if(verbose && safe)
-                message(paste0('\nWARNING:\n\"', filename0, '.rds\" existed in the working directory.
+                message(paste0('\nWARNING:\n', filename0, 'existed in the working directory.
                                Using a unique file name instead.\n'))
     }
     filename
@@ -1050,3 +1051,11 @@ add_cbind <- function(lst){
     }
     dplyr::as_tibble(ret)
 }
+
+SimRead <- function(filename){
+    file_ext <- tools::file_ext(filename)
+    tmp <- if(tolower(file_ext) == 'rds')
+        try(readRDS(filename), TRUE)
+    else try(qs2::qd_read(filename), TRUE)
+    tmp
+}