calc_lagged() bug

NIEHS · Jul 19, 2024 · 39f9b33 · 39f9b33
1 parent ca40d94
commit 39f9b33
Show file tree

Hide file tree

Showing 8 changed files with 77 additions and 66 deletions.
diff --git a/R/calculate_covariates.R b/R/calculate_covariates.R
@@ -728,7 +728,7 @@ calc_modis_daily <- function(
 #' @param name_covariates character. Name header of covariates.
 #' e.g., `"MOD_NDVIF_0_"`.
 #' The calculated covariate names will have a form of
-#' '{name_covariates}{zero-padded buffer radius in meters}',
+#' "{name_covariates}{zero-padded buffer radius in meters}",
 #' e.g., 'MOD_NDVIF_0_50000' where 50 km radius circular buffer
 #' was used to calculate mean NDVI value.
 #' @param subdataset Indices, names, or search patterns for subdatasets.
@@ -2504,7 +2504,7 @@ calc_lagged <- function(
   #### check input data types
   if ("SpatVector" %in% class(from)) {
     from_full <- terra::as.data.frame(from, geom = "WKT")
-    geoms <- unique(from_full[, c("site_id", "geometry")])
+    geoms <- unique(from_full[, c(locs_id, "geometry")])
     from <- from_full |> dplyr::select(-"geometry")
   }
   stopifnot(methods::is(from, "data.frame"))

diff --git a/R/download.R b/R/download.R
@@ -838,7 +838,6 @@ download_gmted <- function(
 #' \insertRef{data_gmao_merra-tavgM_3d_udt_Np}{amadeus}
 #' \insertRef{data_gmao_merra-tavgM_3d_odt_Np}{amadeus}
 #' \insertRef{data_gmao_merra-tavgM_3d_qdt_Np}{amadeus}
-#' \insertRef{data_gmao_merra-statD_2d_slv_Nx}{amadeus}
 #' \insertRef{data_gmao_merra-const_2d_asm_Nx}{amadeus}
 #' \insertRef{data_gmao_merra-instU_2d_asm_Nx}{amadeus}
 #' \insertRef{data_gmao_merra-instU_2d_int_Nx}{amadeus}
@@ -1329,7 +1328,8 @@ download_narr <- function(
 #' respective sub-directories within \code{directory_to_save}.
 #' @importFrom Rdpack reprompt
 #' @references
-#' \insertRef{dewitz_national_2023, dewitz_national_2024}{amadeus}
+#' \insertRef{dewitz_national_2023}{amadeus}
+#' \insertRef{dewitz_national_2024}{amadeus}
 #' @examples
 #' \dontrun{
 #' download_nlcd(
@@ -2025,7 +2025,8 @@ download_hms <- function(
 #' respective sub-directories within \code{directory_to_save}.
 #' @importFrom Rdpack reprompt
 #' @references
-#' \insertRef{article_beck2023koppen, article_beck2018present}{amadeus}
+#' \insertRef{article_beck2023koppen}{amadeus}
+#' \insertRef{article_beck2018present}{amadeus}
 #' @examples
 #' \dontrun{
 #' download_koppen_geiger(
@@ -2176,7 +2177,12 @@ download_koppen_geiger <- function(
 #' \code{directory_to_save}.
 #' @importFrom Rdpack reprompt
 #' @references
-#' \insertRef{data_mcd19a22021, data_mod06l2_2017, data_mod09ga2021, data_mod11a12021, data_mod13a22021, article_roman2018vnp46}{amadeus}
+#' \insertRef{data_mcd19a22021}{amadeus}
+#' \insertRef{data_mod06l2_2017}{amadeus}
+#' \insertRef{data_mod09ga2021}{amadeus}
+#' \insertRef{data_mod11a12021}{amadeus}
+#' \insertRef{data_mod13a22021}{amadeus}
+#' \insertRef{article_roman2018vnp46}{amadeus}
 # nolint end
 #' @examples
 #' \dontrun{

diff --git a/man/calc_modis_par.Rd b/man/calc_modis_par.Rd
diff --git a/man/download_koppen_geiger.Rd b/man/download_koppen_geiger.Rd
diff --git a/man/download_merra2.Rd b/man/download_merra2.Rd
diff --git a/man/download_modis.Rd b/man/download_modis.Rd
diff --git a/man/download_nlcd.Rd b/man/download_nlcd.Rd
diff --git a/tests/testthat/test-calculate_covariates.R b/tests/testthat/test-calculate_covariates.R
@@ -1832,61 +1832,6 @@ testthat::test_that("calc_lagged returns as expected.", {
   }
 })
 
-## 17.1 calc_lag with SpatVector
-testthat::test_that("calc_lagged error with SpatVector.", {
-  withr::local_package("terra")
-  withr::local_package("data.table")
-  ncp <- data.frame(lon = -78.8277, lat = 35.95013)
-  ncp$site_id <- "3799900018810101"
-  ncpv <- terra::vect(ncp, geom = c("lon", "lat"), crs = "EPSG:4326")
-  # expect function
-  testthat::expect_true(
-    is.function(calc_lagged)
-  )
-  narr <-
-    process_narr(
-      date = c("2018-01-01", "2018-01-10"),
-      variable = "weasd",
-      path =
-      testthat::test_path(
-        "..",
-        "testdata",
-        "narr",
-        "weasd"
-      )
-    )
-  narr_covariate_geom <-
-    calc_narr(
-      from = narr,
-      locs = ncpv,
-      locs_id = "site_id",
-      radius = 0,
-      fun = "mean",
-      geom = TRUE
-    )
-  testthat::expect_no_error(
-    narr_covariate_geom_lag <- calc_lagged(
-      from = narr_covariate_geom,
-      date = c("2018-01-03", "2018-01-05"),
-      lag = 1,
-      locs_id = "site_id",
-      time_id = "time",
-      geom = TRUE
-    )
-  )
-  testthat::expect_s4_class(narr_covariate_geom_lag, "SpatVector")
-  testthat::expect_error(
-    calc_lagged(
-      from = as.data.frame(narr_covariate_geom),
-      date = c("2018-01-03", "2018-01-05"),
-      lag = 1,
-      locs_id = "site_id",
-      time_id = "time",
-      geom = TRUE
-    )
-  )
-})
-
 ## 18. Wrapper ####
 testthat::test_that("calc_covariates wrapper works", {
 
@@ -2029,3 +1974,57 @@ testthat::test_that("calc_worker remaining", {
   )
   testthat::expect_s3_class(cwres, "data.frame")
 })
+
+## 17.1 calc_lag with SpatVector
+testthat::test_that("calc_lagged with SpatVector.", {
+  withr::local_package("terra")
+  withr::local_package("data.table")
+  loc <- data.frame(id = "001", lon = -78.8277, lat = 35.95013)
+  locs_v <- terra::vect(loc, geom = c("lon", "lat"), crs = "EPSG:4326")
+  # expect function
+  testthat::expect_true(
+    is.function(calc_lagged)
+  )
+  p <-
+    process_narr(
+      date = c("2018-01-01", "2018-01-10"),
+      variable = "weasd",
+      path =
+      testthat::test_path(
+        "..",
+        "testdata",
+        "narr",
+        "weasd"
+      )
+    )
+  c <-
+    calc_narr(
+      from = p,
+      locs = locs_v,
+      locs_id = "id",
+      radius = 0,
+      fun = "mean",
+      geom = TRUE
+    )
+  testthat::expect_no_error(
+    c_g <- calc_lagged(
+      from = c,
+      date = c("2018-01-03", "2018-01-05"),
+      lag = 1,
+      locs_id = "id",
+      time_id = "time",
+      geom = TRUE
+    )
+  )
+  testthat::expect_s4_class(c_g, "SpatVector")
+  testthat::expect_error(
+    calc_lagged(
+      from = as.data.frame(c_g),
+      date = c("2018-01-03", "2018-01-05"),
+      lag = 1,
+      locs_id = "id",
+      time_id = "time",
+      geom = TRUE
+    )
+  )
+})