Merge pull request #10 from Spatiotemporal-Exposures-and-Toxicology/r…

…emove_stdt check_mysftime() and check_mysf() creation and unit testing
NIEHS · Feb 14, 2024 · e00db14 · e00db14
2 parents 064ff78 + e8bde46
commit e00db14
Show file tree

Hide file tree

Showing 9 changed files with 260 additions and 39 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -12,12 +12,12 @@ Authors@R: c(
     )
 Description: A Mechanism/Machine for Data, Environments, and User Setup package for health and climate research. It is fully tested, versioned, and open source and open access.
 Depends: R (>= 4.1.0)
-Imports: dplyr, sf, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringr, testthat (>= 3.0.0), doParallel, parallelly, stars, foreach, future
-Suggests: covr, withr, knitr, rmarkdown, sftime, lwgeom, FNN, doRNG
+Imports: dplyr, sf, sftime, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringr, testthat (>= 3.0.0), doParallel, parallelly, stars, foreach, future
+Suggests: covr, withr, knitr, rmarkdown, lwgeom, FNN, doRNG
 Encoding: UTF-8
 VignetteBuilder: knitr, rmarkdown
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
 Config/Needs/website: tidyverse/tidytemplate
 Config/testhat/edition: 3
 License: MIT + file LICENSE

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,8 @@ export(calc_nlcd_ratio)
 export(calc_temporal_dummies)
 export(calc_tri)
 export(check_for_null_parameters)
+export(check_mysf)
+export(check_mysftime)
 export(check_url_status)
 export(check_urls)
 export(convert_stdt)
@@ -54,6 +56,8 @@ export(modis_worker)
 export(read_commands)
 export(test_download_functions)
 import(rvest)
+import(sf)
+import(sftime)
 importFrom(data.table,.SD)
 importFrom(data.table,as.data.table)
 importFrom(data.table,fread)

diff --git a/R/download_test_support.R b/R/download_test_support.R
@@ -26,7 +26,7 @@ check_url_status <- function(
   }
 
   status <- hd$status_code
-  Sys.sleep(0.5)
+  Sys.sleep(2)
   return(status == http_status_ok)
 }
 

diff --git a/R/manipulate_spacetime_data.R b/R/manipulate_spacetime_data.R
@@ -122,6 +122,43 @@ is_stdt <- function(obj) {
   }
 }
 
+#' Check if the sftime object is formated on a specific way
+#'
+#' @param x a sftime object
+#' @import sftime
+#' @author Eva Marques
+#' @export
+check_mysftime <- function(x) {
+  stopifnot(
+    "x is not a sftime" = class(x)[1] == "sftime",
+    "x is not inherited from a data.table" =
+      class(x)[3] == "data.table",
+    "time column should be called time" =
+      attributes(x)$time_column == "time",
+    "geometry column should be called geometry" =
+      attributes(x)$sf_column == "geometry",
+    "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT"
+  )
+}
+
+#' Check if the sf object is formated on a specific way
+#'
+#' @param x a sf object
+#' @import sf
+#' @author Eva Marques
+#' @export
+check_mysf <- function(x) {
+  stopifnot(
+    "x is not a sf" = class(x)[1] == "sf",
+    "x is not inherited from a data.table" =
+      class(x)[2] == "data.table",
+    "geometry column should be called geometry" =
+      attributes(x)$sf_column == "geometry",
+    "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT"
+  )
+}
+
+
 
 #' Convert a stdt to sf/sftime/SpatVector
 #' @param stdt A stdt object

diff --git a/man/check_mysf.Rd b/man/check_mysf.Rd
diff --git a/man/check_mysftime.Rd b/man/check_mysftime.Rd
diff --git a/tests/testdata/spacetime_table.csv b/tests/testdata/spacetime_table.csv
@@ -0,0 +1,28 @@
+id,lat,lon,time,var1,var2
+3804,39.349998,-81.433334,1990-01-01T00:00:00Z,35,Tmax
+3804,39.349998,-81.433334,1990-01-02T00:00:00Z,42,Tmax
+3804,39.349998,-81.433334,1990-01-03T00:00:00Z,49,Tmax
+3810,35.733334,-81.383331,1990-01-01T00:00:00Z,55,Tmax
+3810,35.733334,-81.383331,1990-01-02T00:00:00Z,45,Tmax
+3810,35.733334,-81.383331,1990-01-03T00:00:00Z,59,Tmax
+3811,35.599998,-88.916664,1990-01-01T00:00:00Z,45,Tmax
+3811,35.599998,-88.916664,1990-01-02T00:00:00Z,46,Tmax
+3811,35.599998,-88.916664,1990-01-03T00:00:00Z,60,Tmax
+3804,39.349998,-81.433334,1990-01-01T00:00:00Z,35,Tmin
+3804,39.349998,-81.433334,1990-01-02T00:00:00Z,42,Tmin
+3804,39.349998,-81.433334,1990-01-03T00:00:00Z,49,Tmin
+3810,35.733334,-81.383331,1990-01-01T00:00:00Z,55,Tmin
+3810,35.733334,-81.383331,1990-01-02T00:00:00Z,45,Tmin
+3810,35.733334,-81.383331,1990-01-03T00:00:00Z,59,Tmin
+3811,35.599998,-88.916664,1990-01-01T00:00:00Z,45,Tmin
+3811,35.599998,-88.916664,1990-01-02T00:00:00Z,46,Tmin
+3811,35.599998,-88.916664,1990-01-03T00:00:00Z,60,Tmin
+3804,39.349998,-81.433334,1990-01-01T00:00:00Z,0,Precip
+3804,39.349998,-81.433334,1990-01-02T00:00:00Z,0,Precip
+3804,39.349998,-81.433334,1990-01-03T00:00:00Z,0.0099999998,Precip
+3810,35.733334,-81.383331,1990-01-01T00:00:00Z,0,Precip
+3810,35.733334,-81.383331,1990-01-02T00:00:00Z,0,Precip
+3810,35.733334,-81.383331,1990-01-03T00:00:00Z,0,Precip
+3811,35.599998,-88.916664,1990-01-01T00:00:00Z,0,Precip
+3811,35.599998,-88.916664,1990-01-02T00:00:00Z,0,Precip
+3811,35.599998,-88.916664,1990-01-03T00:00:00Z,0.81999998,Precip
diff --git a/tests/testthat/test-download_functions.R b/tests/testthat/test-download_functions.R
@@ -288,7 +288,7 @@ testthat::test_that("MERRA2 download URLs have HTTP status 200.", {
     # extract urls
     urls <- extract_urls(commands = commands, position = 2)
     # check HTTP URL status
-    url_status <- check_urls(urls = urls, size = 30L, method = "HEAD")
+    url_status <- check_urls(urls = urls, size = 3L, method = "HEAD")
     # implement unit tests
     test_download_functions(directory_to_save = directory_to_save,
                             commands_path = commands_path,