first draft template-Main.R

template-main.R

@@ -0,0 +1,308 @@
+#Template master.R
+
+# INSTRUCTIONS:
+#
+# Step 1: Packages
+#
+# If the README specifies packages that need to be manually installed, add them 
+# to readme.libraries on line 248.
+
+# Step 2: rootdir setup
+# 
+# Identify the base directory of your replication package. If the author has an 
+#rproj file or a .here file, rootdir will be set there. Otherwise, in bash, set 
+# your working directory to the base directory, and type
+# "touch .here"
+#
+# If for some reason that does not work (and it always should)
+# manually override in line 76 of this file.
+
+
+# Step 3: Script order
+#
+# At the end of this file, add R scripts to author.programs in the order specified 
+# in the README. If the author provides a main or master file, likely only that 
+# file must be added.
+
+
+# Step 4: Make sure this script carries over
+#
+# Check any author scripts you're running for lines like rm(list = ls(all = TRUE))
+# These will clear your environment and rootdir will no longer work. Comment these
+# lines out
+
+# Step 5: Run code and generate log files
+# 
+# From the Terminal (not Console) tab within Rstudio:
+#     R CMD BATCH --verbose --vanilla main.R main.$(date +%F_%H-%M-%S).Rout 
+# For alternative ways to do that, see 
+# https://github.com/labordynamicsinstitute/replicability-training/wiki/R-Tips
+
+#*================================================
+#* Let's do everything verbosely
+
+options(verbose=TRUE)
+
+#*================================================
+#* Let's capture the current working directory, so we can return to it later
+temphome <- getwd()
+
+#*================================================
+#* If you're running this script in terminal, you may get an  error about trying
+#* to use CRAN without setting a mirror. This line tells R where to install 
+#* packages from to avoid this error
+
+options(repos = c(CRAN = "https://cloud.r-project.org"))
+
+#*==============================================================================================*/
+#* This is specific to AEA replication environment. May not be needed if no 
+#* confidential data are used in the reproducibility check. Replicator should
+#* check the JIRA field "Working location of restricted data" for right path  */
+
+sdrive <- ""
+
+#*================================================
+#* This lists any paths, relative to the root directory, that are to be created
+
+create.paths <- c("logs")
+# For instance, the following paths might be necessary
+# create.paths <- c("data/raw","data/interwrk","data/generated","results")
+
+################################################
+# Setup for automatic basepath detection       #
+################################################
+
+# rootdir <- "path/to/root/directory"
+rootdir <- ""
+
+####################################
+# global libraries used everywhere #
+####################################
+
+posit.date <- Sys.Date() - 31
+# posit.date <- "2020-01-01" # uncomment and set manually if the above does not work
+
+# PPM only snapshots on weekdays (not sure why...)
+# Only check for weekday if posit.date is a Date object, not a string
+if (!is.character(posit.date) && weekdays(posit.date) %in% c("Saturday","Sunday")) {
+  posit.date <- posit.date - 2
+}
+
+# Check if running on Linux
+if (Sys.info()['sysname'] == "Linux") {
+  # Try to determine the Linux distribution and version using /etc/os-release
+  if (file.exists("/etc/os-release")) {
+    os_release <- system("grep -E '^(ID|VERSION_ID|VERSION_CODENAME|ID_LIKE)=' /etc/os-release", intern = TRUE)
+
+    # Extract distribution ID (like ubuntu, debian, rocky)
+    distro_id <- gsub("ID=", "", grep("^ID=", os_release, value = TRUE))
+    distro_id <- gsub("[\"']", "", distro_id) # Remove quotes if present
+
+    # Extract version ID (like 9.4 for Rocky Linux)
+    version_id <- gsub("VERSION_ID=", "", grep("^VERSION_ID=", os_release, value = TRUE))
+    version_id <- gsub("[\"']", "", version_id) # Remove quotes if present
+
+    # Extract codename (like focal, jammy, bullseye)
+    codename <- gsub("VERSION_CODENAME=", "", grep("^VERSION_CODENAME=", os_release, value = TRUE))
+
+    # Extract ID_LIKE (like rhel, centos, fedora)
+    id_like <- gsub("ID_LIKE=", "", grep("^ID_LIKE=", os_release, value = TRUE))
+    id_like <- gsub("[\"']", "", id_like) # Remove quotes if present
+
+    # If we found Ubuntu or Debian
+    if (length(distro_id) > 0 && grepl("^(ubuntu|debian)$", distro_id)) {
+      # Set CRAN to binary PPM for Ubuntu/Debian
+      options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/__linux__/", codename, "/", posit.date)))
+      message(paste0("Using binary PPM for Linux distribution: ", distro_id, " (", codename, ")"))
+    } else if (length(distro_id) > 0 && distro_id == "rocky" && grepl("^9", version_id)) {
+      # Set CRAN to binary PPM for Rocky Linux 9
+      options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/__linux__/rhel9/", posit.date)))
+      message(paste0("Using binary PPM for Linux distribution: ", distro_id, " (version ", version_id, ")"))
+    } else if (length(distro_id) > 0 && distro_id == "opensuse-leap" && version_id == "15.6") {
+      # Set CRAN to binary PPM for opensuse-leap 15.6
+      options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/__linux__/opensuse156/",posit.date)))
+      message(paste0("Using binary PPM for Linux distribution: ", distro_id, " (version ", version_id, ")"))
+    } else {
+      # Use standard PPM with date-based snapshot for other Linux
+      options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/", posit.date)))
+    }
+  } else {
+    # Use standard PPM with date-based snapshot if os-release not available
+    options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/", posit.date)))
+  }
+} else {
+  # Use standard PPM with date-based snapshot for non-Linux systems
+  options(repos = c(CRAN = paste0("https://packagemanager.posit.co/cran/", posit.date)))
+}
+
+# print option repos 
+message(paste0("Setting Posit Package Manager snapshot to ",posit.date))
+message("If this does not work, set the date manually in line 22")
+getOption("repos")
+
+# Note: if any package in an renv lockfile is missing a recorded repository, 
+# renv::restore() will use the PPM date from options("repos"), meaning it will 
+# use *your* PPM date, not the author's
+
+####################################
+# Set path to root directory       #
+#                                  #
+####################################
+
+options(renv.consent = TRUE)
+
+if (!requireNamespace("here", quietly = TRUE)) install.packages("here")
+if ( rootdir == "" ) rootdir <- here::here()
+setwd(rootdir)
+
+# Main directories
+
+for ( dir in create.paths){
+	if (file.exists(file.path(rootdir,dir))){
+	} else {
+	dir.create(file.path(rootdir,dir))
+	}
+}
+
+# In order to make config.R run smoothly, turn off prompts asking if we want to
+# install packages
+
+options(renv.config.autoloader.enabled = TRUE)
+options(renv.config.install.prompt = FALSE)
+
+# renv.lock checks
+
+# How many directory levels to search for an author-provided renv.lock,
+# relative to rootdir. Increase if you can see the author's renv.lock is more than
+# 1 directory level up or down from rootdir
+
+lockfile.search.up   <- 1
+lockfile.search.down <- 1
+
+find_author_lockfile <- function(rootdir, up = 1, down = 1) {
+
+  candidates <- data.frame(path = character(0), distance = integer(0))
+
+  # check rootdir itself
+  self_check <- file.path(rootdir, "renv.lock")
+  if (file.exists(self_check)) {
+    candidates <- rbind(candidates, data.frame(path = self_check, distance = 0))
+  }
+
+  # check upwards from rootdir
+  current <- rootdir
+  for (i in seq_len(up)) {
+    parent <- dirname(current)
+    if (parent == current) break  # hit filesystem root
+    candidate <- file.path(parent, "renv.lock")
+    if (file.exists(candidate)) {
+      candidates <- rbind(candidates, data.frame(path = candidate, distance = i))
+    }
+    current <- parent
+  }
+
+  # check downwards from rootdir
+  if (down > 0) {
+    subdirs <- list.dirs(rootdir, recursive = TRUE, full.names = TRUE)
+    for (d in subdirs) {
+      depth <- length(strsplit(sub(paste0("^", rootdir), "", d), .Platform$file.sep)[[1]]) - 1
+      if (depth >= 1 && depth <= down) {
+        candidate <- file.path(d, "renv.lock")
+        if (file.exists(candidate)) {
+          candidates <- rbind(candidates, data.frame(path = candidate, distance = depth))
+        }
+      }
+    }
+  }
+
+  if (nrow(candidates) == 0) return(NULL)
+  candidates <- candidates[order(candidates$distance), ]
+  candidates$path[1]
+}
+
+lockfile_path <- find_author_lockfile(rootdir, up = lockfile.search.up, down = lockfile.search.down)
+
+# If the author's renv.lock file was found, load their setup and switch rootdir
+# to what their code will likely expect
+if (!is.null(lockfile_path)) {
+  author_root <- dirname(lockfile_path)
+  message("Detected renv.lock at: ", lockfile_path)
+  rootdir <- author_root
+  setwd(rootdir)
+  if (!requireNamespace("renv", quietly = TRUE)) install.packages("renv")
+  renv::restore(project = author_root, prompt = FALSE)
+  renv::load(project = author_root) #uses load not activate to prevent a popup asking to switch projects, which breaks the code
+
+# If no author renv.lock file was found, create a new blank renv project
+} else {
+  message("No renv.lock found within ", lockfile.search.up, " level(s) up / ",
+          lockfile.search.down, " level(s) down. Initializing project-local renv.")
+  if (!requireNamespace("renv", quietly = TRUE)) install.packages("renv")
+  if (!file.exists(file.path(rootdir, "renv"))) renv::init(project = rootdir, bare = TRUE, restart = FALSE)
+  renv::load(project = rootdir) #uses load not activate to prevent a popup asking to switch projects, which breaks the code
+}
+
+# If missing packages, add them here to install into the project's renv library
+#(not base R library) so they will be picked up correctly by renv::snapshot() below
+
+readme.libraries <- c() #ex: c("paletteer", "viridis")
+
+# Install packages from readme.libraries
+
+  pkgTest <- function(x)
+  {
+    if (!require(x,character.only = TRUE))
+    {
+      renv::install(x,prompt = FALSE)
+      if(!require(x,character.only = TRUE)) stop("Package not found")
+    }
+    return("OK")
+  }
+
+invisible(lapply(readme.libraries,pkgTest))
+
+# Get information on the system we are running on
+Sys.info()
+R.version
+
+# Return to the directory we started in
+setwd(temphome)
+
+# Keep these lines in the config file
+message("======================================================================================================")
+message(paste0(" Current working directory: ",getwd()))
+print(sessionInfo())
+message("Current libPaths:")
+message(.libPaths())
+message(print(list.files(.libPaths()[1])))
+
+message("Done with configuration.")
+
+
+####################################
+# Run author code                  #
+#                                  #
+####################################
+
+#* Add author's programs in the order listed in the README
+
+author.programs <- c(
+   "code/master.R"
+)
+
+for (prog in author.programs) {
+  message(paste0("---- Sourcing: ", prog, " ----"))
+  source(file.path(rootdir, prog), echo = TRUE)
+}
+
+# Final snapshot preserves the packages from a successful run but won't overwrite
+# the author's original. Not forced, may change later. Select option 1 so you don't
+# include `here` in the snapshot, but make sure no other packages are listed in 
+# the warning
+renv::snapshot(
+  project  = rootdir,
+  lockfile = file.path(rootdir, "renv.lock.replicator_snapshot"),
+  packages = c(renv::dependencies(rootdir)$Package, readme.libraries),
+  prompt   = FALSE
+)
+