From 39f9b336e2ec23883035ec17734af728d8c38a01 Mon Sep 17 00:00:00 2001 From: mitchellmanware Date: Fri, 19 Jul 2024 15:02:14 -0400 Subject: [PATCH] calc_lagged() bug --- R/calculate_covariates.R | 4 +- R/download.R | 14 ++- man/calc_modis_par.Rd | 2 +- man/download_koppen_geiger.Rd | 3 +- man/download_merra2.Rd | 1 - man/download_modis.Rd | 7 +- man/download_nlcd.Rd | 3 +- tests/testthat/test-calculate_covariates.R | 109 ++++++++++----------- 8 files changed, 77 insertions(+), 66 deletions(-) diff --git a/R/calculate_covariates.R b/R/calculate_covariates.R index 273cb256..3646882e 100644 --- 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 index 881a17ce..a0fefee1 100644 --- 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 index 36671d32..6e21eecf 100644 --- a/man/calc_modis_par.Rd +++ b/man/calc_modis_par.Rd @@ -37,7 +37,7 @@ Default is \code{c(0, 1000, 10000, 50000)}.} \item{name_covariates}{character. Name header of covariates. e.g., \code{"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.} diff --git a/man/download_koppen_geiger.Rd b/man/download_koppen_geiger.Rd index ecf33f6e..a0043815 100644 --- a/man/download_koppen_geiger.Rd +++ b/man/download_koppen_geiger.Rd @@ -68,7 +68,8 @@ download_koppen_geiger( } } \references{ -\insertRef{article_beck2023koppen, article_beck2018present}{amadeus} +\insertRef{article_beck2023koppen}{amadeus} +\insertRef{article_beck2018present}{amadeus} } \author{ Mitchell Manware, Insang Song diff --git a/man/download_merra2.Rd b/man/download_merra2.Rd index 240dba5d..66280632 100644 --- a/man/download_merra2.Rd +++ b/man/download_merra2.Rd @@ -129,7 +129,6 @@ download_merra2( \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} diff --git a/man/download_modis.Rd b/man/download_modis.Rd index e8082152..c32a306a 100644 --- a/man/download_modis.Rd +++ b/man/download_modis.Rd @@ -114,7 +114,12 @@ download_modis( } } \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} } \author{ Mitchell Manware, Insang Song diff --git a/man/download_nlcd.Rd b/man/download_nlcd.Rd index 93241d4c..db33662f 100644 --- a/man/download_nlcd.Rd +++ b/man/download_nlcd.Rd @@ -66,7 +66,8 @@ download_nlcd( } } \references{ -\insertRef{dewitz_national_2023, dewitz_national_2024}{amadeus} +\insertRef{dewitz_national_2023}{amadeus} +\insertRef{dewitz_national_2024}{amadeus} } \author{ Mitchell Manware, Insang Song diff --git a/tests/testthat/test-calculate_covariates.R b/tests/testthat/test-calculate_covariates.R index 3c32a985..2567b1c4 100644 --- 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 + ) + ) +})