test coverage fix

- Just for "covr" compatibility... future::plan(future::sequential)
ropensci · Jan 12, 2024 · b3b9576 · b3b9576
1 parent 500c4bb
commit b3b9576
Show file tree

Hide file tree

Showing 8 changed files with 169 additions and 25 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -11,6 +11,7 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Imports: 
+    doFuture,
     dplyr,
     exactextractr,
     future,
@@ -22,7 +23,6 @@ Imports:
     terra
 Suggests: 
     covr,
-    doFuture,
     future.batchtools,
     igraph,
     knitr,
@@ -38,4 +38,4 @@ Depends:
 LazyData: true
 Config/testthat/edition: 3
 LitrVersionUsed: 0.9.0
-LitrId: 083c5cfaf3173c779a48c55c33eea32b
+LitrId: 87c0f1aa2e25cf3e6bab83b0f987b5f8
diff --git a/NAMESPACE b/NAMESPACE
@@ -28,6 +28,7 @@ export(set_clip_extent)
 export(sp_index_grid)
 export(switch_packbound)
 export(validate_and_repair_vectors)
+import(doFuture)
 import(future)
 import(future.apply)
 importFrom(dplyr,across)

diff --git a/R/preprocessing.R b/R/preprocessing.R
@@ -40,7 +40,12 @@ rast_short <- function(rasterpath, win) {
         is(win, "SpatExtent"))) {
     stop("Argument win should be one of named numeric vector or SpatExtent object.\n")
   }
-  if (is.numeric(win) && !all(grepl("(xmax|xmin|ymax|ymin)", names(win)))) {
+  if (
+    all(
+      is.numeric(win),
+      !all(grepl("(xmax|xmin|ymax|ymin)", names(win))) || is.null(names(win))
+    )
+  ) {
     stop("Numeric win without names is detected. Set valid names for all win elements.\n")
   }
   invisible(terra::rast(rasterpath, win = win))

diff --git a/R/scale_process.R b/R/scale_process.R
@@ -293,6 +293,7 @@ distribute_process_hierarchy <-
 #' # distribute_process_multirasters()
 #' @import future
 #' @import future.apply
+#' @import doFuture
 #' @export
 distribute_process_multirasters <- function(
   filenames,

diff --git a/scomps_rmarkdown_litr.html b/scomps_rmarkdown_litr.html
@@ -400,7 +400,7 @@ <h2>Package setup</h2>
 usethis::use_package(&quot;testthat&quot;, &quot;Suggests&quot;)
 usethis::use_package(&quot;units&quot;, &quot;Suggests&quot;)
 usethis::use_package(&quot;tigris&quot;, &quot;Suggests&quot;)
-usethis::use_package(&quot;doFuture&quot;, &quot;Suggests&quot;)
+usethis::use_package(&quot;doFuture&quot;)
 usethis::use_package(&quot;future.batchtools&quot;, &quot;Suggests&quot;)
 usethis::use_package(&quot;igraph&quot;, &quot;Suggests&quot;)
 usethis::use_package(&quot;withr&quot;, &quot;Suggests&quot;)
@@ -430,6 +430,7 @@ <h2>Package setup</h2>
 ## URL:
 ##     https://Spatiotemporal-Exposures-and-Toxicology.github.io/Scalable_GIS
 ## Imports:
+##     doFuture,
 ##     dplyr,
 ##     exactextractr,
 ##     future,
@@ -441,7 +442,6 @@ <h2>Package setup</h2>
 ##     terra
 ## Suggests:
 ##     covr,
-##     doFuture,
 ##     future.batchtools,
 ##     igraph,
 ##     testthat,
@@ -971,7 +971,12 @@ <h3>Create functions</h3>
         is(win, &quot;SpatExtent&quot;))) {
     stop(&quot;Argument win should be one of named numeric vector or SpatExtent object.\n&quot;)
   }
-  if (is.numeric(win) &amp;&amp; !all(grepl(&quot;(xmax|xmin|ymax|ymin)&quot;, names(win)))) {
+  if (
+    all(
+      is.numeric(win),
+      !all(grepl(&quot;(xmax|xmin|ymax|ymin)&quot;, names(win))) || is.null(names(win))
+    )
+  ) {
     stop(&quot;Numeric win without names is detected. Set valid names for all win elements.\n&quot;)
   }
   invisible(terra::rast(rasterpath, win = win))
@@ -1802,6 +1807,33 @@ <h3>Create functions</h3>
                  1,
                  mode = &quot;buffer&quot;,
                  radius = 1e4L))
+  testthat::expect_error(
+    <a href='scomps_rmarkdown_litr.html#extract_with'>extract_with</a>(as.list(ncp),
+                 ncelev,
+                 &quot;GEOID&quot;,
+                 mode = &quot;buffer&quot;,
+                 radius = 1e4L))
+  testthat::expect_error(
+    <a href='scomps_rmarkdown_litr.html#extract_with'>extract_with</a>(sf::st_as_sf(ncp),
+                 ncelev,
+                 &quot;GEOID&quot;,
+                 mode = &quot;buffer&quot;,
+                 radius = 1e4L))
+  testthat::expect_error(
+    <a href='scomps_rmarkdown_litr.html#extract_with'>extract_with</a>(sf::st_as_sf(ncp),
+                 ncelev,
+                 1,
+                 mode = &quot;buffer&quot;,
+                 radius = &quot;Ibidem&quot;))
+  testthat::expect_error(
+    <a href='scomps_rmarkdown_litr.html#extract_with_buffer'>extract_with_buffer</a>(ncp,
+                        ncelev,
+                        &quot;pid&quot;,
+                        kernel = &quot;epanechnikov&quot;,
+                        func = stats::weighted.mean,
+                        bandwidth = 1.25e4L,
+                        radius = 1e4L,
+                        qsegs = 3 + 2i))
 
 })
 
@@ -2171,19 +2203,27 @@ <h3>Create functions</h3>
   sf::st_crs(pp) &lt;- &quot;EPSG:5070&quot;
   ppb &lt;- sf::st_buffer(pp, nQuadSegs = 180, dist = units::set_units(20, &quot;km&quot;))
 
-  system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb, nc, &quot;id&quot;)})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb, nc, &quot;id&quot;)})
+  )
   expect_s3_class(ppb_nc_aw, &quot;sf&quot;)
 
   # terra
   ppb_t &lt;- terra::vect(ppb)
   nc_t &lt;- terra::vect(nc)
-  system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb_t, nc_t, &quot;id&quot;)})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb_t, nc_t, &quot;id&quot;)})
+  )
   expect_s3_class(ppb_nc_aw, &quot;data.frame&quot;)
 
   # auto convert formats
-  system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb_t, nc, &quot;id&quot;)})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw &lt;- <a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(ppb_t, nc, &quot;id&quot;)})
+  )
   expect_s3_class(ppb_nc_aw, &quot;data.frame&quot;)
 
+  # error case
+  testthat::expect_error(<a href='scomps_rmarkdown_litr.html#aw_covariates'>aw_covariates</a>(as.list(ppb_t), nc, &quot;id&quot;))
 })
 
 
@@ -2537,6 +2577,7 @@ <h3>Create functions</h3>
 #&#39; # <a href='scomps_rmarkdown_litr.html#distribute_process_multirasters'>distribute_process_multirasters</a>()
 #&#39; @import future
 #&#39; @import future.apply
+#&#39; @import doFuture
 #&#39; @export
 <span id='distribute_process_multirasters'>distribute_process_multirasters</span> &lt;- function(
   filenames,
@@ -2893,7 +2934,11 @@ <h3>Create functions</h3>
   withr::local_package(&quot;future&quot;)
   withr::local_package(&quot;future.apply&quot;)
   withr::local_package(&quot;dplyr&quot;)
-  withr::local_options(list(sf_use_s2 = FALSE))
+  withr::local_options(
+    list(
+      sf_use_s2 = FALSE,
+      future.resolve.recursive = 2L
+      ))
 
   ncpath &lt;- testthat::test_path(&quot;..&quot;, &quot;testdata&quot;, &quot;nc_hierarchy.gpkg&quot;)
   nccnty &lt;- terra::vect(ncpath, layer = &quot;county&quot;)
@@ -2938,6 +2983,7 @@ <h3>Create functions</h3>
   testthat::expect_true(anyNA(resnas))
 
   # error case
+  future::plan(future::sequential)
   testthat::expect_condition(
     resnasx &lt;- <a href='scomps_rmarkdown_litr.html#distribute_process_multirasters'>distribute_process_multirasters</a>(
       filenames = testfiles_corrupted,
@@ -3061,7 +3107,7 @@ <h2>Documenting the package and building</h2>
 ## (as &#39;lib&#39; is unspecified)</code></pre>
 <pre><code>## 
 ## The downloaded binary packages are in
-##  /var/folders/58/7rn_bn5d6k3_cxwnzdhswpz4n0z2n9/T//Rtmpl2Ec4s/downloaded_packages
+##  /var/folders/58/7rn_bn5d6k3_cxwnzdhswpz4n0z2n9/T//RtmpoVqIO2/downloaded_packages
 ## ── R CMD build ─────────────────────────────────────────────────────────────────
 ## * checking for file ‘/Users/songi2/Documents/GitHub/Scalable_GIS/scomps/DESCRIPTION’ ... OK
 ## * preparing ‘scomps’:
@@ -3075,7 +3121,7 @@ <h2>Documenting the package and building</h2>
 ## Warning: invalid gid value replaced by that for user &#39;nobody&#39;
 ## 
 ## Running /Library/Frameworks/R.framework/Resources/bin/R CMD INSTALL \
-##   /var/folders/58/7rn_bn5d6k3_cxwnzdhswpz4n0z2n9/T//Rtmpl2Ec4s/scomps_0.1.2.01122024.tar.gz \
+##   /var/folders/58/7rn_bn5d6k3_cxwnzdhswpz4n0z2n9/T//RtmpoVqIO2/scomps_0.1.2.01122024.tar.gz \
 ##   --install-tests --no-docs --no-multiarch --no-demo 
 ## * installing to library ‘/Users/songi2/Library/R/arm64/4.3/library’
 ## * installing *source* package ‘scomps’ ...

diff --git a/scomps_rmarkdown_litr.rmd b/scomps_rmarkdown_litr.rmd
@@ -53,7 +53,7 @@ usethis::use_package("covr", "Suggests")
 usethis::use_package("testthat", "Suggests")
 usethis::use_package("units", "Suggests")
 usethis::use_package("tigris", "Suggests")
-usethis::use_package("doFuture", "Suggests")
+usethis::use_package("doFuture")
 usethis::use_package("future.batchtools", "Suggests")
 usethis::use_package("igraph", "Suggests")
 usethis::use_package("withr", "Suggests")
@@ -708,7 +708,12 @@ rast_short <- function(rasterpath, win) {
         is(win, "SpatExtent"))) {
     stop("Argument win should be one of named numeric vector or SpatExtent object.\n")
   }
-  if (is.numeric(win) && !all(grepl("(xmax|xmin|ymax|ymin)", names(win)))) {
+  if (
+    all(
+      is.numeric(win),
+      !all(grepl("(xmax|xmin|ymax|ymin)", names(win))) || is.null(names(win))
+    )
+  ) {
     stop("Numeric win without names is detected. Set valid names for all win elements.\n")
   }
   invisible(terra::rast(rasterpath, win = win))
@@ -1601,6 +1606,33 @@ testthat::test_that("extract_with runs well", {
                  1,
                  mode = "buffer",
                  radius = 1e4L))
+  testthat::expect_error(
+    extract_with(as.list(ncp),
+                 ncelev,
+                 "GEOID",
+                 mode = "buffer",
+                 radius = 1e4L))
+  testthat::expect_error(
+    extract_with(sf::st_as_sf(ncp),
+                 ncelev,
+                 "GEOID",
+                 mode = "buffer",
+                 radius = 1e4L))
+  testthat::expect_error(
+    extract_with(sf::st_as_sf(ncp),
+                 ncelev,
+                 1,
+                 mode = "buffer",
+                 radius = "Ibidem"))
+  testthat::expect_error(
+    extract_with_buffer(ncp,
+                        ncelev,
+                        "pid",
+                        kernel = "epanechnikov",
+                        func = stats::weighted.mean,
+                        bandwidth = 1.25e4L,
+                        radius = 1e4L,
+                        qsegs = 3 + 2i))
 
 })
 
@@ -1999,19 +2031,27 @@ testthat::test_that("aw_covariates works as expected.", {
   sf::st_crs(pp) <- "EPSG:5070"
   ppb <- sf::st_buffer(pp, nQuadSegs = 180, dist = units::set_units(20, "km"))
 
-  system.time({ppb_nc_aw <- aw_covariates(ppb, nc, "id")})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw <- aw_covariates(ppb, nc, "id")})
+  )
   expect_s3_class(ppb_nc_aw, "sf")
 
   # terra
   ppb_t <- terra::vect(ppb)
   nc_t <- terra::vect(nc)
-  system.time({ppb_nc_aw <- aw_covariates(ppb_t, nc_t, "id")})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw <- aw_covariates(ppb_t, nc_t, "id")})
+  )
   expect_s3_class(ppb_nc_aw, "data.frame")
 
   # auto convert formats
-  system.time({ppb_nc_aw <- aw_covariates(ppb_t, nc, "id")})
+  testthat::expect_no_error(
+    system.time({ppb_nc_aw <- aw_covariates(ppb_t, nc, "id")})
+  )
   expect_s3_class(ppb_nc_aw, "data.frame")
 
+  # error case
+  testthat::expect_error(aw_covariates(as.list(ppb_t), nc, "id"))
 })
 
 
@@ -2377,6 +2417,7 @@ distribute_process_hierarchy <-
 #' # distribute_process_multirasters()
 #' @import future
 #' @import future.apply
+#' @import doFuture
 #' @export
 distribute_process_multirasters <- function(
   filenames,
@@ -2747,7 +2788,11 @@ testthat::test_that("Processes are properly spawned and compute over multiraster
   withr::local_package("future")
   withr::local_package("future.apply")
   withr::local_package("dplyr")
-  withr::local_options(list(sf_use_s2 = FALSE))
+  withr::local_options(
+    list(
+      sf_use_s2 = FALSE,
+      future.resolve.recursive = 2L
+      ))
 
   ncpath <- testthat::test_path("..", "testdata", "nc_hierarchy.gpkg")
   nccnty <- terra::vect(ncpath, layer = "county")
@@ -2792,6 +2837,7 @@ testthat::test_that("Processes are properly spawned and compute over multiraster
   testthat::expect_true(anyNA(resnas))
 
   # error case
+  future::plan(future::sequential)
   testthat::expect_condition(
     resnasx <- distribute_process_multirasters(
       filenames = testfiles_corrupted,
@@ -2987,9 +3033,6 @@ if (dir.exists("../figure")) {
 pkgbuild::build(path = ".")
 
 # devtools::test()
-
-devtools::install(build = TRUE, dependencies = FALSE, build_vignettes = TRUE, quick = TRUE)
-
 ```
 
 ```{r, include = FALSE}
@@ -3031,6 +3074,14 @@ system("rm -r ./scomps")
 # }
 # system("mv _pkgdown.yml ./docs")
 
+devtools::install(build = TRUE, dependencies = FALSE, build_vignettes = TRUE, quick = TRUE)
+
+
 devtools::test()
 covr::package_coverage()
+```
+
+```{r slurm-submission-template, eval = FALSE, include = FALSE}
+# slurm submission is here
+
 ```