Merge pull request #28 from USEPA/develop

Develop

.gitignore

@@ -6,3 +6,4 @@ inst/doc
 /doc/
 /Meta/
 notes.md
+

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spsurvey
 Title: Spatial Sampling Design and Analysis
-Version: 5.2.0
+Version: 5.3.0
 Authors@R: c(
     person("Michael", "Dumelle", role=c("aut","cre"),
            email = "[email protected]", comment = c(ORCID = "0000-0002-3393-5529")),

NEWS.md

@@ -1,3 +1,25 @@
+# spsurvey 5.3.0 (2022-02-24)
+
+## Minor updates
+
+* Added a `projcrs_check` argument to `grts()` and `irs()`, which checks whether projected coordinates are required (`projcrs_check = TRUE`) or not (`projcrs_check = FALSE`).
+* Nearest neighbor replacement sites (specified by `n_near`) in `grts()` or `irs()` are now also generated for each observation in `legacy_sites`.
+
+## Bug fixes
+
+* Fixed a bug in `attrisk_analysis()`, `diffrisk_analysis()`, and `relrisk_analysis()` that sometimes caused names in `response_levels` to not be found.
+* Fixed a bug in `grts()` and `irs()` that returned an error when the name of the `geometry` column in `sframe` and `legacy_sites` differed. Now when this occurs, the `geometry` column in `legacy_sites` is renamed to have the same name as the geometry column in `sframe`.
+* Fixed a bug in `grts()` and `irs()` that prevented `legacy_stratum_var`, `legacy_caty_var` and `legacy_aux_var` from performing properly.
+* Fixed a bug in `grts()` and `irs()` that returned an error when at least one stratum in `legacy_sites` had zero observations.
+* Fixed a bug in `grts()` and `irs()` that prevented `warnprnt()` from performing properly.
+* Removed the warning in `grts()` and `irs()` that indicated when m or z values in `sframe` or `legacy_sites` were dropped. Now, the dropping of m or z values is explained in the documentation.
+* Removed a warning in `grts()` and `irs()` that indicated when row names were set if `legacy_sites` was a tibble. Now, `legacy_sites` is coerced to a base R data frame (i.e., not a tibble) before setting row names.
+* Added an error in `grts()` and `irs()` when `legacy_stratum_var` (and `legacy_caty_var` and `legacy_aux_var`) are `NULL` but the name of `stratum_var` in `sframe` is not contained in `legacy_sites`.
+* Added an error in `grts()` and `irs()` that checks whether `sframe` and `legacy_sites` have the same crs.
+* Updated documentation for `pt_density` in `grts()` and `irs()` to indicate that `pt_density` must be a positive integer.
+* Fixed a bug in `sp_summary()` that returned an error when `formula = ~ .` and the geometry column was not named `"geometry"`. Now, `sp_summary()` works with `formula = ~ .` regardless of the name of the geometry column.
+* Fixed a bug in `grts()` and `irs()` that affected minimum distance performance when legacy sites were used.
+
 # spsurvey 5.2.0 (2021-01-23)
 
 ## Minor updates

R/attrisk_analysis.R

@@ -573,7 +573,7 @@ attrisk_analysis <- function(dframe, vars_response, vars_stressor, response_leve
           msg <- paste0("\nCategory names for the following response variables do not match category names \nin the response_levels argument:\n", temp_str)
           error_vec <- c(error_vec, msg)
         } else {
-          if (!all(names(response_levels)) %in% vars_response) {
+          if (!all(names(response_levels) %in% vars_response)) {
             error_ind <- TRUE
             msg <- "Names for the response_levels list do not match the values in the vars_response \nargument."
             error_vec <- c(error_vec, msg)

R/diffrisk_analysis.R

@@ -307,7 +307,7 @@ diffrisk_analysis <- function(dframe, vars_response, vars_stressor, response_lev
           msg <- paste0("\nCategory names for the following response variables do not match category names \nin the response_levels argument:\n", temp_str)
           error_vec <- c(error_vec, msg)
         } else {
-          if (!all(names(response_levels)) %in% vars_response) {
+          if (!all(names(response_levels) %in% vars_response)) {
             error_ind <- TRUE
             msg <- "Names for the response_levels list do not match the values in the vars_response \nargument."
             error_vec <- c(error_vec, msg)

R/dsgn_check.R

@@ -82,6 +82,11 @@
 #' @param maxtry Number of maximum attempts to ensure minimum distance (mindis) between sites.
 #'   Default is \code{10}.
 #'
+#'  @param projcrs_check A check for whether the coordinates are projected. If \code{TRUE},
+#'    an error is returned if coordinates are not projected. If \code{FALSE}, the
+#'    check is not performed and the raw coordinates in the geometry column of
+#'    \code{sframe} (and \code{legacy_sites} if provided) are used.
+#'
 #'
 #' @return Nothing is returned. If errors are found they are collected and written out.
 #'   One or more errors will cause the call to \code{grts()} to stop.
@@ -92,24 +97,41 @@
 #' @noRd
 ###############################################################################
 dsgn_check <- function(sframe, sf_type, legacy_sites, legacy_option, stratum, seltype, n_base, caty_n,
-                       n_over, n_near, stratum_var, caty_var, aux_var, legacy_var, mindis,
-                       DesignID, SiteBegin, maxtry) {
+                       n_over, n_near, stratum_var, caty_var, aux_var,
+                       legacy_stratum_var, legacy_caty_var, legacy_aux_var,
+                       legacy_var, mindis,
+                       DesignID, SiteBegin, maxtry, projcrs_check) {
 
   # Create a data frame for stop messages
   stop_ind <- FALSE
   stop_df <- NULL
 
-  # check that coordinates are NA or geographic
-  if (is.na(st_crs(sframe))) {
+  # check that coordinates are NA or geographic # | st_is_longlat(sframe))
+  if (projcrs_check & is.na(st_crs(sframe))) {
     stop_ind <- TRUE
-    stop_mess <- "The coordinate reference system (crs) for sframe is NA. The coordinate reference system for sframe should instead use projected coordinates. For more information, see spsurvey's \"Start Here\" vignette by running vignette(\"start-here\", \"spsurvey\")."
+    stop_mess <- "The coordinate reference system (crs) for sframe is NA. The coordinate reference system for sframe should instead use projected coordinates. For more information on geographic and projected coordinates, see spsurvey's \"Start Here\" vignette by running vignette(\"start-here\", \"spsurvey\"). To override the check for projected coordinates, set projcrs_check = FALSE."
     stop_df <- rbind(stop_df, data.frame(func = I("sframe"), I(stop_mess)))
-  } else if (st_is_longlat(sframe)) {
+  }
+
+  if (projcrs_check & st_is_longlat(sframe)) {
     stop_ind <- TRUE
-    stop_mess <- "The coordinate reference system (crs) for sframe uses geographic coordinates. The coordinate reference system for sframe should instead use projected coordinates. For more information, see spsurvey's \"Start Here\" vignette by running vignette(\"start-here\", \"spsurvey\")."
+    stop_mess <- "The coordinate reference system (crs) for sframe is geographic. The coordinate reference system for sframe should instead use projected coordinates. For more information on geographic and projected coordinates, see spsurvey's \"Start Here\" vignette by running vignette(\"start-here\", \"spsurvey\"). To override the check for projected coordinates, set projcrs_check = FALSE."
     stop_df <- rbind(stop_df, data.frame(func = I("sframe"), I(stop_mess)))
   }
 
+  # check that legacy and sframe coordinates match
+  if (!is.null(legacy_sites)) {
+    if (sum(is.na(st_crs(sframe)), is.na(st_crs(legacy_sites))) == 1) {
+      stop_ind <- TRUE
+      stop_mess <- "sframe and legacy_sites must have the same crs. If crs should be ignored completely, run st_crs(sframe) <- NA and st_crs(legacy_sites) <- NA"
+      stop_df <- rbind(stop_df, data.frame(func = I("sframe"), I(stop_mess)))
+    } else if (st_crs(sframe) != st_crs(legacy_sites)) {
+      stop_ind <- TRUE
+      stop_mess <- "sframe and legacy_sites must have the same crs. If crs should be ignored completely, run st_crs(sframe) <- NA and st_crs(legacy_sites) <- NA"
+      stop_df <- rbind(stop_df, data.frame(func = I("sframe"), I(stop_mess)))
+    }
+  }
+
   # check that sframe has required variables for stratum, caty, aux and legacy
   # If stratum_var is provided, does the attribute exist in sframe
   if (!is.null(stratum_var)) {
@@ -161,26 +183,26 @@ dsgn_check <- function(sframe, sf_type, legacy_sites, legacy_option, stratum, se
   }
 
   ### Check legacy_sites sf object if present
-  if (sf_type %in% c("sf_linear", "sf_area") & !is.null(legacy_sites)) {
+  if (sf_type %in% c("sf_point", "sf_linear", "sf_area") & !is.null(legacy_sites)) {
     # check that legacy_sites has required variables for stratum, caty, aux and legacy
     # If stratum_var is provided, does the attribute exist
-    if (!is.null(stratum_var)) {
+    if (!is.null(stratum_var) & is.null(legacy_stratum_var)) {
       if (match(stratum_var, names(legacy_sites), nomatch = 0) == 0) {
         stop_ind <- TRUE
         stop_mess <- "The value provided for stratum variable does not exist as a variable in legacy_sites."
         stop_df <- rbind(stop_df, data.frame(func = I("stratum_var"), I(stop_mess)))
       }
     }
     # If caty_var is provided, does the attribute exist
-    if (!is.null(caty_var)) {
+    if (!is.null(caty_var) & is.null(legacy_caty_var)) {
       if (match(caty_var, names(legacy_sites), nomatch = 0) == 0) {
         stop_ind <- TRUE
         stop_mess <- "The value provided for caty variable does not exist as a variable in legacy_sites."
         stop_df <- rbind(stop_df, data.frame(func = I("stratum_var"), I(stop_mess)))
       }
     }
     # If aux_var is provided, does the attribute exist
-    if (!is.null(aux_var)) {
+    if (!is.null(aux_var) & is.null(legacy_aux_var)) {
       if (match(aux_var, names(legacy_sites), nomatch = 0) == 0) {
         stop_ind <- TRUE
         stop_mess <- "The value provided for aux variable does not exist as a variable in legacy_sites."