Merge pull request #14 from DrylandEcology/release/devel_v0.2.1

Release/devel v0.2.1

* `fetch_mukeys_spatially_NRCS_SDA()` now requires at least
  `"soilDB"` version `2.6.10` (and no longer supports `"sp"`).
* Linting updated to `lintr` >= `3.1`.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rSW2exter
 Title: Access External Data as Input for SOILWAT2 and STEPWAT2 Simulations
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: c(
   person(
     "Daniel", "Schlaepfer",
@@ -23,12 +23,11 @@ Imports:
     sf
 Suggests:
     FedData (>= 3.0.2),
-    soilDB (>= 2.5.7),
-    sp,
+    soilDB (>= 2.6.10),
     utils,
     testthat (>= 3.0.0),
-    spelling,
-    lintr (>= 3.0.0),
+    spelling (>= 2.1.0),
+    lintr (>= 3.1.0),
     covr
 Remotes:
     github::DrylandEcology/rSW2utils,

NEWS.md

@@ -1,14 +1,20 @@
+# rSW2exter v0.2.1
+* `fetch_mukeys_spatially_NRCS_SDA()` now requires at least
+  `"soilDB"` version `2.6.10` (and no longer supports `"sp"`).
+* Linting updated to `lintr` >= `3.1`.
+
+
 # rSW2exter v0.2.0
-* `fetch_mukeys_spatially_NRCS_SDA()` now handles versions of "soilDB"
+* `fetch_mukeys_spatially_NRCS_SDA()` now handles versions of `"soilDB"`
   from `2.5.7` to at least `2.6.14`.
 * `extract_soils_NRCS_SDA()` queries include now `localphase`;
   this should improve the ability to identify a component of a soil map unit
-  across NRCS data releases by a combination of
+  across `NRCS` data releases by a combination of
   `compname`, `comppct_r`, `localphase`.
 * `extract_soils_NRCS_SDA()` gains argument `only_soilcomp` which excludes
   non-soil components, i.e., those that are not "Miscellaneous areas" and
-  are not "NOTCOM" (not completed).
-* Linting updated to `lintr` >= 3 and
+  are not `"NOTCOM"` (not completed).
+* Linting updated to `lintr` >= `3.0` and
   lint workflow switched from package tests to Github Action (#5).
 
 # rSW2exter v0.1.0

R/extract_soils_Miller1998_CONUSSoils.R

@@ -567,7 +567,7 @@ extract_soils_Miller1998_CONUSSoil <- function(
     if (all(var_stxt3 %in% colnames(res))) {
       has_vals <-
         complete.cases(res[, var_stxt3]) &
-        apply(res[, var_stxt3, drop = FALSE], 1, sum, na.rm = TRUE) > 0
+        rowSums(res[, var_stxt3, drop = FALSE], na.rm = TRUE) > 0
 
       res[has_vals, var_stxt3] <- rSW2utils::scale_rounded_by_sum(
         x = res[has_vals, var_stxt3],

R/extract_soils_NRCS_SDA.R

@@ -235,7 +235,7 @@ calculate_soil_depth_NRCS <- function(
         )
         ids_ph_restricted <- which(
           xc[, "check"] & !is.na(xc[, "ph1to1h2o_r"]) &
-          xc[, "ph1to1h2o_r"] <= 3.5
+            xc[, "ph1to1h2o_r"] <= 3.5
         )
 
         c(
@@ -388,10 +388,10 @@ calculate_soil_depth_NRCS <- function(
     MARGIN = 1,
     FUN = function(x) {
       !is.na(x[[1L]]) &
-      x[[1L]] > 0 &
-      x[[2L]] == 0 &
-      !is.na(x[[3L]]) &
-      x[[3L]] > 0
+        x[[1L]] > 0 &
+        x[[2L]] == 0 &
+        !is.na(x[[3L]]) &
+        x[[3L]] > 0
     }
   )
   locs_table_depths[ids, "SoilDepth_cm"] <- locs_table_depths[ids, "depth_L1"]
@@ -457,23 +457,15 @@ fetch_mukeys_spatially_NRCS_SDA <- function(
 
   stopifnot(
     requireNamespace("soilDB"),
-    "db" %in% methods::formalArgs(soilDB::SDA_spatialQuery),
     curl::has_internet()
   )
 
-  vsoilDB <- getNamespaceVersion("soilDB")
 
   #------ Make sure inputs are correctly formatted
   db <- match.arg(db)
 
-  if (vsoilDB >= as.numeric_version("2.6.10")) {
-    locations <- rSW2st::as_points(x, to_class = "sf", crs = crs)
-    nxlocs <- nrow(locations)
-  } else {
-    stopifnot(requireNamespace("sp"))
-    locations <- rSW2st::as_points(x, to_class = "sp", crs = crs)
-    nxlocs <- length(locations)
-  }
+  locations <- rSW2st::as_points(x, to_class = "sf", crs = crs)
+  nxlocs <- nrow(locations)
 
 
   #--- Extract mukeys for each point location
@@ -505,13 +497,9 @@ fetch_mukeys_spatially_NRCS_SDA <- function(
   for (k in seq_len(N_chunks)) {
     res_mukeys <- try(
       soilDB::SDA_spatialQuery(
-        geom = locations[ids_chunks[[k]], ],
+        geom = locations[ids_chunks[[k]], ], # sf since soilDB v2.6.10
         db = db,
-        what = if (vsoilDB >= as.numeric_version("2.6.3")) {
-          "mupolygon"
-        } else {
-          "geom"
-        }
+        what = "mupolygon" # since soilDB v2.6.3
       ),
       silent = FALSE
     )
@@ -528,25 +516,16 @@ fetch_mukeys_spatially_NRCS_SDA <- function(
       # Extract mukey for each location because
       # return values of `SDA_spatialQuery` are not ordered by input `geom`
       # (unless `byFeature = TRUE` since v2.6.10)
-      res[[k]] <- if (inherits(locations, "sf")) {
-        ids <- unlist(unclass(
-          sf::st_intersects(locations[ids_chunks[[k]], ], res_mukeys)
-        ))
-        as.vector(res_mukeys[ids, "mukey", drop = TRUE])
-
-      } else if (inherits(locations, "Spatial")) {
-        # sp is only used if soilDB < 2.6.10
-        sp::over(
-          x = sp::spTransform(
-            locations[ids_chunks[[k]], ],
-            CRSobj = sp::proj4string(res_mukeys)
-          ),
-          y = res_mukeys
-        )[, "mukey"]
-
-      } else {
-        stop(class(res_mukeys), "/", class(locations), " is not implemented.")
+      tmp <- sf::st_intersects(locations[ids_chunks[[k]], ], res_mukeys)
+      ltmp <- lengths(tmp)
+
+      if (any(ltmp == 0L, ltmp > 1L)) {
+        stop("Spatial SDA query return no or more than one result.")
       }
+
+      res[[k]] <- as.vector(
+        res_mukeys[unlist(unclass(tmp)), "mukey", drop = TRUE]
+      )
     }
 
     if (has_progress_bar) {
@@ -718,16 +697,14 @@ fetch_soils_from_NRCS_SDA <- function(
     tmp_sql <- paste(sql, collapse = " ")
     res[[k]] <- suppressMessages(soilDB::SDA_query(tmp_sql))
 
-    if (length(res) > 0) {
-      if (inherits(res[[k]], "try-error")) {
-        message(
-          "Error produced during call to `soilDB::SDA_query`; ",
-          "result will be set to NULL; query leading to error was: ",
-          tmp_sql
-        )
-        warning(res[[k]])
-        res[[k]] <- NULL
-      }
+    if (length(res) > 0 && inherits(res[[k]], "try-error")) {
+      message(
+        "Error produced during call to `soilDB::SDA_query`; ",
+        "result will be set to NULL; query leading to error was: ",
+        tmp_sql
+      )
+      warning(res[[k]])
+      res[[k]] <- NULL
     }
 
     if (has_progress_bar) {
@@ -960,12 +937,14 @@ extract_soils_NRCS_SDA <- function(
 
   if (FALSE) {
     # e.g., unique soil units defined by mukey-component combinations
+    # nolint start: object_usage_linter.
     tmp_tag <- apply(
       locs_keys[, c("mukey", "compname", "comppct_r", "localphase")],
       MARGIN = 1,
       FUN = function(x) paste0(as.integer(x[[1L]]), "_", x[[2L]])
     )
     locs_keys[, "unit_id"] <- match(tmp_tag, unique(tmp_tag))
+    # nolint end: object_usage_linter.
   }
 
 
@@ -989,13 +968,15 @@ extract_soils_NRCS_SDA <- function(
 
   if (FALSE) {
     # e.g., unique soil units defined by mukey-compname combinations
+    # nolint start: object_usage_linter.
     tmp_tag2 <- apply(
       res[, c("MUKEY", "compname", "comppct_r", "localphase")],
       MARGIN = 1,
       FUN = function(x) paste0(as.integer(x[[1L]]), "_", x[[2L]])
     )
     ids <- match(tmp_tag2, tmp_tag)
     res[, "unit_id"] <- locs_keys[ids, "unit_id"]
+    # nolint end: object_usage_linter.
   }
 
 
@@ -1279,7 +1260,7 @@ extract_soils_NRCS_SDA <- function(
     if (all(var_stxt3 %in% colnames(res))) {
       has_vals <-
         complete.cases(res[, var_stxt3]) &
-        apply(res[, var_stxt3, drop = FALSE], 1, sum, na.rm = TRUE) > 0
+        rowSums(res[, var_stxt3, drop = FALSE], na.rm = TRUE) > 0
 
       res[has_vals, var_stxt3] <- rSW2utils::scale_rounded_by_sum(
         x = res[has_vals, var_stxt3],
@@ -1326,8 +1307,8 @@ extract_soils_NRCS_SDA <- function(
   ids_h0 <- which(locs_table_depths[, "N_horizons"] == 0)
   if (
     length(ids_h0) > 0 &&
-    !missing(x) &&
-    method == "SSURGO_then_STATSGO"
+      !missing(x) &&
+      method == "SSURGO_then_STATSGO"
   ) {
 
     # Call again for nosoil rows and extract from STATSGO instead of SSURGO

R/extract_soils_POLARIS.R

@@ -567,7 +567,7 @@ extract_soils_POLARIS <- function(
       for (k in seq_len(N_layers)) {
         has_vals <-
           complete.cases(res[, var_stxt3, k]) &
-          apply(res[, var_stxt3, k, drop = FALSE], 1, sum, na.rm = TRUE) > 0
+          rowSums(res[, var_stxt3, k, drop = FALSE], na.rm = TRUE) > 0
 
         res[has_vals, var_stxt3, k] <- rSW2utils::scale_rounded_by_sum(
           x = res[has_vals, var_stxt3, k],

tests/testthat/test_soils_NRCS_SDA.R

@@ -98,6 +98,7 @@ test_that("Extract soils from NRCS SDA", {
   x[, "organic"] <- is_NRCS_horizon_organic(x)
   expect_true(all(x[, "organic"] %in% c(NA, FALSE, TRUE)))
 
+  # nolint start: implicit_assignment_linter.
   expect_silent(
     sd1 <- calculate_soil_depth_NRCS(
       x,
@@ -120,6 +121,7 @@ test_that("Extract soils from NRCS SDA", {
       var_soiltexture = var_soiltexture
     )
   )
+  # nolint end: implicit_assignment_linter.
 
   expect_true(all(expected_depth_variables %in% colnames(sd1)))
   expect_true(