GCL-R-Scripts/load_objects.R at master · krshedd/GCL-R-Scripts · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
load_objects <- function(path, pattern = NULL, rds = FALSE) {

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # This function loads R objects saved with `dput` or 'saveRDS', this is
  # a wrapper for 'dget' and 'readRDS'.
  #
  # Inputs~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  #   path - character vector of where the objects you wish to load reside
  #
  #   pattern - optinal argument so you can manually specify a pattern (i.e., specific object)
  #
  #   rds - logical; if set to TRUE the function will load files in rds format.
  #                  if set to FALSE the function will load test files produced by 'dput'
  #                  default is FALSE for backwards compatablity.
  #
  # Outputs~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  #   Returns a character vector of objects loaded
  #
  # Example~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # setwd("V:/Analysis/1_SEAK/Sockeye/Mixture/Lynn Canal Inseason/2018/")
  # load_objects(path = "Objects", pattern = "^loci") - just loads loci objects from "Objects" dir
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  if(!require("pacman")) install.packages("pacman"); library(pacman); pacman::p_load(tidyverse)  # Install packages, if not in library and then load them

  if(rds){extension <- ".rds"}else{extension <- ".txt"}

  if(is.null(pattern)){

    files_to_load <-  list.files(path = path, pattern = paste0("*", extension), full.names = FALSE)

    if(length(files_to_load)==0){stop(paste0("There are no '", extension, "'files in the path provided"))}

  } else{

    files_to_load <-  list.files(path = path, pattern = paste0("*", extension), full.names = FALSE)

    files_to_load <-  stringr::str_subset(files_to_load, pattern = pattern)

    if(length(files_to_load)==0){stop(paste0("There are no '", extension, "'files containing the pattern ", "'", pattern, "' in the path provided"))}

  }

  if(length(files_to_load)==0){stop(paste0("No files contain the pattern ", "'", pattern, "'"))}

  objects <- invisible(sapply(files_to_load, function(file) {

    obj <- unlist(strsplit(x = file, split = extension))

    if(rds){

      assign(x = obj, value = readRDS(file = paste(path, file, sep = "/")), pos = 1)

    }else{

      assign(x = obj, value = dget(file = paste(path, file, sep = "/")), pos = 1)

    }

    obj

  }, USE.NAMES = FALSE))

  print(objects)

}