Update ScriptLocation + Small fixes

Author: elgabbas

DESCRIPTION

@@ -3,7 +3,7 @@ Package: IASDT.R
 Title: Modelling the distribution of invasive alien plant species in
     Europe
 Version: 0.1.03
-Date: 2025-03-13
+Date: 2025-03-14
 Authors@R: 
     person("Ahmed", "El-Gabbas", , "ahmed.el-gabbas@ufz.de", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2225-088X"))

R/General_CatTime.R

@@ -56,8 +56,6 @@ CatTime <- function(
     AllArgs,
     function(x) get(x, envir = parent.env(env = environment()))) %>%
     stats::setNames(AllArgs)
-  IASDT.R::CheckArgs(
-    AllArgs = AllArgs, Type = "character", Args = "Text")
   IASDT.R::CheckArgs(
     AllArgs = AllArgs, Type = "logical",
     Args = c("Time", "Bold", "Red", "Date"))

R/General_Package_RemoteSha.R

@@ -2,34 +2,58 @@
 # Package_RemoteSha ----
 ## |------------------------------------------------------------------------| #
 
-#' Get the remote SHA of an R packages
+#' Get the remote SHA of R packages
 #'
 #' This function retrieves the remote SHA (Secure Hash Algorithm) reference for
-#' one or more specified R packages. It is useful for tracking the exact version
-#' of a package's source code.
+#' one or more specified R packages from their remote repositories. The SHA
+#' uniquely identifies the version of a package's source code, useful for
+#' reproducibility and version tracking.
+#'
 #' @name Package_RemoteSha
-#' @param ... Character. Names of one or more R packages for which to retrieve
-#'   the remote SHA.
+#' @param ... Character. Names of one or more R packages (quoted or unquoted)
+#'   for which to retrieve the remote SHA.
 #' @return A named character vector where names are the package names and values
-#'   are the corresponding remote SHAs.
+#'   are the corresponding remote SHAs. If a package is not found or has no
+#'   remote SHA, the value will be `NA`.
 #' @export
 #' @author Ahmed El-Gabbas
+#' @details The function uses `pak::lib_status()` to query the status of
+#'   installed packages and extract their remote SHAs. It supports packages
+#'   installed from GitHub, GitLab, or other remote sources via `pak`. If a
+#'   package is installed from CRAN or locally without a remote SHA, the result
+#'   will be `NA`.
 #' @examples
-#' Package_RemoteSha(IASDT.R, devtools)
+#' Package_RemoteSha(Hmsc, IASDT.R, "nonexistent")
 
 Package_RemoteSha <- function(...) {
 
-  Pk <- rlang::ensyms(...)  %>%
+  # Capture package names as symbols and convert to character strings
+  Pk <- rlang::ensyms(...) %>%
     purrr::map_chr(.f = rlang::as_string)
 
+  # Retrieve library status once for efficiency and map over packages
+  lib_status <- IASDT.R::AddMissingCols(
+    pak::lib_status(), NA_character_, "remotesha")
+
   Out <- purrr::map_chr(
     .x = Pk,
     .f = ~{
-      pak::lib_status() %>%
-        dplyr::filter(package == .x) %>%
+
+      # Filter library status for the current package
+      sha <- dplyr::filter(lib_status, package == .x) %>%
         dplyr::pull("remotesha")
+
+      # Return the SHA if found, otherwise NA
+      if (length(sha) > 0) {
+        sha
+      } else {
+        NA_character_
+      }
+
     }) %>%
+    # Name the output vector with package names
     stats::setNames(Pk)
 
+  # Return the named vector of SHAs
   return(Out)
 }

R/General_ScriptLocation.R

@@ -1,39 +1,102 @@
 ## |------------------------------------------------------------------------| #
 # ScriptLocation ----
 ## |------------------------------------------------------------------------| #
-#
+
 #' Retrieve the location of the current R script.
 #'
-#' This function attempts to find the location of the currently running R
-#' script. It first tries to identify the script's location based on the command
-#' line arguments used to start the script. If the script is being run in an
-#' interactive session within RStudio, it falls back to using the `rstudioapi`
-#' to find the file path of the script in the source editor. If the location
-#' cannot be determined, it returns `NA`.
+#' This function determines the file path of the currently executing R script.
+#' It checks command line arguments (e.g., via `Rscript`) for the script path,
+#' then in interactive sessions, it examines the call stack for the most
+#' recently sourced file, falling back to `rstudioapi` (if available and RStudio
+#' is running) when no sourcing context exists. If the location cannot be
+#' determined, it returns `NA`.
+#'
 #' @return A character string representing the file path of the current R
-#'   script, or `NA` if the path cannot be determined.
+#'   script, or `NA_character_` if the path cannot be determined (e.g., in an
+#'   unsourced interactive session without a script context).
+#'
+#' @details The function follows this priority order:
+#' - Command line arguments (`--file`) when executed via `Rscript`.
+#' - The most recent `ofile` attribute from the call stack when sourced
+#'   interactively in any R environment, supporting nested sourcing scenarios.
+#' - RStudio's active editor context via `rstudioapi` if available, RStudio is
+#'   running, and no sourcing context is found.
+#' - Returns `NA_character_` for unsourced interactive sessions or
+#'   non-interactive execution without a script path.
+#'
 #' @name ScriptLocation
-#' @source The source code of this function was taken from this
+#' @source The source code of this function was adapted from this
 #'   [stackoverflow](https://stackoverflow.com/questions/47044068/) question.
 #' @importFrom rlang .data
 #' @export
 #' @examples
-#' # ScriptLocation()
+#' \dontrun{
+#' # Save as "myscript.R": ScriptLocation()
+#' # Run: Rscript myscript.R
+#' # Output: [1] "myscript.R" (or full path depending on Rscript invocation)
+#' }
 
 ScriptLocation <- function() {
+  # Attempt to extract the script path from command line arguments (e.g.,
+  # Rscript)
   this_file <- commandArgs() %>%
+    # Convert to a tibble with a single column 'value'
     tibble::enframe(name = NULL) %>%
+    # Split each argument at '=' into 'key' and 'value'
     tidyr::separate(
-      col = .data$value, into = c("key", "value"), sep = "=",
-      fill = "right") %>%
+      col = .data$value, into = c("key", "value"),
+      sep = "=", fill = "right") %>%
+    # Keep only the '--file' argument
     dplyr::filter(.data$key == "--file") %>%
+    # Extract the value (file path)
     dplyr::pull(.data$value)
 
-  if (length(this_file) == 0) {
-    this_file <- rstudioapi::getSourceEditorContext()$path
+  if (length(this_file) > 0) {
+    # If a command-line file path is found (e.g., from Rscript), use it. This
+    # handles cases like 'Rscript myscript.R'
+    this_file <- this_file
+  } else if (interactive()) {
+    # If running interactively (R console, RStudio, etc.), check the call stack
+    # for sourced script paths
+    frame_files <- lapply(
+      X = sys.frames(),
+      FUN = function(x) {
+        # For each frame, check if 'ofile' exists (set by source()) and retrieve
+        # it
+        if (exists("ofile", envir = x)) {
+          get("ofile", envir = x)
+        } else {
+          NULL
+        }
+      })
+
+    # Flatten the list, removing NULLs
+    valid_files <- unlist(frame_files)
+    if (length(valid_files) > 0 && any(nzchar(valid_files))) {
+      # If valid file paths are found, take the most recent one (last in stack).
+      # This ensures nested sourcing returns the innermost script (e.g., TT2.R)
+      this_file <- utils::tail(valid_files[nzchar(valid_files)], 1)
+    } else if (requireNamespace("rstudioapi", quietly = TRUE) &&
+               rstudioapi::isAvailable()) {
+      # If no sourced files are found and RStudio is available, use the active
+      # editor context as a fallback (useful for unsourced code in RStudio)
+      this_file <- tryCatch(
+        # Get path of active script in RStudio
+        rstudioapi::getSourceEditorContext()$path,
+        # Return NA if RStudio call fails
+        error = function(e) NA_character_)
+    } else {
+      # No sourced files and not in RStudio: return NA (e.g., console without
+      # source)
+      this_file <- NA_character_
+    }
   } else {
+    # Non-interactive session without command-line args (unlikely case): return
+    # NA
     this_file <- NA_character_
   }
 
+  # Return the determined file path or NA
   return(this_file)
+
 }

R/General_git_log.R

@@ -32,9 +32,6 @@
 #' @author Ahmed El-Gabbas
 #' @export
 #' @examples
-#' # not a git repo
-#' git_log(Path = "C:/")
-#'
 #' # Show the most recent commit
 #' git_log(Num = 1)
 #'
@@ -47,6 +44,12 @@
 #' length(Log)
 #'
 #' head(Log, 8)
+#'
+#' \dontrun{
+#'   # not a git repo
+#'   git_log(Path = "C:/")
+#'   # #> Error: The provided path does not exist.
+#' }
 
 git_log <- function(Path = ".", Num = NULL, ReturnLog = FALSE) {
 

R/Mod_GetCV.R

@@ -130,7 +130,7 @@ Mod_GetCV <- function(
   # # 1. CV using large blocks -----
   # # |||||||||||||||||||||||||||||||||||
 
-  IASDT.R::CatTime("1. CV_Large", Level = 1)
+  IASDT.R::CatTime("1. CV_Large", Level = 1, Time = FALSE)
   CV_Large <- blockCV::cv_spatial(
     x = XY_sf, r = DT_R, hexagon = FALSE, iteration = 1000, k = CV_NFolds,
     rows_cols = c(CV_NR, CV_NC), plot = FALSE, progress = FALSE, report = FALSE)
@@ -139,7 +139,7 @@ Mod_GetCV <- function(
   # # 2. CV based on number of grid cells -----
   # # |||||||||||||||||||||||||||||||||||
 
-  IASDT.R::CatTime("2. CV_Dist", Level = 1)
+  IASDT.R::CatTime("2. CV_Dist", Level = 1, Time = FALSE)
   CV_Dist <- blockCV::cv_spatial(
     x = XY_sf, r = DT_R, hexagon = FALSE, iteration = 1000, k = CV_NFolds,
     size = CV_NGrids * raster::res(DT_R)[1], plot = FALSE, progress = FALSE,

R/Mod_Prep4HPC.R

@@ -148,39 +148,6 @@
 #' @order 1
 #' @importFrom rlang .data
 #' @author Ahmed El-Gabbas
-#' @details The current models are fitted for 8 habitat types see [Pysek et
-#'   al.](https://doi.org/10.23855/preslia.2022.447):
-#' - **1. Forests** -- closed vegetation dominated by deciduous or evergreen
-#'   trees
-#' - **2. Open forests** -- woodlands with canopy openings created by
-#'   environmental stress or disturbance, including forest edges
-#' - **3. Scrub** -- shrublands maintained by environmental stress (aridity) or
-#'   disturbance
-#' - **4a. Natural grasslands** -- grasslands maintained by climate (aridity,
-#'   unevenly distributed precipitation), herbivores or environmental stress
-#'   (aridity, instability or toxicity of substrate)
-#' - **4b. Human-maintained grasslands** -- grasslands dependent on regular
-#'   human-induced management (mowing, grazing by livestock, artificial burning)
-#' - **10. Wetland** -- sites with the permanent or seasonal influence of
-#'   moisture, ranging from oligotrophic to eutrophic
-#' - **12a. Ruderal habitats** -- anthropogenically disturbed or eutrophicated
-#'   sites, where the anthropogenic disturbance or fertilization is typically a
-#'   side-product and not the aim of the management
-#' - **12b. Agricultural habitats** -- synanthropic habitats directly
-#'   associated with growing of agricultural products, thus dependent on
-#'   specific type of management (ploughing, fertilization)
-#'
-#'   <br/>The following habitat types are excluded from the analysis:
-#' - **5. Sandy** -- dunes and other habitats on unstable sandy substrate,
-#'   stressed by low nutrients, drought and disturbed by sand movement
-#' - **6. Rocky** -- cliffs and rock outcrops with very shallow or no soil
-#' - **7. Dryland** -- habitats in which drought stress limits vegetation
-#'   development
-#' - **8. Saline** -- habitats stressed by high soil salinity
-#' - **9. Riparian** -- a mosaic of wetlands, grasslands, tall-forb stands,
-#'   scrub and open forests in stream corridors
-#' - **11. Aquatic** -- water bodies and streams with submerged and floating
-#'   plant species
 
 Mod_Prep4HPC <- function(
     Hab_Abb = NULL, DirName = NULL,
@@ -649,9 +616,9 @@ Mod_Prep4HPC <- function(
   IASDT.R::CatTime("Response - Y matrix")
   DT_y <- dplyr::select(DT_All, tidyselect::starts_with("Sp_")) %>%
     as.data.frame()
-  IASDT.R::CatTime(paste0(ncol(DT_y), " species"), Level = 1)
+  IASDT.R::CatTime(paste0(ncol(DT_y), " species"), Level = 1, Time = FALSE)
 
-  IASDT.R::CatTime("Save species summary", Level = 1)
+  IASDT.R::CatTime("Save species summary", Level = 1, Time = FALSE)
   SpSummary <- IASDT.R::Path(Path_PA, "Sp_PA_Summary_DF.RData")
   if (!file.exists(SpSummary)) {
     stop(SpSummary, " file does not exist", call. = FALSE)
@@ -682,22 +649,25 @@ Mod_Prep4HPC <- function(
     IASDT.R::CatTime(
       paste0(
         "Models will be fitted using ", length(XVars), " predictors: ",
-        paste(XVars, collapse = " + ")), Level = 1)
+        paste(XVars, collapse = " + ")), Level = 1, Time = FALSE)
   } else {
     OnlyLinear <- setdiff(XVars, QuadraticVars)
     FormVars <- c(
       OnlyLinear,
       paste0("stats::poly(", QuadraticVars, ", degree = 2, raw = TRUE)"))
 
-    IASDT.R::CatTime("Models will be fitted using:", Level = 1)
+    IASDT.R::CatTime("Models will be fitted using:", Level = 1, Time = FALSE)
 
-    IASDT.R::CatTime(paste0(length(OnlyLinear), " linear effect: "), Level = 2)
-    IASDT.R::CatTime(paste(OnlyLinear, collapse = " + "), Level = 3)
+    IASDT.R::CatTime(
+      paste0(length(OnlyLinear), " linear effect: "), Level = 2, Time = FALSE)
+    IASDT.R::CatTime(
+      paste(OnlyLinear, collapse = " + "), Level = 3, Time = FALSE)
 
     IASDT.R::CatTime(
       paste0(length(QuadraticVars), " linear and quadratic effects: "),
       Level = 2)
-    IASDT.R::CatTime(paste(QuadraticVars, collapse = " + "), Level = 3)
+    IASDT.R::CatTime(
+      paste(QuadraticVars, collapse = " + "), Level = 3, Time = FALSE)
 
   }
 
@@ -738,7 +708,7 @@ Mod_Prep4HPC <- function(
 
   IASDT.R::CatTime(
     paste0("Models will be fitted using ", paste(Tree, collapse = " & ")),
-    Level = 1)
+    Level = 1, Time = FALSE)
 
   ## # ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 
@@ -763,7 +733,7 @@ Mod_Prep4HPC <- function(
 
       IASDT.R::CatTime(
         paste0("Prepare working on parallel using ", NCores_GPP, " cores."),
-        Level = 1)
+        Level = 2, Time = FALSE)
 
       withr::local_options(
         future.globals.maxSize = 8000 * 1024^2, future.gc = TRUE,
@@ -792,7 +762,7 @@ Mod_Prep4HPC <- function(
 
     } else {
 
-      IASDT.R::CatTime("Working sequentially")
+      IASDT.R::CatTime("Working sequentially", Time = FALSE, Level = 2)
 
       GPP_Knots <- purrr::map(
         .x = GPP_Dists * 1000,
@@ -1250,7 +1220,8 @@ Mod_Prep4HPC <- function(
   IASDT.R::CatTime(
     "Save model fitting commands for batch SLURM jobs", Level = 1)
   IASDT.R::CatTime(
-    paste0("Models will be fitted in ", NSplits, " SLURM job(s)"), Level = 2)
+    paste0("Models will be fitted in ", NSplits, " SLURM job(s)"),
+    Level = 2, Time = FALSE)
 
   purrr::walk(
     .x = seq_len(NSplits),
@@ -1445,7 +1416,8 @@ Mod_Prep4HPC <- function(
 
   ## # ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 
-  IASDT.R::CatDiff(InitTime = .StartTime)
+  IASDT.R::CatDiff(
+    Prefix = "Processing modelling data took ", InitTime = .StartTime)
 
   return(invisible(NULL))
 }

README.md

@@ -74,4 +74,4 @@ If you use the `IASDT.R` package, please cite it as:
 > <a href="https://biodt.eu" target="_blank">https://biodt.eu</a>.
 
 <span style="     color: grey !important;">Last update:
-2025-03-13</span>
+2025-03-14</span>

inst/WORDLIST

@@ -212,3 +212,6 @@ sbatch
 Warton
 unevaluated
 Unevaluated
+RStudio's
+RStudio
+unsourced