Merge pull request #49 from epi-sam/dev

v0.3.3 - metadata builder now trims otherPkgs from sessionInfo; increment_file_version

ChangeLog.md

@@ -2,6 +2,17 @@ ChangeLog for SamsElves Package
 
 --------------------------------------------------------------------------------
 
+## 2024-09-23 v.0.3.3
+
+- updated:
+  - `build_metadata_shell`
+    - now trims sessionInfo for `otherPkgs` as well as `loadedOnly` to reduce metadata bloat.
+- added:
+  - `increment_file_version`
+    - adds a `_v1`/`_v2`/etc. to the end of a file name to increment the version number
+    - retains original file extension
+
+
 ## 2024-09-19 v.0.3.2
 
 - updated:

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: SamsElves
 Title: Helper functions for the data science at IHME
-Version: 0.3.2
+Version: 0.3.3
 Author: Sam Byrne ([email protected])
 Description: Helper functions for the data science at IHME
 License: none

NAMESPACE

@@ -13,6 +13,7 @@ export(datetime_stamp)
 export(extract_sessionInfo)
 export(extract_submission_commands)
 export(find_file_extension)
+export(increment_file_version)
 export(is_empty)
 export(is_sequential_int_vec)
 export(make_directory)

R/build_metadata_shell.R

@@ -381,24 +381,29 @@ extract_sessionInfo <- function(
     )
 ){
   si <- sessionInfo()
-  # Pull out necessary bits of package info
-  pkg_list <- si$loadedOnly
-
-  pkg_extract <- lapply(pkg_list, function(pkg){
-
-    pkg_fields <- lapply(seq_along(fields), function(idx) {
-      if(fields[idx] %in% names(pkg)) {
-        field_info <- pkg[[fields[idx]]]
-      } else {
-        field_info <- NA_character_
-      }
-      return(field_info)
+
+  # Pull out necessary bits of package info for various sub-lists under the
+  # sessionInfo list
+  for(sublist in c("loadedOnly", "otherPkgs")){
+
+    pkg_info_extracted <- lapply(si[[sublist]], function(pkg){
+
+      pkg_fields <- lapply(seq_along(fields), function(idx) {
+        if(fields[idx] %in% names(pkg)) {
+          field_info <- pkg[[fields[idx]]]
+        } else {
+          field_info <- NA_character_
+        }
+        return(field_info)
+      })
+
+      names(pkg_fields) <- fields
+      return(pkg_fields)
     })
 
-    names(pkg_fields) <- fields
-    return(pkg_fields)
-  })
+    si[[sublist]] <- pkg_info_extracted
+
+  }
 
-  si$loadedOnly <- pkg_extract
   return(si)
 }

R/submit_job.R

@@ -211,7 +211,7 @@ submit_job <- function(
   if(length(job_id) > 1) warning("job_id from submitted job '",  job_name ,"' is longer than 1, inspect before use.")
   job_id <- as.integer(unlist(job_id))
 
-  if(verbose)   message(paste("\n", array_message, submission_return, " : ", job_name, "\n"))
+  if(verbose)   message(paste("\n", submission_return, array_message, " : ", job_name, "\n"))
   if(v_verbose) message("Logs saved to: \n", paste0(unique(c(std_out_path, std_err_path)), collapse = "\n"), "\n")
 
   return(job_id)

R/utils_io.R

@@ -151,3 +151,41 @@ read_file <- function(path_to_file, verbose = FALSE, csv_opt = "data.table::frea
 
   return(read_fun(path_to_file, ...))
 }
+
+#' If a file exists, get a new path with `v1`, `v2`, etc. appended
+#'
+#' If file does not exist, return the original path
+#'
+#' @param outpath [chr] full path to file
+#'
+#' @return [chr] new path with version number appended (if necessary)
+#' @export
+#'
+#' @examples
+#' dir.create(tempdir(), recursive = TRUE, showWarnings = FALSE)
+#' fname_old <- "test_file.csv"
+#' file.create(file.path(tempdir(), fname_old))
+#' list.files(tempdir()) # [1] "test_file.csv"
+#' fname_new <- increment_file_version(file.path(tempdir(), "test_file.csv"))
+#' file.create(fname_new)
+#' list.files(tempdir()) # 1] "test_file_v1.csv" "test_file.csv"
+#' file.remove(c(file.path(tempdir(), fname_old), fname_new))
+increment_file_version <- function(outpath){
+  if(file.exists(outpath)){
+    fname_og <- basename(outpath)
+    fname_split <- strsplit(fname_og, "\\.")[[1]]
+    dirname_og <- dirname(outpath)
+    outpath_new <- file.path(dirname_og, paste0(fname_split[1], "_v1", ".", fname_split[2]))
+    idx <- 2
+
+    while(file.exists(outpath_new)){
+      fname_new <- paste0(fname_split[1], "_v", idx, ".", fname_split[2])
+      outpath_new <- file.path(dirname_og, paste0(fname_new))
+      idx <- idx + 1
+    }
+  } else {
+    outpath_new <- outpath
+  }
+
+  return(outpath_new)
+}