test coverage improvement

.github/workflows/test-coverage-local.yaml

@@ -68,6 +68,10 @@ jobs:
         id: patch-comparison
         shell: bash
         run: |
+          if ( ! test -f cov_current.Rout ); then
+            echo "0" >> cov_current.Rout
+          fi
+
           cov_patch="${{ steps.get-values.outputs.coverage }}"
           cov_current=$(cat cov_current.Rout)
           echo "Current coverage: $cov_current"

tests/testthat/test-calculate_covariates.R

@@ -358,6 +358,13 @@ testthat::test_that("calc_modis works well.", {
       locs = sf::st_as_sf(site_faux)
     )
   )
+  testthat::expect_error(
+    calc_modis_daily(
+      from = terra::rast(nrow = 3, ncol = 3, vals = 1:9, names = "a"),
+      date = "2021-08-15",
+      locs = array(1:12, dim = c(2, 2, 3))
+    )
+  )
   site_faux0 <- site_faux
   names(site_faux0)[2] <- "date"
   testthat::expect_error(
@@ -415,7 +422,7 @@ testthat::test_that("calc_modis works well.", {
       preprocess = process_bluemarble,
       name_covariates = c("MOD_NITLT_0_", "MOD_K1_"),
       subdataset = 3L,
-      nthreads = 1,
+      nthreads = 2,
       tile_df = process_bluemarble_corners(c(9, 10), c(5, 5))
     )
   )
@@ -1655,7 +1662,54 @@ testthat::test_that("calc_check_time identifies missing `time` column.", {
 
 # Calc message
 testthat::test_that("calc_message exception",
+  {
+    testthat::expect_no_error(
+      calc_message("gmted", "mean", "2020", "year", NULL)
+    )
+    testthat::expect_no_error(
+      calc_message("narr", "shum", 2000, "year", NULL)
+    )
+  }
+)
+
+# calc time
+testthat::test_that("calc time remains", {
   testthat::expect_no_error(
-    calc_message("gmted", "mean", "2020", "year", NULL)
+    rr <- calc_time("eternal", "timeless")
   )
-)
+  testthat::expect_true(rr == "eternal")
+})
+
+# calc worker
+testthat::test_that("calc_worker remaining", {
+  withr::local_package("terra")
+  withr::local_package("sf")
+  withr::local_package("exactextractr")
+  withr::local_options(sf_use_s2 = FALSE)
+
+  ncp <- data.frame(lon = -78.8277, lat = 35.95013, time = "boundless")
+  ncp$site_id <- "3799900018810101"
+  ncpt <-
+    terra::vect(ncp, geom = c("lon", "lat"),
+                keepgeom = TRUE, crs = "EPSG:4326")
+  nc <- system.file("gpkg/nc.gpkg", package = "sf")
+  nc <- terra::vect(nc)
+  nc <- terra::project(nc, "EPSG:4326")
+  ncrast <- terra::rast(nc, resolution = 0.05)
+  terra::values(ncrast) <- rgamma(terra::ncell(ncrast), 1, 1e-4)
+
+  testthat::expect_no_error(
+    cwres <-
+      calc_worker(
+        from = ncrast,
+        dataset = "whatever",
+        locs_vector = ncpt,
+        locs_df = ncp,
+        time = ncpt$time,
+        time_type = "timeless",
+        radius = 1e5,
+        max_cells = 3e7
+      )
+  )
+  testthat::expect_s3_class(cwres, "data.frame")
+})

tests/testthat/test-process.R

@@ -619,6 +619,15 @@ testthat::test_that("process_sedac_population returns null for netCDF.", {
   )
 })
 
+testthat::test_that("sedac_codes", {
+  string <- "2.5 minute"
+  testthat::expect_no_error(
+    code <- process_sedac_codes(string)
+  )
+  testthat::expect_equal(code, "2pt5_min")
+})
+
+
 # test HMS ####
 testthat::test_that("process_hms returns expected.", {
   withr::local_package("terra")
@@ -746,6 +755,32 @@ testthat::test_that("import_gmted returns error with non-vector variable.", {
   )
 })
 
+testthat::test_that("gmted_codes inversion", {
+  teststring <- "mx"
+  testthat::expect_no_error(
+    statorig <- process_gmted_codes(
+      teststring,
+      statistic = TRUE,
+      resolution = FALSE,
+      invert = TRUE
+    )
+  )
+  testthat::expect_equal(statorig, "Maximum Statistic")
+
+  teststring <- "75"
+  testthat::expect_no_error(
+    resoorig <- process_gmted_codes(
+      teststring,
+      statistic = FALSE,
+      resolution = TRUE,
+      invert = TRUE
+    )
+  )
+  testthat::expect_equal(resoorig, "7.5 arc-seconds")
+})
+
+
+## test NARR ####
 testthat::test_that("process_narr returns expected.", {
   withr::local_package("terra")
   variables <- c(
@@ -1652,3 +1687,72 @@ testthat::test_that("process_olm", {
   )
 })
 # nolint end
+
+## AUX tests ####
+testthat::test_that("loc_radius tests", {
+  withr::local_package("terra")
+  withr::local_package("sf")
+  withr::local_options(list(sf_use_s2 = FALSE))
+
+  lon <- seq(-112, -101, length.out = 5) # create lon sequence
+  lat <- seq(33.5, 40.9, length.out = 5) # create lat sequence
+  df <- expand.grid("lon" = lon, "lat" = lat) # expand to regular grid
+  df <- rbind(df, df)
+  df$time <- c(rep("2023-11-02", 25), rep("2023-11-03", 25))
+  df$var1 <- 1:50
+  df$var2 <- 51:100
+  dfsf <- sf::st_as_sf(
+    df,
+    coords = c("lon", "lat"),
+    crs = "EPSG:4326",
+    remove = FALSE
+  )
+  dftr <- terra::vect(dfsf)
+
+  testthat::expect_no_error(
+    dftrb00 <- process_locs_radius(dftr, 0)
+  )
+  testthat::expect_no_error(
+    dftrb1k <- process_locs_radius(dftr, 1000L)
+  )
+  testthat::expect_true(terra::geomtype(dftrb00) == "points")
+  testthat::expect_true(terra::geomtype(dftrb1k) == "polygons")
+  testthat::expect_s4_class(dftrb00, "SpatVector")
+  testthat::expect_s4_class(dftrb1k, "SpatVector")
+})
+
+testthat::test_that("process_locs_vector tests", {
+  withr::local_package("terra")
+  withr::local_package("sf")
+  withr::local_options(list(sf_use_s2 = FALSE))
+
+  lon <- seq(-112, -101, length.out = 5) # create lon sequence
+  lat <- seq(33.5, 40.9, length.out = 5) # create lat sequence
+  df <- expand.grid("lon" = lon, "lat" = lat) # expand to regular grid
+  dfsf <- sf::st_as_sf(
+    df,
+    coords = c("lon", "lat"),
+    crs = "EPSG:4326",
+    remove = FALSE
+  )
+  dftr <- terra::vect(dfsf)
+
+  testthat::expect_no_error(
+    dftr1 <- process_locs_vector(dftr, "EPSG:4326", 0)
+  )
+  testthat::expect_no_error(
+    dfsftr <- process_locs_vector(dfsf, "EPSG:4326", 0)
+  )
+  testthat::expect_no_error(
+    dfdftr <- process_locs_vector(df, "EPSG:4326", 0)
+  )
+  testthat::expect_no_error(
+    dfdftrb <- process_locs_vector(df, "EPSG:4326", radius = 1000L)
+  )
+  testthat::expect_s4_class(dftr1, "SpatVector")
+  testthat::expect_s4_class(dfsftr, "SpatVector")
+  testthat::expect_s4_class(dfdftr, "SpatVector")
+  testthat::expect_s4_class(dfdftrb, "SpatVector")
+  testthat::expect_true(terra::geomtype(dfdftr) == "points")
+  testthat::expect_true(terra::geomtype(dfdftrb) == "polygons")
+})