update tests

NEWS.md

@@ -7,8 +7,10 @@
   habitat types for resident distributions of non-migratory species would not
   include those exclusively affiliated with the species' passage distributions.
   Thanks to Jianqiao Zhao for raising this issue.
-- Fix bug in `create_spp_aoh_data()` that caused errors when using the GDAL
-  engine on macOS systems.
+- Update built-in testing data to include multiple migratory species.
+- Update internal R script for creating test dataset
+  (i.e., `inst/scripts/test-data.R`) to be compatible with current version of
+  the package.
 - Fix URLs.
 
 # aoh 0.0.2.11

inst/scripts/test-data.R

@@ -2,7 +2,7 @@
 ## define variables
 n_spp <- 10
 country_names <- c("spain", "portugal")
-habitat_version <- "10.5281/zenodo.4058819"
+habitat_version <- "10.5281/zenodo.6622038"
 elevation_version <- "10.5281/zenodo.5719984"
 cache_dir <- rappdirs::user_data_dir("aoh")
 
@@ -13,7 +13,7 @@ library(dplyr)
 library(terra)
 
 # set rng state
-set.seed(501)
+set.seed(502)
 
 # Preliminary processing
 ## install dependencies if needed
@@ -89,8 +89,8 @@ sim_elevation_data <- terra::aggregate(
 ## identify codes to use for test data
 ## these are codes present in both the Jung and Lumbierres crosswalks
 include_codes <- intersect(
-  crosswalk_jung_data$code,
-  crosswalk_lumbierres_data$code
+  crosswalk_jung_lvl2_data$code,
+  crosswalk_lumb_cgls_data$code
 )
 omit_codes <- setdiff(iucn_habitat_data$code, include_codes)
 omit_codes <- unique(c(omit_codes, iucn_habitat_codes_marine()))
@@ -101,7 +101,7 @@ sim_data <- simulate_spp_data(
   boundary_data = sim_boundary_data,
   habitat_data = sim_habitat_data,
   elevation_data = sim_elevation_data,
-  crosswalk_data = crosswalk_jung_data,
+  crosswalk_data = crosswalk_jung_lvl2_data,
   omit_habitat_codes = omit_codes
 )
 
@@ -110,6 +110,17 @@ assertthat::assert_that(
   sum(sim_data$spp_range_data$seasonal == 2) > 0,
   msg = "simulated data does not contain any migratory species"
 )
+mig_ids <- unique(
+  sim_data$spp_range_data$id_no[sim_data$spp_range_data$seasonal == 2]
+)
+assertthat::assert_that(
+  any(mig_ids %in% sim_data$spp_habitat_data$id_no),
+  msg = "no simulated habitat data for migratory species"
+)
+assertthat::assert_that(
+  any(mig_ids %in% sim_data$spp_summary_data$id_no),
+  msg = "no simulated summary data for migratory species"
+)
 
 # Exports
 ## save boundary data

inst/testdata/sim_spp_habitat_data.csv

@@ -1,44 +1,43 @@
 "id_no","code","habitat","suitability","season","majorimportance"
-932,"1.4","Forest - Temperate","Suitable","Resident",NA
-932,"2.1","Savanna - Dry","Suitable","Resident",NA
-932,"14.2","Pastureland","Suitable","Resident",NA
-3032,"1.4","Forest - Temperate","Suitable","Resident",NA
-3032,"4","Grassland","Suitable","Resident",NA
-3032,"14.5","Urban Areas","Suitable","Resident",NA
-3046,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
-3046,"5","Wetlands (inland)","Suitable","Resident",NA
-3046,"2.1","Savanna - Dry","Suitable","Resident",NA
-3046,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Non-breeding Season",NA
-3046,"1.4","Forest - Temperate","Suitable","Non-breeding Season",NA
-3046,"14.2","Pastureland","Suitable","Non-breeding Season",NA
-3046,"14.1","Arable Land","Suitable","Passage",NA
-3046,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Passage",NA
-3046,"5","Wetlands (inland)","Suitable","Passage",NA
-3255,"4.4","Grassland - Temperate","Suitable","Resident",NA
-3255,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Resident",NA
-3255,"2.1","Savanna - Dry","Suitable","Resident",NA
-4008,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
-4008,"4.5","Grassland - Subtropical/tropical dry","Suitable","Resident",NA
-4008,"6","Rocky Areas (e.g., inland cliffs, mountain peaks)","Suitable","Resident",NA
-4785,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
-4785,"5","Wetlands (inland)","Suitable","Resident",NA
-4973,"3.4","Shrubland - Temperate","Suitable","Resident",NA
-4973,"1.4","Forest - Temperate","Suitable","Resident",NA
-4973,"14.2","Pastureland","Suitable","Resident",NA
-5854,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
-5854,"2.1","Savanna - Dry","Suitable","Resident",NA
-5854,"5","Wetlands (inland)","Suitable","Resident",NA
-6068,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
-6068,"6","Rocky Areas (e.g., inland cliffs, mountain peaks)","Suitable","Resident",NA
-6068,"4","Grassland","Suitable","Resident",NA
-6678,"4.4","Grassland - Temperate","Suitable","Resident",NA
-6678,"1.5","Forest - Subtropical/tropical dry","Suitable","Resident",NA
-6678,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Resident",NA
-6678,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Breeding Season",NA
-6678,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Breeding Season",NA
-6678,"14.2","Pastureland","Suitable","Breeding Season",NA
-6678,"14.5","Urban Areas","Suitable","Non-breeding Season",NA
-6678,"5","Wetlands (inland)","Suitable","Non-breeding Season",NA
-6678,"14.5","Urban Areas","Suitable","Passage",NA
-6678,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Passage",NA
-6678,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Passage",NA
+670,"14.5","Urban Areas","Suitable","Breeding Season",NA
+670,"14.2","Pastureland","Suitable","Breeding Season",NA
+670,"4.4","Grassland - Temperate","Suitable","Non-breeding Season",NA
+670,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Non-breeding Season",NA
+670,"6","Rocky Areas (e.g., inland cliffs, mountain peaks)","Suitable","Non-breeding Season",NA
+670,"1.5","Forest - Subtropical/tropical dry","Suitable","Passage",NA
+670,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Passage",NA
+670,"3.4","Shrubland - Temperate","Suitable","Passage",NA
+2072,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
+2072,"1.4","Forest - Temperate","Suitable","Resident",NA
+2072,"2.1","Savanna - Dry","Suitable","Resident",NA
+2374,"4.4","Grassland - Temperate","Suitable","Resident",NA
+2374,"2.1","Savanna - Dry","Suitable","Resident",NA
+2374,"14.5","Urban Areas","Suitable","Resident",NA
+3667,"1.4","Forest - Temperate","Suitable","Resident",NA
+3667,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Resident",NA
+3667,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
+4421,"3.5","Shrubland - Subtropical/tropical dry","Suitable","Resident",NA
+4421,"4.4","Grassland - Temperate","Suitable","Resident",NA
+4650,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
+4650,"4.4","Grassland - Temperate","Suitable","Resident",NA
+4650,"14.5","Urban Areas","Suitable","Resident",NA
+5808,"14.5","Urban Areas","Suitable","Resident",NA
+5808,"14.1","Arable Land","Suitable","Resident",NA
+5808,"14.2","Pastureland","Suitable","Resident",NA
+5808,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Breeding Season",NA
+5808,"4.1","Grassland - Tundra","Suitable","Breeding Season",NA
+5808,"2.1","Savanna - Dry","Suitable","Breeding Season",NA
+5808,"14.1","Arable Land","Suitable","Non-breeding Season",NA
+5808,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Non-breeding Season",NA
+5808,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Passage",NA
+5808,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Passage",NA
+5808,"4","Grassland","Suitable","Passage",NA
+6701,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
+6701,"5.5","Wetlands (inland) - Permanent freshwater lakes (over 8 ha)","Suitable","Resident",NA
+6701,"4.1","Grassland - Tundra","Suitable","Resident",NA
+8110,"3.8","Shrubland - Mediterranean-type shrubby vegetation","Suitable","Resident",NA
+8110,"1.4","Forest - Temperate","Suitable","Resident",NA
+8110,"14.5","Urban Areas","Suitable","Resident",NA
+8644,"3.4","Shrubland - Temperate","Suitable","Resident",NA
+8644,"14.5","Urban Areas","Suitable","Resident",NA
+8644,"5","Wetlands (inland)","Suitable","Resident",NA

inst/testdata/sim_spp_summary_data.csv

@@ -1,11 +1,11 @@
 "id_no","taxonid","scientific_name","kingdom","phylum","class","order","family","genus","main_common_name","authority","published_year","assessment_date","category","criteria","population_trend","marine_system","freshwater_system","terrestrial_system","assessor","reviewer","aoo_km2","eoo_km2","elevation_upper","elevation_lower","depth_upper","depth_lower","errata_flag","errata_reason","amended_flag","amended_reason"
-932,932,"Simulus spp. 932",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"NT",NA,NA,"false","false","true",NA,NA,NA,NA,830,76,NA,NA,NA,NA,NA,NA
-3032,3032,"Simulus spp. 3032",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,999,36,NA,NA,NA,NA,NA,NA
-3046,3046,"Simulus spp. 3046",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,874,23,NA,NA,NA,NA,NA,NA
-3255,3255,"Simulus spp. 3255",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"VU",NA,NA,"false","false","true",NA,NA,NA,NA,1050,90,NA,NA,NA,NA,NA,NA
-4008,4008,"Simulus spp. 4008",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,933,38,NA,NA,NA,NA,NA,NA
-4785,4785,"Simulus spp. 4785",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,942,45,NA,NA,NA,NA,NA,NA
-4973,4973,"Simulus spp. 4973",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,1058,43,NA,NA,NA,NA,NA,NA
-5854,5854,"Simulus spp. 5854",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,1018,45,NA,NA,NA,NA,NA,NA
-6068,6068,"Simulus spp. 6068",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"NT",NA,NA,"false","false","true",NA,NA,NA,NA,1052,335,NA,NA,NA,NA,NA,NA
-6678,6678,"Simulus spp. 6678",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,1017,32,NA,NA,NA,NA,NA,NA
+670,670,"Simulus spp. 670",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"LC",NA,NA,"false","false","true",NA,NA,NA,NA,942,82,NA,NA,NA,NA,NA,NA
+2072,2072,"Simulus spp. 2072",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"NT",NA,NA,"false","false","true",NA,NA,NA,NA,907,46,NA,NA,NA,NA,NA,NA
+2374,2374,"Simulus spp. 2374",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"VU",NA,NA,"false","false","true",NA,NA,NA,NA,1020,65,NA,NA,NA,NA,NA,NA
+3667,3667,"Simulus spp. 3667",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,598,15,NA,NA,NA,NA,NA,NA
+4421,4421,"Simulus spp. 4421",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"VU",NA,NA,"false","false","true",NA,NA,NA,NA,949,85,NA,NA,NA,NA,NA,NA
+4650,4650,"Simulus spp. 4650",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"NT",NA,NA,"false","false","true",NA,NA,NA,NA,951,54,NA,NA,NA,NA,NA,NA
+5808,5808,"Simulus spp. 5808",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"VU",NA,NA,"false","false","true",NA,NA,NA,NA,974,91,NA,NA,NA,NA,NA,NA
+6701,6701,"Simulus spp. 6701",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"EN",NA,NA,"false","false","true",NA,NA,NA,NA,1069,221,NA,NA,NA,NA,NA,NA
+8110,8110,"Simulus spp. 8110",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"VU",NA,NA,"false","false","true",NA,NA,NA,NA,991,75,NA,NA,NA,NA,NA,NA
+8644,8644,"Simulus spp. 8644",NA,NA,NA,NA,NA,"Simulus",NA,NA,NA,NA,"LC",NA,NA,"false","false","true",NA,NA,NA,NA,1183,182,NA,NA,NA,NA,NA,NA

tests/testthat/test_clean_spp_range_data.R

@@ -76,7 +76,7 @@ test_that("custom presence, origin, and seasonal codes", {
   f <- system.file("testdata", "SIMULATED_SPECIES.zip", package = "aoh")
   presence <- c(1, 3)
   origin <- c(1, 5)
-  season <- c(1, 5)
+  season <- c(1, 2, 5)
   # create object
   d <- read_spp_range_data(f)
   x <- clean_spp_range_data(

tests/testthat/test_collate_spp_info_data.R

@@ -237,6 +237,28 @@ test_that("habitat codes (adjust_habitat_codes = TRUE)", {
   d3 <- utils::read.table(
     f3, header = TRUE, sep = ",", stringsAsFactors = FALSE
   )
+  # add in additional classes for passage distributions for some species,
+  # this is to mimic cases where passage habitat data are available for
+  # migratory and non-migratory species and we want to make sure they
+  # are handled correctly
+  ## sample species to add extra habitat class
+  mig_ids <- unique(d3$id_no[d3$season == "Breeding Season"])
+  non_mig_ids <- setdiff(unique(d3$id_no), mig_ids)
+  ids <- c(sample(mig_ids, size = 2), sample(non_mig_ids, size = 2))
+  ## create additional habitat data
+  ## we will deliberately use aquatic habitat so we can make sure that
+  ## the passage habitat information is treated correctly
+  new_data <- d3
+  new_data <-
+    dplyr::filter(new_data, id_no %in% ids)
+  new_data <- dplyr::group_by(new_data, id_no)
+  new_data <- dplyr::filter(new_data , seq_along(id_no) == 1)
+  new_data <- dplyr::ungroup(new_data)
+  new_data$code <- 15.4
+  new_data$habitat <- "Salt Exploitation Sites"
+  new_data$season <- "Passage"
+  ## merge extra data
+  d3 <- dplyr::bind_rows(d3, new_data)
   # create object
   x <- collate_spp_info_data(
     x = cd1,
@@ -246,14 +268,16 @@ test_that("habitat codes (adjust_habitat_codes = TRUE)", {
     verbose = interactive()
   )
   # tests
-  ids <- unique(d1$id_no)
-  for (i in seq_along(ids)) {
-    s <- dplyr::filter(cd1, id_no == ids[i])
-    h <- dplyr::filter(d3, id_no == ids[i])
+  ## verify that habitat classes are correct for each seasonal distribution
+  ## for each species
+  all_ids <- unique(d1$id_no)
+  for (i in seq_along(all_ids)) {
+    s <- dplyr::filter(cd1, id_no == all_ids[i])
+    h <- dplyr::filter(d3, id_no == all_ids[i])
     m <- any(c(2L, 3L, 4L) %in% s$seasonal)
     h$seasonal <- convert_to_seasonal_id(h$season)
     for (j in unique(s$seasonal)) {
-      w <- dplyr::filter(x, id_no == ids[i], seasonal == j)
+      w <- dplyr::filter(x, id_no == all_ids[i], seasonal == j)
       if ((j == 1) && !isTRUE(m)) {
         h_ids <- h$code[(h$seasonal %in% seq_len(5)) | is.na(h$seasonal)]
       } else if ((j == 1) && isTRUE(m)) {
@@ -271,6 +295,26 @@ test_that("habitat codes (adjust_habitat_codes = TRUE)", {
       expect_equal(w$full_habitat_code, h_code)
     }
   }
+  ## double check that passage habitat classes are NOT included for resident
+  ## distributions of migratory species
+  updated_mig_ids <- mig_ids[mig_ids %in% ids]
+  for (i in seq_along(updated_mig_ids)) {
+    w <- dplyr::filter(x, id_no == updated_mig_ids[i], seasonal == 1)
+    if (nrow(w) > 0) {
+      h_ids <- as.numeric(strsplit(w$full_habitat_code, "|", fixed = TRUE)[[1]])
+      expect_false(15.4 %in% h_ids)
+    }
+  }
+  ## double check that passage habitat classes are included for resident
+  ## distributions of non-migratory species
+  updated_non_mig_ids <- non_mig_ids[non_mig_ids %in% ids]
+  for (i in seq_along(updated_non_mig_ids)) {
+    w <- dplyr::filter(x, id_no == updated_non_mig_ids[i], seasonal == 1)
+    if (nrow(w) > 0) {
+      h_ids <- as.numeric(strsplit(w$full_habitat_code, "|", fixed = TRUE)[[1]])
+      expect_true(15.4 %in% h_ids)
+    }
+  }
 })
 
 test_that("habitat codes (adjust_habitat_codes = FALSE)", {
@@ -289,6 +333,26 @@ test_that("habitat codes (adjust_habitat_codes = FALSE)", {
   d3 <- utils::read.table(
     f3, header = TRUE, sep = ",", stringsAsFactors = FALSE
   )
+  # add in additional classes for passage distributions for some species,
+  # this is to mimic cases where passage habitat data are available for
+  # migratory and non-migratory species and we want to make sure they
+  # are handled correctly
+  ## sample species to add extra habitat class
+  mig_ids <- unique(d3$id_no[d3$season == "Breeding Season"])
+  non_mig_ids <- setdiff(unique(d3$id_no), mig_ids)
+  ids <- c(sample(mig_ids, size = 2), sample(non_mig_ids, size = 2))
+  ## create additional habitat data
+  ## we will deliberately use aquatic habitat so we can make sure that
+  ## the passage habitat information is treated correctly
+  new_data <- d3
+  new_data <-
+    dplyr::filter(new_data, id_no %in% ids)
+  new_data <- dplyr::group_by(new_data, id_no)
+  new_data <- dplyr::filter(new_data , seq_along(id_no) == 1)
+  new_data <- dplyr::ungroup(new_data)
+  new_data$code <- 15.4
+  new_data$habitat <- "Salt Exploitation Sites"
+  new_data$season <- "Passage"
   # create object
   x <- collate_spp_info_data(
     x = cd1,
@@ -298,13 +362,13 @@ test_that("habitat codes (adjust_habitat_codes = FALSE)", {
     verbose = interactive()
   )
   # tests
-  ids <- unique(d1$id_no)
-  for (i in seq_along(ids)) {
-    s <- dplyr::filter(cd1, id_no == ids[i])
-    h <- dplyr::filter(d3, id_no == ids[i])
+  all_ids <- unique(d1$id_no)
+  for (i in seq_along(all_ids)) {
+    s <- dplyr::filter(cd1, id_no == all_ids[i])
+    h <- dplyr::filter(d3, id_no == all_ids[i])
     h$seasonal <- convert_to_seasonal_id(h$season)
     for (j in unique(s$seasonal)) {
-      w <- dplyr::filter(x, id_no == ids[i], seasonal == j)
+      w <- dplyr::filter(x, id_no == all_ids[i], seasonal == j)
       if (j == 1) {
         h_ids <- h$code[h$seasonal %in% 1L]
       } else if (j == 2) {

tests/testthat/test_read_spp_range_data.R

@@ -28,7 +28,7 @@ test_that("simulated data (shapefile zip format, multiple files)", {
   td2 <- tempfile()
   dir.create(td2, showWarnings = FALSE, recursive = TRUE)
   n <- nrow(o)
-  m <- median(seq_len(n))
+  m <- as.integer(floor(median(seq_len(n))))
   sf::write_sf(
     o[seq(1, m - 1), , drop = FALSE],
     paste0(td2, "/SIMULATED_SPECIES1.shp")