diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 38221a8e..ff1dc0c6 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,7 +29,6 @@ jobs: - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} - {os: ubuntu-latest, r: '3.6.3'} - - {os: windows-latest, r: '3.6.0'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/DESCRIPTION b/DESCRIPTION index 41bdb40b..6e637177 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: camtraptor Title: Read, Explore and Visualize Camera Trap Data Packages -Version: 0.20.1 +Version: 0.21.0 Authors@R: c( person("Damiano", "Oldoni", email = "damiano.oldoni@inbo.be", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3445-7562")), @@ -22,7 +22,7 @@ Authors@R: c( role = "fnd", comment = "https://lifewatch.be") ) Description: Read, explore and visualize Camera Trap Data Packages (Camtrap DP). - 'Camtrap DP' () is a community developed + 'Camtrap DP' () is a community developed data exchange format for this type of data. With camtraptor you can read and filter data, create overviews of observed species, relative abundance or effort, and plot these data on a map. diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..8330eae0 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,8 @@ +# camtraptor 0.21.0 + +- `read_camtrap_dp()` supports Camtrap DP 1.0 (upcoming Agouti export format) + in favour of Camtrap DP 1.0-rc.1 (#284). + To avoid breaking changes to users, it will down-convert Camtrap DP 1.0 to + 0.1.6 which is currently used as internal data model for camtraptor. +- `get_custom_effort()` now calculates per calendar month/week (#219). +- `write_dwc()` has an updated mapping for dwc_audubon.csv (#274). diff --git a/R/calc_animal_pos.R b/R/calc_animal_pos.R index b0aa577a..61502087 100644 --- a/R/calc_animal_pos.R +++ b/R/calc_animal_pos.R @@ -51,8 +51,11 @@ calc_animal_pos <- function(animal_pos, assertthat::assert_that( length(not_found_cols) == 0, msg = glue::glue( - "Columns `{not_found_cols}` not found in `animal_pos`.", - .transformer = collapse_transformer(sep = "`, `", last = "` and `") + "Columns ", + glue::glue_collapse( + glue::backtick(not_found_cols), sep = ", ", last = " and " + ), + " not found in `animal_pos`." ) ) diff --git a/R/check_package.R b/R/check_package.R index aeebf8e8..223878eb 100644 --- a/R/check_package.R +++ b/R/check_package.R @@ -52,8 +52,8 @@ check_package <- function(package = NULL, assertthat::assert_that( length(tables_absent) == 0, msg = glue::glue( - "Can't find {length(tables_absent)} elements in data package: {tables_absent*}", - .transformer = collapse_transformer(sep = ", ", last = " and ") + "Can't find {length(tables_absent)} elements in data package: ", + glue::glue_collapse(tables_absent, sep = ", ", last = " and ") ) ) if (media) { diff --git a/R/data.R b/R/data.R index 0c25c0d5..08b0937b 100644 --- a/R/data.R +++ b/R/data.R @@ -1,6 +1,6 @@ #' Sample of Camtrap DP formatted data #' -#' A sample [Camera Trap Data Package](https://tdwg.github.io/camtrap-dp) as +#' A sample [Camera Trap Data Package](https://camtrap-dp.tdwg.org) as #' read by [read_camtrap_dp()]. #' The source data are derived from the [Camtrap DP example dataset]( #' https://github.com/tdwg/camtrap-dp/tree/ad0278ef86ef518dacfb306c598dce97667cfb81/example) diff --git a/R/get_n_individuals.R b/R/get_n_individuals.R index d982dfe1..4fd24258 100644 --- a/R/get_n_individuals.R +++ b/R/get_n_individuals.R @@ -87,9 +87,8 @@ get_n_individuals <- function(package = NULL, if (length(species) > 1) { ignored_species <- species[!species == "all"] warning(glue::glue( - "Value `all` found in `species`.", - "All other values are ignored: {ignored_species*}.", - .transformer = collapse_transformer(sep = ", ", last = " and ") + "Value `all` found in `species`. All other values are ignored: ", + glue::glue_collapse(ignored_species, sep = ", ", last = " and ") )) } species <- get_species(package)$scientificName diff --git a/R/get_n_obs.R b/R/get_n_obs.R index 8d3187f7..e94f0613 100644 --- a/R/get_n_obs.R +++ b/R/get_n_obs.R @@ -84,9 +84,8 @@ get_n_obs <- function(package = NULL, if (length(species) > 1) { ignored_species <- species[!species == "all"] warning(glue::glue( - "Value `all` found in `species`.", - "All other values are ignored: {ignored_species*}.", - .transformer = collapse_transformer(sep = ", ", last = " and ") + "Value `all` found in `species`. All other values are ignored: ", + glue::glue_collapse(ignored_species, sep = ", ", last = " and ") )) } species <- get_species(package)$scientificName diff --git a/R/get_prefixes.R b/R/get_prefixes.R index 099b1ab1..95ce2fef 100644 --- a/R/get_prefixes.R +++ b/R/get_prefixes.R @@ -3,7 +3,7 @@ #' Stores prefixes for info shown while hovering over a deployment with the #' mouse. #' List fields in deployments as in -#' . +#' . #' #' Returns a data.frame of all prefixes with the following columns: #' - `info`: Deployment info. diff --git a/R/map_dep.R b/R/map_dep.R index d82582e2..6b3548c0 100644 --- a/R/map_dep.R +++ b/R/map_dep.R @@ -57,7 +57,7 @@ #' - `latitude` #' - `longitude` #' -#' See the [Deployment](https://tdwg.github.io/camtrap-dp/data/#deployments) +#' See the [Deployment](https://camtrap-dp.tdwg.org/data/#deployments) #' section of Camtrap DP for the full list of columns you can use. #' @param palette The palette name or the colour function that values will be #' mapped to. @@ -545,8 +545,8 @@ map_dep <- function(package = NULL, if (n_not_found_cols > 0) { warning(glue::glue( "Can't find {n_not_found_cols} columns defined in `hover_columns` in ", - "deployments: {not_found_cols*}", - .transformer = collapse_transformer(sep = ", ", last = " and ") + "deployments: ", + glue::glue_collapse(not_found_col, sep = ", ", last = " and ") )) } } diff --git a/R/read_camtrap_dp.R b/R/read_camtrap_dp.R index aea7e58b..7817918f 100644 --- a/R/read_camtrap_dp.R +++ b/R/read_camtrap_dp.R @@ -1,7 +1,7 @@ #' Read a Camtrap DP #' #' Reads files from a [Camera Trap Data Package]( -#' https://tdwg.github.io/camtrap-dp) into memory. +#' https://camtrap-dp.tdwg.org) into memory. #' All datetime information is automatically transformed to Coordinated #' Universal Time (UTC). #' Vernacular names found in the metadata (`package$taxonomic`) are added to the @@ -80,12 +80,12 @@ read_camtrap_dp <- function(file = NULL, package <- frictionless::read_package(file) # supported versions - supported_versions <- c("0.1.6", "1.0-rc.1") + supported_versions <- c("0.1.6", "1.0") # get package version profile <- package$profile - if (profile == "https://raw.githubusercontent.com/tdwg/camtrap-dp/1.0-rc.1/camtrap-dp-profile.json") { - version <- "1.0-rc.1" + if (profile == "https://raw.githubusercontent.com/tdwg/camtrap-dp/1.0/camtrap-dp-profile.json") { + version <- "1.0" } else { if (profile == "https://raw.githubusercontent.com/tdwg/camtrap-dp/0.1.6/camtrap-dp-profile.json") { version <- "0.1.6" @@ -97,13 +97,10 @@ read_camtrap_dp <- function(file = NULL, # check version is supported assertthat::assert_that( version %in% supported_versions, - msg = paste0( - glue::glue("Version {version} "), - "is not supported. Supported versions: ", - glue::glue_collapse(glue::glue("{supported_versions}"), - sep = " ", - last = " and "), - ".") + msg = glue::glue( + "Version `{version}` is not supported. Supported versions: ", + glue::glue_collapse(supported_versions, sep = " ", last = " and ") + ) ) # get resource names @@ -152,7 +149,7 @@ read_camtrap_dp <- function(file = NULL, package <- add_taxonomic_info(package) # convert to 0.1.6 - if (version == "1.0-rc.1") { + if (version == "1.0") { package <- convert_to_0.1.6(package, version, media = media) } diff --git a/R/read_wi.R b/R/read_wi.R index 2dbbe585..7e8f88be 100644 --- a/R/read_wi.R +++ b/R/read_wi.R @@ -7,7 +7,7 @@ #' [private](https://www.wildlifeinsights.org/get-started/download/private) #' download. #' The function transforms data and metadata to a [Camera Trap Data Package]( -#' https://tdwg.github.io/camtrap-dp) which can be written to file with +#' https://camtrap-dp.tdwg.org) which can be written to file with #' [frictionless::write_package()]. #' #' **The function has only been tested on image-based projects.** @@ -61,7 +61,7 @@ read_wi <- function(directory = ".") { # Create package package <- frictionless::create_package() # Also sets profile, resources - # Set metadata properties, see https://tdwg.github.io/camtrap-dp/metadata + # Set metadata properties, see https://camtrap-dp.tdwg.org/metadata package$name <- basename(directory) # Unique name if unchanged from WI export zip package$id <- wi_project$ark_id # (e.g. http://n2t.net/ark:/63614/w12001317) package$created <- lubridate::format_ISO8601(lubridate::now()) @@ -229,7 +229,7 @@ read_wi <- function(directory = ".") { # packageID = "" ) - # Create deployments, see https://tdwg.github.io/camtrap-dp/data/#deployments + # Create deployments, see https://camtrap-dp.tdwg.org/data/#deployments deployments <- wi_deployments %>% dplyr::left_join(wi_cameras, by = c("project_id", "camera_id")) %>% @@ -298,7 +298,7 @@ read_wi <- function(directory = ".") { `_id` = NA_character_ ) - # Create media, see https://tdwg.github.io/camtrap-dp/data/#media + # Create media, see https://camtrap-dp.tdwg.org/data/#media media <- wi_images %>% dplyr::distinct(.data$location, .keep_all = TRUE) %>% @@ -317,7 +317,7 @@ read_wi <- function(directory = ".") { `_id` = NA_character_ ) - # Create observations, see https://tdwg.github.io/camtrap-dp/data/#observations + # Create observations, see https://camtrap-dp.tdwg.org/data/#observations observations <- wi_images %>% dplyr::transmute( diff --git a/R/write_dwc.R b/R/write_dwc.R index 5362de85..719b9763 100644 --- a/R/write_dwc.R +++ b/R/write_dwc.R @@ -1,7 +1,7 @@ #' Transform Camtrap DP data to Darwin Core #' #' Transforms data from a [Camera Trap Data Package]( -#' https://tdwg.github.io/camtrap-dp/) to [Darwin Core](https://dwc.tdwg.org/). +#' https://camtrap-dp.tdwg.org) to [Darwin Core](https://dwc.tdwg.org/). #' The resulting CSV files can be uploaded to an [IPT]( #' https://www.gbif.org/ipt) for publication to GBIF. #' A `meta.xml` file is included as well. diff --git a/R/write_eml.R b/R/write_eml.R index 8886a54a..bb2a1ad4 100644 --- a/R/write_eml.R +++ b/R/write_eml.R @@ -1,9 +1,9 @@ #' Transform Camtrap DP metadata to EML #' #' Transforms the metadata of a [Camera Trap Data Package]( -#' https://tdwg.github.io/camtrap-dp/) to an [EML]( -#' https://eml.ecoinformatics.org/) file that can be uploaded to a [GBIF IPT]( -#' https://www.gbif.org/ipt) for publication. +#' https://camtrap-dp.tdwg.org) to an [EML](https://eml.ecoinformatics.org/) +#' file that can be uploaded to a [GBIF IPT](https://www.gbif.org/ipt) for +#' publication. #' #' @param package A Camtrap DP, as read by [read_camtrap_dp()]. #' @param directory Path to local directory to write file to. diff --git a/R/zzz.R b/R/zzz.R index cb886e00..d4d3f075 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -37,26 +37,24 @@ check_value <- function(arg, options = NULL, arg_name, null_allowed = TRUE) { # Suppress long messages with valid options if (length(options) > max_print) { - options_to_print <- c(options[1:max_print], "others..") + options_to_print <- c(options[1:max_print], "others...") } else { options_to_print <- options } - - # compose error message - if (null_allowed == TRUE) { - string_to_print <- "Invalid value for {arg_name} parameter: {wrong_values}. - Valid inputs are: NULL, {options_to_print*}." - } else { - if (is.null(wrong_values)) { - wrong_values <- "NULL" - } - string_to_print <- "Invalid value for {arg_name} parameter: {wrong_values}. - Valid inputs are: {options_to_print*}." + + # Include NULL + if (null_allowed) { + options_to_print <- append(options_to_print, "NULL") + } else if (is.null(wrong_values)) { + wrong_values <- "NULL" } - + + # Compose error message msg_to_print <- glue::glue( - string_to_print, - .transformer = collapse_transformer(sep = ", ", last = " and ") + "Invalid value for {arg_name} parameter: ", + glue::glue_collapse(wrong_values, sep = ", ", last = " and "), + ".\nValid inputs are: ", + glue::glue_collapse(options_to_print, sep = ", ", last = " and ") ) # Provide user message @@ -72,21 +70,6 @@ check_value <- function(arg, options = NULL, arg_name, null_allowed = TRUE) { } } -#' Print list of options -#' -#' @param regex Character. A regular expression to parse. -#' @param ... Additional parameters passed to the collapse. -#' @noRd -collapse_transformer <- function(regex = "[*]$", ...) { - function(code, envir) { - if (grepl(regex, code)) { - code <- sub(regex, "", code) - } - res <- eval(parse(text = code), envir) - glue::glue_collapse(res, ...) - } -} - #' Check reading issues #' #' This helper function throws a warning if issues while reading datapackage @@ -207,8 +190,7 @@ get_dep_no_obs <- function(package = NULL, } message(glue::glue( "There are {n_dep_no_obs} deployments without observations: ", - "{options_to_print*}", - .transformer = collapse_transformer(sep = ", ", last = " and ") + glue::glue_collapse(options_to_print, sep = ", ", last = " and ") )) } return(dep_no_obs) @@ -371,7 +353,7 @@ mutate_when_missing <- function(.data,...){ #' #' This help function adds taxonomic information in `taxonomic` element of #' metadata to `observations`. Notice that higher classification, i.e. new -#' fields in v1.0-rc.1, are removed. +#' fields in v1.0, are removed. #' #' @param package Camera trap data package. #' @return Camera trap data package with taxonomic related cols added to @@ -384,9 +366,8 @@ add_taxonomic_info <- function(package) { # classification) taxon_infos <- dplyr::select( taxon_infos, - dplyr::any_of(c("taxonID", - "taxonIDReference", - "scientificName", + dplyr::all_of("scientificName"), + dplyr::any_of(c("taxonIDReference", "taxonRank")), dplyr::starts_with("vernacularNames") ) @@ -397,7 +378,7 @@ add_taxonomic_info <- function(package) { dplyr::left_join( package$data$observations, taxon_infos, - by = c("taxonID", "scientificName") + by = c("scientificName") ) package$data$observations <- observations } @@ -437,21 +418,19 @@ add_speed_radius_angle <- function(obs){ #' @param media If `TRUE` (default), read media records into memory. If `FALSE`, #' ignore media file to speed up reading larger Camtrap DP packages. #' @noRd -convert_to_0.1.6 <- function(package, from = "1.0-rc.1", media = TRUE){ +convert_to_0.1.6 <- function(package, from = "1.0", media = TRUE){ if (from == "0.1.6") { message(glue::glue("package's version: {from}. No conversion needed.")) return(package) } # check version - supported_versions <- c("1.0-rc.1") + supported_versions <- c("1.0") assertthat::assert_that( from %in% supported_versions, - msg = paste0( + msg = glue::glue( "Only conversion from ", - glue::glue_collapse(glue::glue("{supported_versions}"), - sep = " ", - last = " and "), - " to 0.1.6 is supported." + glue::glue_collapse(supported_versions, sep = " ", last = " and "), + " to `0.1.6` is supported." ) ) # check data slot is present in package @@ -461,14 +440,11 @@ convert_to_0.1.6 <- function(package, from = "1.0-rc.1", media = TRUE){ ) # notify about conversion - message( - writeLines( - c( - "The dataset uses Camtrap DP version 1.0-rc.1, it has been converted to 0.1.6.", - "See https://inbo.github.io/camtraptor/#camtrap-dp for details." - ) - ) - ) + message(glue::glue( + "The dataset uses Camtrap DP version 1.0, it has been converted to 0.1.6.", + "See https://inbo.github.io/camtraptor/#camtrap-dp for details.", + .sep = "\n" + )) # convert metadata package <- convert_metadata_to_0.1.6(package, from) # convert deployments @@ -485,7 +461,7 @@ convert_to_0.1.6 <- function(package, from = "1.0-rc.1", media = TRUE){ #' Convert metadata to Camtrap DP version 0.1.6 #' -#' Convert metadata of a Camtrap DP from version 1.0-rc.1 to 0.1.6 to avoid +#' Convert metadata of a Camtrap DP from version 1.0 to 0.1.6 to avoid #' breaking changes #' #' @param package Camera trap data package object. @@ -493,43 +469,33 @@ convert_to_0.1.6 <- function(package, from = "1.0-rc.1", media = TRUE){ #' @return Camera trap data package object with converted `metadata`. #' @noRd #' @importFrom dplyr %>% .data -convert_metadata_to_0.1.6 <- function(package, from = "1.0-rc.1"){ +convert_metadata_to_0.1.6 <- function(package, from = "1.0"){ authors <- purrr::map_df(package$contributors, unlist) if ("role" %in% names(authors)) { deprecated_roles <- c("author", "maintainer") if (any(deprecated_roles %in% authors$role)) { - warning(paste0( + warning(glue::glue( "Roles ", - glue::glue_collapse(glue::glue("{deprecated_roles}"), - sep = " ", - last = " and "), - " are deprecated in ", - "version {from}." - ) - ) + glue::glue_collapse(deprecated_roles, sep = " ", last = " and "), + " are deprecated in version {from}." + )) } } if ("organizations" %in% names(package)) { warning(glue::glue( - "The field `organizations` is deprecated in ", - "version {from}." - ) - ) + "The field `organizations` is deprecated in version {from}." + )) } if ("animalTypes" %in% names(package)) { warning(glue::glue( - "The field `animalTypes` is deprecated in", - "version {from}." - ) - ) + "The field `animalTypes` is deprecated in version {from}." + )) } names(package)[names(package) == "observationLevel"] <- "classificationLevel" if ("sequenceInterval" %in% names(package$project)) { warning(glue::glue( - "The field `sequenceInterval` is deprecated in", - "version {from}." - ) - ) + "The field `sequenceInterval` is deprecated in version {from}." + )) } package$platform <- package$sources[[1]]$title # `title` value of the first contributor with role `rightsHolder` @@ -537,12 +503,21 @@ convert_metadata_to_0.1.6 <- function(package, from = "1.0-rc.1"){ dplyr::filter(.data$role == "rightsHolder") %>% dplyr::slice(1) %>% dplyr::pull(.data$title) + + # downconvert `captureMethod` to values from Camtrap DP version v0.1.6 + package$project$captureMethod <- + dplyr::case_match( + .default = package$project$captureMethod, + package$project$captureMethod, + "activityDetection" ~ "motionDetection" + ) + return(package) } #' Convert deployments to Camtrap DP version 0.1.6 #' -#' Convert deployments of a Camtrap DP from version 1.0-rc.1 to 0.1.6 to avoid +#' Convert deployments of a Camtrap DP from version 1.0 to 0.1.6 to avoid #' breaking changes #' #' @param package Camera trap data package object. @@ -550,7 +525,7 @@ convert_metadata_to_0.1.6 <- function(package, from = "1.0-rc.1"){ #' @return Camera trap data package object with converted `deployments`. #' @noRd #' @importFrom dplyr %>% .data -convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { +convert_deployments_to_0.1.6 <- function(package, from = "1.0") { # check deployments slot is present assertthat::assert_that( @@ -572,6 +547,8 @@ convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { } # ignore detectionDistance deployments$detectionDistance <- NULL + # ignore cameraDepth + deployments$cameraDepth <- NULL if ("baitUse" %in% names(deployments)) { # baitUse values in version 0.1.6 bait_uses_old <- c("none", "scent", "food", "visual", "acoustic", "other") @@ -604,9 +581,9 @@ convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { dplyr::mutate(baitUse = factor(.data$baitUse, levels = bait_uses_old)) } if ("session" %in% names(deployments)) { - warning(glue::glue("The field `session` of deployments is deprecated in", - "version {from}.") - ) + warning(glue::glue( + "The field `session` of deployments is deprecated in version {from}." + )) } else { deployments <- deployments %>% dplyr::mutate(session = NA) @@ -615,26 +592,30 @@ convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { # map to session and then remove deployments <- deployments %>% dplyr::mutate(session = dplyr::case_when( - is.na(.data$session) ~.data$deploymentGroups, - is.na(.data$deploymentGroups) ~ .data$session, !is.na(.data$deploymentGroups) & !is.na(.data$session) ~ stringr::str_c(.data$session, .data$deploymentGroups, - sep = " | "))) %>% + sep = " | "), + !is.na(.data$deploymentGroups) & is.na(.data$session) ~ + .data$deploymentGroups, + is.na(.data$deploymentGroups) & !is.na(.data$session) ~ + .data$session, + # if there is no value for neither deploymentGroups or session: + .default = NA)) %>% dplyr::select(-"deploymentGroups") } if ("array" %in% names(deployments)) { - warning(glue::glue("The field `array` of deployments is deprecated in", - "version {from}.") - ) + warning(glue::glue( + "The field `array` of deployments is deprecated in version {from}." + )) } else { deployments <- deployments %>% dplyr::mutate(array = NA) } if ("_id" %in% names(deployments)) { - warning(glue::glue("The field `_id` of deployments is deprecated in", - "version {from}.") - ) + warning(glue::glue( + "The field `_id` of deployments is deprecated in version {from}." + )) } else { deployments <- deployments %>% dplyr::mutate("_id" = NA) @@ -654,7 +635,7 @@ convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { #' Convert media to Camtrap DP version 0.1.6 #' -#' Convert media of a Camtrap DP from version 1.0-rc.1 to 0.1.6 to avoid +#' Convert media of a Camtrap DP from version 1.0 to 0.1.6 to avoid #' breaking changes. Notice that this function `MUST` be run before #' `convert_observations_to_0.1.6()`. #' @@ -663,7 +644,7 @@ convert_deployments_to_0.1.6 <- function(package, from = "1.0-rc.1") { #' @return Camera trap data package object with converted `media`. #' @noRd #' @importFrom dplyr %>% .data -convert_media_to_0.1.6 <- function(package, from = "1.0-rc.1") { +convert_media_to_0.1.6 <- function(package, from = "1.0") { # check media slot is present assertthat::assert_that( @@ -689,7 +670,7 @@ convert_media_to_0.1.6 <- function(package, from = "1.0-rc.1") { event_obs <- observations %>% dplyr::filter(is.na(.data$mediaID)) %>% dplyr::select("eventID", "deploymentID", "eventStart", "eventEnd") %>% - # eventID is not anymore required in v1.0-rc1, remove where not present + # eventID is not anymore required in v1.0, remove where not present dplyr::filter(!is.na(.data$eventID)) # Join on deploymentID and timestamp between eventStart and eventEnd @@ -714,21 +695,31 @@ convert_media_to_0.1.6 <- function(package, from = "1.0-rc.1") { dplyr::rename(comments = "mediaComments") } if ("_id" %in% names(media)) { - warning(glue::glue("The field `_id` of media is deprecated in", - "version {from}.") - ) + warning(glue::glue( + "The field `_id` of media is deprecated in version {from}." + )) } else { media <- media %>% dplyr::mutate("_id" = NA) } + # convert captureMethod value to v1.6.0 terms + media <- media %>% + dplyr::mutate( + captureMethod = factor( + ifelse(captureMethod == "activityDetection", + "motionDetection", + as.character(captureMethod)) + ) + ) + package$data$media <- media return(package) } #' Convert observations to Camtrap DP version 0.1.6 #' -#' Convert observations of a Camtrap DP from version 1.0-rc.1 to 0.1.6 to avoid +#' Convert observations of a Camtrap DP from version 1.0 to 0.1.6 to avoid #' breaking changes #' #' @param package Camera trap data package object. @@ -736,7 +727,7 @@ convert_media_to_0.1.6 <- function(package, from = "1.0-rc.1") { #' @return Camera trap data package object with converted `observations`. #' @noRd #' @importFrom dplyr %>% .data -convert_observations_to_0.1.6 <- function(package, from = "1.0-rc.1") { +convert_observations_to_0.1.6 <- function(package, from = "1.0") { # check observations slot is present assertthat::assert_that( @@ -775,10 +766,8 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0-rc.1") { } if ("countNew" %in% names(observations)) { warning(glue::glue( - "The field `countNew` of observations is deprecated in", - "version {from}." - ) - ) + "The field `countNew` of observations is deprecated in version {from}." + )) } else { observations <- observations %>% dplyr::mutate("countNew" = NA) @@ -803,9 +792,9 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0-rc.1") { dplyr::rename(comments = "observationComments") } if ("_id" %in% names(observations)) { - warning(glue::glue("The field `_id` of observations is deprecated in", - "version {from}.") - ) + warning(glue::glue( + "The field `_id` of observations is deprecated in version {from}." + )) } else { observations <- observations %>% dplyr::mutate("_id" = NA) @@ -824,6 +813,16 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0-rc.1") { } # remove bounding box related cols if present observations <- observations %>% dplyr::select(-dplyr::starts_with("bbox")) + # add taxonID if missing + if(!"taxonID" %in% colnames(observations)){ + observations <- observations %>% + dplyr::mutate(taxonID = NA_character_) + } + # add taxonIDReference if missing + if(!"taxonIDReference" %in% colnames(observations)){ + observations <- observations %>% + dplyr::mutate(taxonIDReference = NA_character_) + } package$data$observations <- observations return(package) diff --git a/README.Rmd b/README.Rmd index aa08e1b2..1e66eb6f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -23,11 +23,11 @@ knitr::opts_chunk$set( ![last commit](https://img.shields.io/github/last-commit/inbo/camtraptor) -Camtraptor is an R package to read, explore and visualize Camera Trap Data Packages (Camtrap DP). [Camtrap DP](https://tdwg.github.io/camtrap-dp/) is a community developed data exchange format for this type of data. With camtraptor you can read and filter data, create overviews of observed species, relative abundance or effort, and plot these data on a map. +Camtraptor is an R package to read, explore and visualize Camera Trap Data Packages (Camtrap DP). [Camtrap DP](https://camtrap-dp.tdwg.org) is a community developed data exchange format for this type of data. With camtraptor you can read and filter data, create overviews of observed species, relative abundance or effort, and plot these data on a map. ## Camtrap DP -Camtraptor currently uses the legacy Camtrap DP 0.1.6 for its internal data model. `read_camtrap_dp()` will automatically down-convert Camtrap DP 1.0-rc.1 datasets to that legacy model to avoid introducing breaking changes. The downside is that some newer properties like `media.filePublic` and `observations.eventEnd` are ignored when reading data. +Camtraptor currently uses the legacy Camtrap DP 0.1.6 for its internal data model. `read_camtrap_dp()` will automatically down-convert Camtrap DP 1.0 datasets to that legacy model to avoid introducing breaking changes. The downside is that some newer properties like `deployments.cameraDepth`, `media.filePublic` and `observations.eventEnd` are removed when reading data. The upcoming [camtraptor v1.0](https://github.com/inbo/camtraptor/milestone/3) will update the internal data model to Camtrap DP 1.0 and drop support for Camtrap DP 0.1.6. This is a breaking change that will be accompanied by a number of other major changes. Future versions of camtraptor will always use the latest version of Camtrap DP and up-convert legacy datasets to that model. diff --git a/README.md b/README.md index 1d346c16..4f507202 100644 --- a/README.md +++ b/README.md @@ -16,20 +16,19 @@ commit](https://img.shields.io/github/last-commit/inbo/camtraptor) Camtraptor is an R package to read, explore and visualize Camera Trap -Data Packages (Camtrap DP). [Camtrap -DP](https://tdwg.github.io/camtrap-dp/) is a community developed data -exchange format for this type of data. With camtraptor you can read and -filter data, create overviews of observed species, relative abundance or -effort, and plot these data on a map. +Data Packages (Camtrap DP). [Camtrap DP](https://camtrap-dp.tdwg.org) is +a community developed data exchange format for this type of data. With +camtraptor you can read and filter data, create overviews of observed +species, relative abundance or effort, and plot these data on a map. ## Camtrap DP Camtraptor currently uses the legacy Camtrap DP 0.1.6 for its internal data model. `read_camtrap_dp()` will automatically down-convert Camtrap -DP 1.0-rc.1 datasets to that legacy model to avoid introducing breaking +DP 1.0 datasets to that legacy model to avoid introducing breaking changes. The downside is that some newer properties like -`media.filePublic` and `observations.eventEnd` are ignored when reading -data. +`deployments.cameraDepth`, `media.filePublic` and +`observations.eventEnd` are removed when reading data. The upcoming [camtraptor v1.0](https://github.com/inbo/camtraptor/milestone/3) will update the diff --git a/man/map_dep.Rd b/man/map_dep.Rd index c8994adc..e0bff6b5 100644 --- a/man/map_dep.Rd +++ b/man/map_dep.Rd @@ -95,7 +95,7 @@ created internally by a \verb{get_*()} function). \item \code{longitude} } -See the \href{https://tdwg.github.io/camtrap-dp/data/#deployments}{Deployment} +See the \href{https://camtrap-dp.tdwg.org/data/#deployments}{Deployment} section of Camtrap DP for the full list of columns you can use.} \item{palette}{The palette name or the colour function that values will be diff --git a/man/mica.Rd b/man/mica.Rd index eeb64982..491bb09c 100644 --- a/man/mica.Rd +++ b/man/mica.Rd @@ -14,7 +14,7 @@ An object of class \code{datapackage} (inherits from \code{list}) of length 16. mica } \description{ -A sample \href{https://tdwg.github.io/camtrap-dp}{Camera Trap Data Package} as +A sample \href{https://camtrap-dp.tdwg.org}{Camera Trap Data Package} as read by \code{\link[=read_camtrap_dp]{read_camtrap_dp()}}. The source data are derived from the \href{https://github.com/tdwg/camtrap-dp/tree/ad0278ef86ef518dacfb306c598dce97667cfb81/example}{Camtrap DP example dataset} and are saved in \code{inst/extdata/mica}. diff --git a/man/read_camtrap_dp.Rd b/man/read_camtrap_dp.Rd index fea77426..6ce40786 100644 --- a/man/read_camtrap_dp.Rd +++ b/man/read_camtrap_dp.Rd @@ -26,7 +26,7 @@ as a property \code{data} containing the data as three data frames: } } \description{ -Reads files from a \href{https://tdwg.github.io/camtrap-dp}{Camera Trap Data Package} into memory. +Reads files from a \href{https://camtrap-dp.tdwg.org}{Camera Trap Data Package} into memory. All datetime information is automatically transformed to Coordinated Universal Time (UTC). Vernacular names found in the metadata (\code{package$taxonomic}) are added to the diff --git a/man/read_wi.Rd b/man/read_wi.Rd index 9fbbf544..1a16c3fe 100644 --- a/man/read_wi.Rd +++ b/man/read_wi.Rd @@ -19,7 +19,7 @@ Reads files from an unzipped \href{https://www.wildlifeinsights.org/}{Wildlife I Data can be exported from Wildlife Insights as a \href{https://www.wildlifeinsights.org/get-started/data-download/public}{public} or \href{https://www.wildlifeinsights.org/get-started/download/private}{private} download. -The function transforms data and metadata to a \href{https://tdwg.github.io/camtrap-dp}{Camera Trap Data Package} which can be written to file with +The function transforms data and metadata to a \href{https://camtrap-dp.tdwg.org}{Camera Trap Data Package} which can be written to file with \code{\link[frictionless:write_package]{frictionless::write_package()}}. } \details{ diff --git a/man/write_dwc.Rd b/man/write_dwc.Rd index b2f8971c..843d8f20 100644 --- a/man/write_dwc.Rd +++ b/man/write_dwc.Rd @@ -19,7 +19,7 @@ CSV and \code{meta.xml} files written to disk or a list of data frames when \code{directory = NULL}. } \description{ -Transforms data from a \href{https://tdwg.github.io/camtrap-dp/}{Camera Trap Data Package} to \href{https://dwc.tdwg.org/}{Darwin Core}. +Transforms data from a \href{https://camtrap-dp.tdwg.org}{Camera Trap Data Package} to \href{https://dwc.tdwg.org/}{Darwin Core}. The resulting CSV files can be uploaded to an \href{https://www.gbif.org/ipt}{IPT} for publication to GBIF. A \code{meta.xml} file is included as well. See \code{write_eml()} to create an \code{eml.xml} file. diff --git a/man/write_eml.Rd b/man/write_eml.Rd index f946b71c..4956fa57 100644 --- a/man/write_eml.Rd +++ b/man/write_eml.Rd @@ -45,7 +45,9 @@ name. \code{directory = NULL}. } \description{ -Transforms the metadata of a \href{https://tdwg.github.io/camtrap-dp/}{Camera Trap Data Package} to an \href{https://eml.ecoinformatics.org/}{EML} file that can be uploaded to a \href{https://www.gbif.org/ipt}{GBIF IPT} for publication. +Transforms the metadata of a \href{https://camtrap-dp.tdwg.org}{Camera Trap Data Package} to an \href{https://eml.ecoinformatics.org/}{EML} +file that can be uploaded to a \href{https://www.gbif.org/ipt}{GBIF IPT} for +publication. } \section{Transformation details}{ diff --git a/tests/testthat/test-check_package.R b/tests/testthat/test-check_package.R index 16116c48..9a12895f 100644 --- a/tests/testthat/test-check_package.R +++ b/tests/testthat/test-check_package.R @@ -1,7 +1,7 @@ test_that("check_package() returns deprecation warning on datapkg argument", { expect_warning( check_package(datapkg = mica, function_name = "function_name_here"), - regexp = "The `datapkg` argument of `function_name_here()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `function_name_here()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) @@ -9,13 +9,13 @@ test_that("check_package() returns deprecation warning on datapkg argument", { test_that("check_package() returns error when package is not a list", { expect_error( check_package("not a list!"), - regexp = "package is not a list.", + "package is not a list.", fixed = TRUE ) expect_error( check_package(data.frame(letters = c("a", "b", "c"), numbers = c(pi, 2 * pi, 3 * pi))), - regexp = "package is not a list.", + "package is not a list.", fixed = TRUE ) }) @@ -23,7 +23,7 @@ test_that("check_package() returns error when package is not a list", { test_that("check_package() returns error on missing data", { expect_error( check_package(purrr::discard_at(mica, at = "data")), - regexp = "data element is missing from package", + "data element is missing from package", fixed = TRUE ) }) @@ -33,14 +33,14 @@ test_that("check_package() returns error if not all elements are present", { mica_no_dep$data$deployments <- NULL expect_error( check_package(mica_no_dep, media = TRUE), - regexp = "Can't find 1 elements in data package: deployments", + "Can't find 1 elements in data package: deployments", fixed = TRUE ) mica_no_dep_no_obs <- mica_no_dep mica_no_dep_no_obs$data$observations <- NULL expect_error( check_package(mica_no_dep_no_obs), - regexp = "Can't find 2 elements in data package: deployments and observations", + "Can't find 2 elements in data package: deployments and observations", fixed = TRUE ) }) @@ -51,7 +51,7 @@ test_that( mica_no_media$data$media <- NULL expect_error( check_package(mica_no_media, media = TRUE), - regexp = "Can't find 1 elements in data package: media", + "Can't find 1 elements in data package: media", fixed = TRUE ) expect_true(check_package(mica_no_media)) @@ -62,7 +62,7 @@ test_that("check_package() returns error if observations is not a data.frame", { mica_listed$data$observations <- as.list(mica_listed$data$observations) expect_error( check_package(mica_listed), - regexp = "package$data$observations is not a data frame", + "package$data$observations is not a data frame", fixed = TRUE ) }) @@ -72,7 +72,7 @@ test_that("check_package() returns error if deployments is not a data.frame", { mica_listed$data$deployments <- as.list(mica_listed$data$deployments) expect_error( check_package(mica_listed), - regexp = "package$data$deployments is not a data frame", + "package$data$deployments is not a data frame", fixed = TRUE ) }) @@ -89,7 +89,7 @@ test_that("check_package() returns error if media is not a data.frame", { mica_listed$data$media <- as.list(mica_listed$data$media) expect_error( check_package(mica_listed), - regexp = "package$data$media is not a data frame", + "package$data$media is not a data frame", fixed = TRUE ) }) diff --git a/tests/testthat/test-check_species.R b/tests/testthat/test-check_species.R index 74bff7d1..e60681c6 100644 --- a/tests/testthat/test-check_species.R +++ b/tests/testthat/test-check_species.R @@ -12,17 +12,18 @@ test_that("Error is returned if one or more species are invalid", { "Ans streperi", # wrong "blauwe reiger", "Anas strepera", - "bad name" + "bad name" # wrong ) - ), # wrong - paste( - "Invalid value for species parameter: ans streperi and bad", - "name.\nValid inputs are: anas platyrhynchos, anas strepera, ardea,", - "ardea cinerea, castor fiber, homo sapiens, martes foina, mustela", - "putorius, vulpes vulpes, mallard, gadwall, great herons, grey", - "heron, eurasian beaver, human, beech marten, european polecat, red", - "fox, wilde eend, krakeend and others..." ), + paste0( + "Invalid value for species parameter: ans streperi and bad name.\n", + "Valid inputs are: anas platyrhynchos, anas strepera, ardea, ardea ", + "cinerea, castor fiber, homo sapiens, martes foina, mustela putorius, ", + "vulpes vulpes, mallard, gadwall, great herons, grey heron, eurasian ", + "beaver, human, beech marten, european polecat, red fox, wilde eend, ", + "krakeend and others..." + ), + fixed = TRUE ) }) diff --git a/tests/testthat/test-get_cam_op.R b/tests/testthat/test-get_cam_op.R index e5726572..60dda148 100644 --- a/tests/testthat/test-get_cam_op.R +++ b/tests/testthat/test-get_cam_op.R @@ -6,18 +6,20 @@ test_that("input camtrap dp is checked properly", { # station_col is not NA expect_error( get_cam_op(mica, station_col = NA), - regexp = "station_col is not a string (a length one character vector).", + "station_col is not a string (a length one character vector).", fixed = TRUE) # station_col is length 1 expect_error( get_cam_op(mica, station_col = c("locationID","locationName")), - regexp = "station_col is not a string (a length one character vector).", + "station_col is not a string (a length one character vector).", fixed = TRUE) # station_col value is not a column of deployments expect_error( get_cam_op(mica, station_col = "bla"), - regexp = paste("Station column name (`bla`) is not valid:", - "it must be one of the deployments column names."), + paste0( + "Station column name (`bla`) is not valid: ", + "it must be one of the deployments column names." + ), fixed = TRUE ) # column specified by station_col contains empty values @@ -173,7 +175,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_cam_op(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_cam_op()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_cam_op()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_custom_effort.R b/tests/testthat/test-get_custom_effort.R index 44ebff35..fe073958 100644 --- a/tests/testthat/test-get_custom_effort.R +++ b/tests/testthat/test-get_custom_effort.R @@ -1,10 +1,11 @@ test_that("get_custom_effort returns error for invalid group_by value", { - expect_error(get_custom_effort(mica, group_by = "bad_value"), - regexp = paste0("Invalid value for group_by parameter: ", - "bad_value.\n", - "Valid inputs are: NULL, day, week, month ", - "and year."), - fixed = TRUE + expect_error( + get_custom_effort(mica, group_by = "bad_value"), + paste0( + "Invalid value for group_by parameter: bad_value.\n", + "Valid inputs are: day, week, month, year and NULL" + ), + fixed = TRUE ) }) @@ -14,10 +15,12 @@ test_that("get_custom_effort returns error for start not a Date", { expect_error( get_custom_effort( mica, - start = lubridate::as_datetime("2021-12-05 22:25:01 CET")), - regexp = paste0("`start` must be `NULL` or an object of class Date. ", - "Did you forget to convert a string to Date with ", - "`as.Date()`?"), + start = lubridate::as_datetime("2021-12-05 22:25:01 CET") + ), + paste0( + "`start` must be `NULL` or an object of class Date. ", + "Did you forget to convert a string to Date with `as.Date()`?" + ), fixed = TRUE ) }) @@ -26,60 +29,73 @@ test_that("get_custom_effort returns error for end not a Date", { expect_error(get_custom_effort(mica, end = "2021-01-01")) # No datetime allowed expect_error( - get_custom_effort(mica, - end = lubridate::as_datetime("2021-12-05 22:25:01 CET")), - regexp = paste0("`end` must be `NULL` or an object of class Date. ", - "Did you forget to convert a string to Date with ", - "`as.Date()`?"), + get_custom_effort( + mica, + end = lubridate::as_datetime("2021-12-05 22:25:01 CET") + ), + paste0( + "`end` must be `NULL` or an object of class Date. ", + "Did you forget to convert a string to Date with `as.Date()`?" + ), fixed = TRUE ) }) test_that("get_custom_effort returns error if end earlier than start", { expect_error( - get_custom_effort(mica, - start = as.Date("2021-01-01"), - end = as.Date("1990-01-01")), - regexp = paste0("`end` value is set too early. `end` value must be not ", - "earlier than the start of the earliest deployment: ", - "2019-10-09."), + get_custom_effort( + mica, start = as.Date("2021-01-01"), end = as.Date("1990-01-01") + ), + paste0( + "`end` value is set too early. `end` value must be not earlier than the ", + "start of the earliest deployment: 2019-10-09." + ), fixed = TRUE ) }) test_that( "get_custom_effort returns error if start later than end of latest deployment", { - expect_error(get_custom_effort(mica, start = as.Date("2030-01-01")), - regexp = paste0( - "`start` value is set too late. ", - "`start` value must be not later than the end of the latest ", - "deployment: 2021-04-18." - ), - fixed = TRUE - ) + expect_error( + get_custom_effort(mica, start = as.Date("2030-01-01")), + paste0( + "`start` value is set too late. ", + "`start` value must be not later than the end of the latest deployment: ", + "2021-04-18." + ), + fixed = TRUE + ) }) test_that( "get_custom_effort returns error if end earlier than begin of first deployment", { - expect_error(get_custom_effort(mica, end = as.Date("1900-04-05")), - regexp = paste0( - "`end` value is set too early. ", - "`end` value must be not earlier than the start of the ", - "earliest deployment: 2019-10-09."), - fixed = TRUE + expect_error( + get_custom_effort(mica, end = as.Date("1900-04-05")), + paste0( + "`end` value is set too early. ", + "`end` value must be not earlier than the start of the ", + "earliest deployment: 2019-10-09." + ), + fixed = TRUE ) }) test_that("get_custom_effort returns error for invalid effort units", { - expect_error(get_custom_effort(mica, unit = "second"), - regexp = paste0("Invalid value for unit parameter: second.\n", - "Valid inputs are: hour and day."), - fixed = TRUE + expect_error( + get_custom_effort(mica, unit = "second"), + paste0( + "Invalid value for unit parameter: second.\n", + "Valid inputs are: hour and day" + ), + fixed = TRUE ) - expect_error(get_custom_effort(mica, unit = "year"), - regexp = paste0("Invalid value for unit parameter: year.\n", - "Valid inputs are: hour and day."), - fixed = TRUE + expect_error( + get_custom_effort(mica, unit = "year"), + paste0( + "Invalid value for unit parameter: year.\n", + "Valid inputs are: hour and day" + ), + fixed = TRUE ) }) @@ -238,7 +254,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_custom_effort(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_custom_effort()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_custom_effort()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_effort.R b/tests/testthat/test-get_effort.R index 1df1a113..86de9ad1 100644 --- a/tests/testthat/test-get_effort.R +++ b/tests/testthat/test-get_effort.R @@ -1,12 +1,20 @@ testthat::test_that("get_effort returns error for invalid effort units", { testthat::expect_error( get_effort(mica, unit = "bad_unit"), - "Invalid value for unit parameter: bad_unit. -Valid inputs are: second, minute, hour, day, month and year.") + paste0( + "Invalid value for unit parameter: bad_unit.\n", + "Valid inputs are: second, minute, hour, day, month and year" + ), + fixed = TRUE + ) testthat::expect_error( get_effort(mica, unit = NULL), - "Invalid value for unit parameter: NULL. -Valid inputs are: second, minute, hour, day, month and year.") + paste0( + "Invalid value for unit parameter: NULL.\n", + "Valid inputs are: second, minute, hour, day, month and year" + ), + fixed = TRUE + ) }) testthat::test_that("get_effort returns error for invalid datapackage", { @@ -82,7 +90,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_effort(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_effort()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_effort()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-get_n_individuals.R b/tests/testthat/test-get_n_individuals.R index c2ff521e..79ba8cc9 100644 --- a/tests/testthat/test-get_n_individuals.R +++ b/tests/testthat/test-get_n_individuals.R @@ -254,7 +254,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_n_individuals(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_n_individuals()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_n_individuals()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_n_obs.R b/tests/testthat/test-get_n_obs.R index 0b4befd3..a761490f 100644 --- a/tests/testthat/test-get_n_obs.R +++ b/tests/testthat/test-get_n_obs.R @@ -287,7 +287,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_n_obs(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_n_obs()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_n_obs()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_n_species.R b/tests/testthat/test-get_n_species.R index 19c27ef3..8aa5bc29 100644 --- a/tests/testthat/test-get_n_species.R +++ b/tests/testthat/test-get_n_species.R @@ -51,7 +51,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_n_species(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_n_species()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_n_species()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_rai.R b/tests/testthat/test-get_rai.R index dd3056df..678b85d0 100644 --- a/tests/testthat/test-get_rai.R +++ b/tests/testthat/test-get_rai.R @@ -111,7 +111,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_rai(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_rai()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_rai()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-get_rai_individuals.R b/tests/testthat/test-get_rai_individuals.R index 0d59c2f8..c625370a 100644 --- a/tests/testthat/test-get_rai_individuals.R +++ b/tests/testthat/test-get_rai_individuals.R @@ -115,7 +115,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_rai_individuals(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_rai_individuals()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_rai_individuals()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_record_table.R b/tests/testthat/test-get_record_table.R index 79772aa7..9e0193f8 100644 --- a/tests/testthat/test-get_record_table.R +++ b/tests/testthat/test-get_record_table.R @@ -201,7 +201,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_record_table(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_record_table()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_record_table()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_scientific_name.R b/tests/testthat/test-get_scientific_name.R index 415ad934..36b939f4 100644 --- a/tests/testthat/test-get_scientific_name.R +++ b/tests/testthat/test-get_scientific_name.R @@ -25,7 +25,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_scientific_name(datapkg = mica, vernacular_name = "beech marten") ), - regexp = "The `datapkg` argument of `get_scientific_name()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_scientific_name()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-get_species.R b/tests/testthat/test-get_species.R index fcfb0408..17cbf7e5 100644 --- a/tests/testthat/test-get_species.R +++ b/tests/testthat/test-get_species.R @@ -78,7 +78,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", get_species(datapkg = mica) ), - regexp = "The `datapkg` argument of `get_species()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `get_species()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-map_dep.R b/tests/testthat/test-map_dep.R index f882984e..9f8f1cd3 100644 --- a/tests/testthat/test-map_dep.R +++ b/tests/testthat/test-map_dep.R @@ -1,6 +1,6 @@ test_that("map_dep() returns error when feature is missing", { expect_error(map_dep(mica), - regexp = 'argument "feature" is missing, with no default', + 'argument "feature" is missing, with no default', fixed = TRUE ) }) @@ -15,22 +15,21 @@ test_that("map_dep() returns error for invalid feature", { "rai_individuals", "effort" ) - valid_input_string <- - sub(",([^,]*)$", " and\\1", paste(valid_inputs, collapse = ", ")) - no_feature <- "not a feature" + no_feature <- "not_a_feature" # invalid feature expect_error( map_dep(mica, feature = no_feature), - regexp = glue::glue("Invalid value for feature parameter: {no_feature}.", - "Valid inputs are: {valid_input_string}.", - .sep = "\n" + paste0( + "Invalid value for feature parameter: not_a_feature.\n", + "Valid inputs are: n_species, n_obs, n_individuals, rai, ", + "rai_individuals and effort" ), fixed = TRUE ) # more than one feature expect_error( map_dep(mica, feature = valid_inputs[1:2]), - regexp = "`feature` must have length 1", + "`feature` must have length 1", fixed = TRUE ) }) @@ -38,17 +37,17 @@ test_that("map_dep() returns error for invalid feature", { test_that("map_dep() can handle combinations of arguments", { expect_warning( map_dep(mica, feature = "n_species", effort_unit = "month"), - regexp = "`effort_unit` ignored for `feature = n_species`.", + "`effort_unit` ignored for `feature = n_species`.", fixed = TRUE ) expect_warning( map_dep(mica, feature = "n_species", sex = "male"), - regexp = "`sex` ignored for `feature = n_species`.", + "`sex` ignored for `feature = n_species`.", fixed = TRUE ) expect_warning( map_dep(mica, feature = "n_species", life_stage = "subadult"), - regexp = "`life_stage` ignored for `feature = n_species`.", + "`life_stage` ignored for `feature = n_species`.", fixed = TRUE ) }) @@ -57,31 +56,31 @@ test_that("map_dep() can toggle showing deployments with zero values", { # expect an error when the toggle has length > 1 expect_error(map_dep(mica, feature = "n_obs", zero_values_show = c(TRUE, TRUE)), - regexp = "zero_values_show must be a logical: TRUE or FALSE.", + "zero_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) # expect an error when the toggle is not TRUE or FALSE expect_error(map_dep(mica, feature = "n_obs", zero_values_show = "dax"), - regexp = "zero_values_show must be a logical: TRUE or FALSE.", + "zero_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) expect_error(map_dep(mica, feature = "n_obs", zero_values_show = NA), - regexp = "zero_values_show must be a logical: TRUE or FALSE.", + "zero_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) expect_error(map_dep(mica, feature = "n_obs", zero_values_show = NULL), - regexp = "zero_values_show must be a logical: TRUE or FALSE.", + "zero_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) # expect a message when an url/size is provided but the toggle is off suppressMessages(expect_message( map_dep(mica, feature = "n_obs", zero_values_show = FALSE), - regexp = "`zero_values_show` is FALSE: `zero_values_icon_url` ignored.", + "`zero_values_show` is FALSE: `zero_values_icon_url` ignored.", fixed = TRUE )) suppressMessages(expect_message( map_dep(mica, feature = "n_obs", zero_values_show = FALSE), - regexp = "`zero_values_show` is FALSE: `zero_values_icon_size` is ignored.", + "`zero_values_show` is FALSE: `zero_values_icon_size` is ignored.", fixed = TRUE )) @@ -94,31 +93,31 @@ test_that("map_dep() can toggle showing deployments with NA values", { # expect an error when the toggle has length > 1 expect_error(map_dep(mica, feature = "n_obs", na_values_show = c(TRUE, TRUE)), - regexp = "na_values_show must be a logical: TRUE or FALSE.", + "na_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) # expect an error when the toggle is not TRUE or FALSE expect_error(map_dep(mica, feature = "n_obs", na_values_show = "dax"), - regexp = "na_values_show must be a logical: TRUE or FALSE.", + "na_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) expect_error(map_dep(mica, feature = "n_obs", na_values_show = NA), - regexp = "na_values_show must be a logical: TRUE or FALSE.", + "na_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) expect_error(map_dep(mica, feature = "n_obs", na_values_show = NULL), - regexp = "na_values_show must be a logical: TRUE or FALSE.", + "na_values_show must be a logical: TRUE or FALSE.", fixed = TRUE) # expect a message when an url/size is provided but the toggle is off suppressMessages(expect_message( map_dep(mica, feature = "n_obs", na_values_show = FALSE), - regexp = "`na_values_show` is FALSE: `na_values_icon_url` ignored.", + "`na_values_show` is FALSE: `na_values_icon_url` ignored.", fixed = TRUE )) suppressMessages(expect_message( map_dep(mica, feature = "n_obs", na_values_show = FALSE), - regexp = "`na_values_show` is FALSE: `na_values_icon_size` is ignored.", + "`na_values_show` is FALSE: `na_values_icon_size` is ignored.", fixed = TRUE )) @@ -143,20 +142,18 @@ test_that("map_dep() can calculate and get feature values", { ) suppressMessages(expect_message( map_dep(mica, feature = "rai", species = "krakeend"), - regexp = - glue::glue("There are 3 deployments without observations: {no_obs_deployments_str}"), + glue::glue("There are 3 deployments without observations: {no_obs_deployments_str}"), fixed = TRUE )) suppressMessages(expect_message( map_dep(mica, feature = "rai_individuals", species = "krakeend"), - regexp = - glue::glue("There are 3 deployments without observations: {no_obs_deployments_str}"), + glue::glue("There are 3 deployments without observations: {no_obs_deployments_str}"), fixed = TRUE )) expect_warning( map_dep(mica, feature = "n_species", species = "krakeend"), - regexp = "`species` ignored for `feature = n_species`", + "`species` ignored for `feature = n_species`", fixed = TRUE ) }) @@ -169,11 +166,11 @@ test_that("map_dep() allows for scale modifications", { relative_scale = FALSE )) expect_warning(map_dep(mica, feature = "effort", max_scale = 0), - regexp = "Relative scale used: max_scale value ignored.", + "Relative scale used: max_scale value ignored.", fixed = TRUE ) expect_error(map_dep(mica, feature = "effort", relative_scale = FALSE), - regexp = "If you use an absolute scale, `max_scale` must be a number, not `NULL`.", + "If you use an absolute scale, `max_scale` must be a number, not `NULL`.", fixed = TRUE ) }) @@ -206,17 +203,17 @@ test_that("map_dep() allows filtering by predicates", { expect_message( map_dep(mica, pred_gt("latitude", 51.18), feature = "n_species"), - regexp = "df %>% dplyr::filter((latitude > 51.18))", + "df %>% dplyr::filter((latitude > 51.18))", fixed = TRUE) suppressMessages(expect_message( map_dep(mica, pred_gt("latitude", 90), feature = "n_species"), - regexp = "No deployments left.", + "No deployments left.", fixed = TRUE)) suppressMessages(expect_message( map_dep(mica, pred_gt("latitude", 90), feature = "n_species"), - regexp = "df %>% dplyr::filter((latitude > 90))", + "df %>% dplyr::filter((latitude > 90))", fixed = TRUE)) }) @@ -233,7 +230,7 @@ test_that("Argument datapkg is deprecated: warning returned", { lifecycle_verbosity = "warning", map_dep(datapkg = mica, feature = "n_obs") ), - regexp = "The `datapkg` argument of `map_dep()` is deprecated as of camtraptor 0.16.0.", + "The `datapkg` argument of `map_dep()` is deprecated as of camtraptor 0.16.0.", fixed = TRUE ) }) diff --git a/tests/testthat/test-read_camtrap_dp.R b/tests/testthat/test-read_camtrap_dp.R index 48cd60c8..6fd31bd6 100644 --- a/tests/testthat/test-read_camtrap_dp.R +++ b/tests/testthat/test-read_camtrap_dp.R @@ -1,3 +1,12 @@ +## read camera trap data package from v1.0 +path_to_json_v1 <- "https://raw.githubusercontent.com/tdwg/camtrap-dp/1.0/example/datapackage.json" +dp_v1_with_media <- suppressMessages( + read_camtrap_dp(path_to_json_v1) +) +dp_v1_without_media <- suppressMessages( + read_camtrap_dp(path_to_json_v1, media = FALSE) +) + test_that("file argument is checked properly", { expect_error(read_camtrap_dp("aaa")) expect_error(read_camtrap_dp(1)) @@ -7,7 +16,7 @@ test_that("file can be an URL", { # camtraptor is trailing camtrap-dp, refer to specific commit to keep using old version # dp_path <- "https://raw.githubusercontent.com/tdwg/camtrap-dp/main/example/datapackage.json" dp_path <- - "https://raw.githubusercontent.com/tdwg/camtrap-dp/81379eadfafee3398a4b498c1141e617c5982f4a/example/datapackage.json" + "https://raw.githubusercontent.com/tdwg/camtrap-dp/1.0/example/datapackage.json" dp <- suppressMessages(read_camtrap_dp( file = dp_path, media = FALSE @@ -19,27 +28,20 @@ test_that("file can be an URL", { class(dp$data$observations))) }) -test_that("only DP versions 1.0-rc.1 and dp 0.1.6 are supported", { +test_that("only DP versions 1.0 and dp 0.1.6 are supported", { expect_error( suppressMessages(read_camtrap_dp("https://raw.githubusercontent.com/tdwg/camtrap-dp/bb046c85a55bef2ced709357c0047f0136df8326/example/datapackage.json")), - "Version https://raw.githubusercontent.com/tdwg/camtrap-dp/0.5/camtrap-dp-profile.json is not supported. Supported versions: 0.1.6 and 1.0-rc.1." + "Version `https://raw.githubusercontent.com/tdwg/camtrap-dp/0.5/camtrap-dp-profile.json` is not supported. Supported versions: 0.1.6 and 1.0", + fixed = TRUE ) expect_error( suppressMessages(read_camtrap_dp("https://raw.githubusercontent.com/tdwg/dwc-for-biologging/403f57db105982dc05b70f3cf66fd2b5591798db/derived/camtrap-dp/data/raw/datapackage.json")), - "Version tabular-data-package is not supported. Supported versions: 0.1.6 and 1.0-rc.1." + "Version `tabular-data-package` is not supported. Supported versions: 0.1.6 and 1.0", + fixed = TRUE ) }) -## read camera trap data package from v1.0-rc1 -path_to_json_v1rc1 <- "https://raw.githubusercontent.com/tdwg/camtrap-dp/1.0-rc.1/example/datapackage.json" -dp_v1_rc1_with_media <- suppressMessages( - read_camtrap_dp(path_to_json_v1rc1) -) -dp_v1_rc1_without_media <- suppressMessages( - read_camtrap_dp(path_to_json_v1rc1, media = FALSE) -) - test_that("test warnings while reading files with parsing issues", { local_edition(2) camtrap_dp_file_with_issues <- system.file( @@ -48,10 +50,10 @@ test_that("test warnings while reading files with parsing issues", { package = "camtraptor" ) w <- capture_warnings( - camtraptor::read_camtrap_dp(file = camtrap_dp_file_with_issues) + dp_issues <- camtraptor::read_camtrap_dp(file = camtrap_dp_file_with_issues) ) # warning on deployments - expect_equal( + expect_identical( w[2], # w[1] is returned by readr via frictionless paste0( "One or more parsing issues occurred while reading `deployments`. ", @@ -59,8 +61,9 @@ test_that("test warnings while reading files with parsing issues", { "`readr::problems()`." ) ) + # warning on observations - expect_equal( + expect_identical( w[4], # w[3] is returned by readr via frictionless paste0( "One or more parsing issues occurred while reading `observations`. ", @@ -68,8 +71,9 @@ test_that("test warnings while reading files with parsing issues", { "`readr::problems()`." ) ) + # warning on media - expect_equal( + expect_identical( w[6], # w[5] is returned by readr via frictionless paste0( "One or more parsing issues occurred while reading `media`. ", @@ -97,12 +101,13 @@ test_that("output is a list", { file = dp_path, media = FALSE )) + expect_true(is.list(dp_without_media)) - expect_equal(class(dp_without_media), "list") - expect_true(is.list(dp_v1_rc1_with_media)) - expect_equal(class(dp_v1_rc1_with_media), "list") - expect_true(is.list(dp_v1_rc1_without_media)) - expect_equal(class(dp_v1_rc1_without_media), "list") + expect_type(dp_without_media, "list") + expect_true(is.list(dp_v1_with_media)) + expect_type(dp_v1_with_media, "list") + expect_true(is.list(dp_v1_without_media)) + expect_type(dp_v1_without_media, "list") }) test_that("output data slot is a list of length 3", { @@ -113,12 +118,13 @@ test_that("output data slot is a list of length 3", { file = dp_path, media = FALSE )) + expect_true("data" %in% names(dp_without_media)) - expect_equal(length(dp_without_media$data), 3) - expect_true("data" %in% names(dp_v1_rc1_with_media)) - expect_equal(length(dp_v1_rc1_with_media$data), 3) - expect_true("data" %in% names(dp_v1_rc1_without_media)) - expect_equal(length(dp_v1_rc1_without_media$data), 3) + expect_length(dp_without_media$data, 3) + expect_true("data" %in% names(dp_v1_with_media)) + expect_length(dp_v1_with_media$data, 3) + expect_true("data" %in% names(dp_v1_without_media)) + expect_length(dp_v1_without_media$data, 3) }) test_that("media arg influences only slot media", { @@ -136,28 +142,28 @@ test_that("media arg influences only slot media", { # media is NULL only for data packages imported using `media` = `FALSE` expect_null(dp_without_media$data$media) expect_false(is.null(dp_with_media$data$media)) - expect_null(dp_v1_rc1_without_media$data$media) - expect_false(is.null(dp_v1_rc1_with_media$data$media)) + expect_null(dp_v1_without_media$data$media) + expect_false(is.null(dp_v1_with_media$data$media)) # metadata are the same metadata_with_media <- dp_with_media metadata_with_media$data <- NULL metadata_without_media <- dp_without_media metadata_without_media$data <- NULL expect_identical(metadata_with_media, metadata_without_media) - metadata_with_media_dp_v1_rc1 <- dp_v1_rc1_with_media - metadata_with_media_dp_v1_rc1$data <- NULL - metadata_without_media_dp_v1_rc1 <- dp_v1_rc1_without_media - metadata_without_media_dp_v1_rc1$data <- NULL - expect_identical(metadata_with_media_dp_v1_rc1, - metadata_without_media_dp_v1_rc1) + metadata_with_media_dp_v1 <- dp_v1_with_media + metadata_with_media_dp_v1$data <- NULL + metadata_without_media_dp_v1 <- dp_v1_without_media + metadata_without_media_dp_v1$data <- NULL + expect_identical(metadata_with_media_dp_v1, + metadata_without_media_dp_v1) # observations are the same expect_identical( dp_with_media$data$observations, dp_without_media$data$observations ) expect_identical( - dp_v1_rc1_with_media$data$observations, - dp_v1_rc1_without_media$data$observations + dp_v1_with_media$data$observations, + dp_v1_without_media$data$observations ) # deployments are the same expect_identical( @@ -165,8 +171,8 @@ test_that("media arg influences only slot media", { dp_without_media$data$deployments ) expect_identical( - dp_v1_rc1_with_media$data$deployments, - dp_v1_rc1_without_media$data$deployments + dp_v1_with_media$data$deployments, + dp_v1_without_media$data$deployments ) }) @@ -181,11 +187,11 @@ test_that("datapackage data elements are named as in resource names", { )) resource_names <- frictionless::resources(dp_without_media) expect_true(all(names(dp_without_media$data) %in% resource_names)) - # check for v1.0-rc1 - resource_names <- frictionless::resources(dp_v1_rc1_with_media) - expect_true(all(names(dp_v1_rc1_with_media$data) %in% resource_names)) - resource_names <- frictionless::resources(dp_v1_rc1_without_media) - expect_true(all(names(dp_v1_rc1_without_media$data %in% resource_names))) + # check for v1.0 + resource_names <- frictionless::resources(dp_v1_with_media) + expect_true(all(names(dp_v1_with_media$data) %in% resource_names)) + resource_names <- frictionless::resources(dp_v1_without_media) + expect_true(all(names(dp_v1_without_media$data %in% resource_names))) }) test_that("datapackage resources are tibble dataframes", { @@ -201,13 +207,13 @@ test_that("datapackage resources are tibble dataframes", { class(dp_without_media$data$deployments))) expect_true(all(c("tbl_df", "tbl", "data.frame") %in% class(dp_without_media$data$observations))) - # check for v1.0-rc1 (only one of the two: chosen for the one with media) + # check for v1.0 (only one of the two: chosen for the one with media) expect_true(all(c("tbl_df", "tbl", "data.frame") %in% - class(dp_v1_rc1_with_media$data$deployments))) + class(dp_v1_with_media$data$deployments))) expect_true(all(c("tbl_df", "tbl", "data.frame") %in% - class(dp_v1_rc1_with_media$data$observations))) + class(dp_v1_with_media$data$observations))) expect_true(all(c("tbl_df", "tbl", "data.frame") %in% - class(dp_v1_rc1_with_media$data$media))) + class(dp_v1_with_media$data$media))) }) test_that( @@ -248,34 +254,34 @@ test_that( }) test_that( - "v1.0-rc.1: sc. names and vernacular names in obs match info in metadata", { + "v1.0: sc. names and vernacular names in obs match info in metadata", { taxon_infos <- purrr::map_dfr( - dp_v1_rc1_with_media$taxonomic, + dp_v1_with_media$taxonomic, function(x) x %>% as.data.frame() ) %>% dplyr::tibble() expect_true( - all(names(taxon_infos) %in% names(dp_v1_rc1_with_media$data$observations)) + all(names(taxon_infos) %in% names(dp_v1_with_media$data$observations)) ) # get scientific names from observations and check that they match with # taxonomic info - sc_names <- dp_v1_rc1_with_media$data$observations$scientificName[!is.na( - dp_v1_rc1_with_media$data$observations$scientificName + sc_names <- dp_v1_with_media$data$observations$scientificName[!is.na( + dp_v1_with_media$data$observations$scientificName )] expect_true(all(sc_names %in% taxon_infos$scientificName)) # get vernacular names in English from observations and check that they match # with taxonomic info - en_names <- dp_v1_rc1_with_media$data$observations$vernacularNames.eng[ - !is.na(dp_v1_rc1_with_media$data$observations$vernacularNames.eng) + en_names <- dp_v1_with_media$data$observations$vernacularNames.eng[ + !is.na(dp_v1_with_media$data$observations$vernacularNames.eng) ] expect_true(all(en_names %in% taxon_infos$vernacularNames.eng)) # get vernacular names in Dutch from observations and check that they match # with taxonomic info - nl_names <- dp_v1_rc1_with_media$data$observations$vernacularNames.nld[ + nl_names <- dp_v1_with_media$data$observations$vernacularNames.nld[ !is.na( - dp_v1_rc1_with_media$data$observations$vernacularNames.nld + dp_v1_with_media$data$observations$vernacularNames.nld ) ] expect_true(all(nl_names %in% taxon_infos$vernacularNames.nld)) @@ -300,78 +306,100 @@ test_that("path is deprecated", { }) test_that( - "read deployments v1.0-rc1: latitude follows longitude and both present", { - expect_true("latitude" %in% names(dp_v1_rc1_with_media$data$deployments)) - expect_true("longitude" %in% names(dp_v1_rc1_with_media$data$deployments)) - which(names(dp_v1_rc1_with_media$data$deployments) == "latitude") == - which(names(dp_v1_rc1_with_media$data$deployments) == "longitude") + 1 + "read deployments v1.0: latitude follows longitude and both present", { + expect_true("latitude" %in% names(dp_v1_with_media$data$deployments)) + expect_true("longitude" %in% names(dp_v1_with_media$data$deployments)) + which(names(dp_v1_with_media$data$deployments) == "latitude") == + which(names(dp_v1_with_media$data$deployments) == "longitude") + 1 }) -test_that("read deployments v1.0-rc1: eventStart is renamed as start", { - expect_false("eventStart" %in% names(dp_v1_rc1_with_media$data$deployments)) - expect_true("start" %in% names(dp_v1_rc1_with_media$data$deployments)) +test_that("read deployments v1.0: eventStart is renamed as start", { + expect_false("eventStart" %in% names(dp_v1_with_media$data$deployments)) + expect_true("start" %in% names(dp_v1_with_media$data$deployments)) }) -test_that("read deployments v1.0-rc1: eventEnd is renamed as end", { - expect_false("eventEnd" %in% names(dp_v1_rc1_with_media$data$deployments)) - expect_true("end" %in% names(dp_v1_rc1_with_media$data$deployments)) +test_that("read deployments v1.0: eventEnd is renamed as end", { + expect_false("eventEnd" %in% names(dp_v1_with_media$data$deployments)) + expect_true("end" %in% names(dp_v1_with_media$data$deployments)) }) test_that( - "read deployments v1.0-rc1: cameraDelay is renamed as cameraInterval", { - expect_false("cameraDelay" %in% names(dp_v1_rc1_with_media$data$deployments)) - expect_true("cameraInterval" %in% names(dp_v1_rc1_with_media$data$deployments)) + "read deployments v1.0: cameraDelay is renamed as cameraInterval", { + expect_false("cameraDelay" %in% names(dp_v1_with_media$data$deployments)) + expect_true("cameraInterval" %in% names(dp_v1_with_media$data$deployments)) }) test_that( - "read deployments v1.0-rc1: detectionDistance is a new term and is ignored", { + "read deployments v1.0: detectionDistance is a new term and is ignored", { expect_false( - "detectionDistance" %in% names(dp_v1_rc1_with_media$data$deployments) + "detectionDistance" %in% names(dp_v1_with_media$data$deployments) ) }) test_that( - "read deployments v1.0-rc1: baitUse is a factor, not a boolean", { - expect_s3_class(dp_v1_rc1_with_media$data$deployments$baitUse, "factor") + "read deployments v1.0: baitUse is a factor, not a boolean", { + expect_s3_class(dp_v1_with_media$data$deployments$baitUse, "factor") baitUse_levels <- c("none", "scent", "food", "visual", "acoustic", "other") - expect_equal( - levels(dp_v1_rc1_with_media$data$deployments$baitUse), baitUse_levels + expect_identical( + levels(dp_v1_with_media$data$deployments$baitUse), baitUse_levels ) - # boolean NA becomes a factor NA - expect_true(all(is.na(dp_v1_rc1_with_media$data$deployments$baitUse))) } ) -test_that("read deployments v1.0-rc1: session is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$deployments$session))) +test_that("read deployments v1.0: boolean NA becomes a factor NA", { + ## no longer present in the example package! + skip_if_not(any(is.na( + readr::read_csv( + file.path(dirname(path_to_json_v1), "deployments.csv"), + show_col_types = FALSE, + col_select = "baitUse" + ) + )), + message = "There are no NA values present in deployments.baitUse") + + expect_true(all(is.na(dp_v1_with_media$data$deployments$baitUse))) }) -test_that("read deployments v1.0-rc1: array is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$deployments$array))) +test_that( + "read deployments v1.0: session is left empty when deploymentGroups is NA",{ + skip_if(all(!is.na( + readr::read_csv( + file.path(dirname(path_to_json_v1), "deployments.csv"), + show_col_types = FALSE, + col_select = "deploymentGroups" + ) + )), message = "All rows have value for deploymentGroups in deployments.csv") + expect_true(any(is.na( + dp_v1_with_media$data$deployments$session + ))) + }) + +test_that("read deployments v1.0: array is left empty", { + expect_true(all(is.na(dp_v1_with_media$data$deployments$array))) }) -test_that("read deployments v1.0-rc1: deploymentTags is renamed as tags", { +test_that("read deployments v1.0: deploymentTags is renamed as tags", { expect_false( - "deploymentTags" %in% names(dp_v1_rc1_with_media$data$deployments) + "deploymentTags" %in% names(dp_v1_with_media$data$deployments) ) - expect_true("tags" %in% names(dp_v1_rc1_with_media$data$deployments)) + expect_true("tags" %in% names(dp_v1_with_media$data$deployments)) }) test_that( - "read deployments v1.0-rc1: deploymentComments is renamed as comments", { + "read deployments v1.0: deploymentComments is renamed as comments", { expect_false( - "deploymentComments" %in% names(dp_v1_rc1_with_media$data$deployments) + "deploymentComments" %in% names(dp_v1_with_media$data$deployments) ) - expect_true("comments" %in% names(dp_v1_rc1_with_media$data$deployments)) + expect_true("comments" %in% names(dp_v1_with_media$data$deployments)) } ) -test_that("read deployments v1.0-rc1: _id is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$deployments$`_id`))) +test_that("read deployments v1.0: _id is left empty", { + expect_true(all(is.na(dp_v1_with_media$data$deployments$`_id`))) }) test_that( - "all cols `v0.1.6:deployments` are present in `v1.0-rc1:deployments`", { + "all cols `v0.1.6:deployments` are present in `v1.0`", { dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -379,145 +407,146 @@ test_that( file = dp_path, media = FALSE )) - cols_deployments_dp_v1_rc1 <- dp_v1_rc1_without_media$data$deployments %>% + + cols_deployments_dp_v1 <- dp_v1_without_media$data$deployments %>% names() cols_deployments_dp_v0_1_6 <- dp_without_media$data$deployments %>% names() - expect_equal(cols_deployments_dp_v0_1_6, cols_deployments_dp_v1_rc1) + expect_identical(cols_deployments_dp_v0_1_6, cols_deployments_dp_v1) } ) -test_that("read observations v1.0-rc1: media-based observations are removed", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$observations$mediaID))) +test_that("read observations v1.0: media-based observations are removed", { + expect_true(all(is.na(dp_v1_with_media$data$observations$mediaID))) }) -test_that("read observations v1.0-rc1: eventID is renamed as sequenceID", { - expect_false("eventID" %in% names(dp_v1_rc1_with_media$data$observations)) - expect_true("sequenceID" %in% names(dp_v1_rc1_with_media$data$observations)) +test_that("read observations v1.0: eventID is renamed as sequenceID", { + expect_false("eventID" %in% names(dp_v1_with_media$data$observations)) + expect_true("sequenceID" %in% names(dp_v1_with_media$data$observations)) }) -test_that("read observations v1.0-rc1: eventStart is renamed as timestamp", { - expect_false("eventStart" %in% names(dp_v1_rc1_with_media$data$observations)) - expect_true("timestamp" %in% names(dp_v1_rc1_with_media$data$observations)) +test_that("read observations v1.0: eventStart is renamed as timestamp", { + expect_false("eventStart" %in% names(dp_v1_with_media$data$observations)) + expect_true("timestamp" %in% names(dp_v1_with_media$data$observations)) }) test_that( - "read observations v1.0-rc1: eventEnd is a new term and is ignored", { - expect_false("eventEnd" %in% names(dp_v1_rc1_with_media$data$observations)) + "read observations v1.0: eventEnd is a new term and is ignored", { + expect_false("eventEnd" %in% names(dp_v1_with_media$data$observations)) }) test_that( - "read observations v1.0-rc1: observationLevel is a new term and is ignored", { + "read observations v1.0: observationLevel is a new term and is ignored", { expect_false( - "observationLevel" %in% names(dp_v1_rc1_with_media$data$observations) + "observationLevel" %in% names(dp_v1_with_media$data$observations) ) }) test_that( - "read observations v1.0-rc1: cameraSetupType is renamed as cameraSetup", { + "read observations v1.0: cameraSetupType is renamed as cameraSetup", { expect_false( - "cameraSetupType" %in% names(dp_v1_rc1_with_media$data$observations) + "cameraSetupType" %in% names(dp_v1_with_media$data$observations) ) - expect_true("cameraSetup" %in% names(dp_v1_rc1_with_media$data$observations)) + expect_true("cameraSetup" %in% names(dp_v1_with_media$data$observations)) }) -test_that("read observations v1.0-rc1: countNew is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$observations$countNew))) +test_that("read observations v1.0: countNew is left empty", { + expect_true(all(is.na(dp_v1_with_media$data$observations$countNew))) }) -test_that("read observations v1.0-rc1: higher taxonomic ranks ignored", { +test_that("read observations v1.0: higher taxonomic ranks ignored", { expect_false( any(c("kingdom", "phylum", "class", "order", "family", "genus") %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) ) }) test_that( - "read observations v1.0-rc1: behavior is renamed as behavior", { - expect_false("behavior" %in% names(dp_v1_rc1_with_media$data$observations)) - expect_true("behaviour" %in% names(dp_v1_rc1_with_media$data$observations)) + "read observations v1.0: behavior is renamed as behavior", { + expect_false("behavior" %in% names(dp_v1_with_media$data$observations)) + expect_true("behaviour" %in% names(dp_v1_with_media$data$observations)) }) test_that( - "read observations v1.0-rc1: classificationProbability renamed as classificationConfidence", + "read observations v1.0: classificationProbability renamed as classificationConfidence", { expect_false( "classificationProbability" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) expect_true( "classificationConfidence" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) } ) test_that( - "read observations v1.0-rc1: observationComments is renamed as comments", { + "read observations v1.0: observationComments is renamed as comments", { expect_false( - "observationComments" %in% names(dp_v1_rc1_with_media$data$observations) + "observationComments" %in% names(dp_v1_with_media$data$observations) ) - expect_true("comments" %in% names(dp_v1_rc1_with_media$data$observations)) + expect_true("comments" %in% names(dp_v1_with_media$data$observations)) }) -test_that("read observations v1.0-rc1: _id is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$observations$`_id`))) +test_that("read observations v1.0: _id is left empty", { + expect_true(all(is.na(dp_v1_with_media$data$observations$`_id`))) }) test_that( - "read observations v1.0-rc1: individualSpeed is renamed as speed", { + "read observations v1.0: individualSpeed is renamed as speed", { expect_false( - "individualSpeed" %in% names(dp_v1_rc1_with_media$data$observations) + "individualSpeed" %in% names(dp_v1_with_media$data$observations) ) - expect_true("speed" %in% names(dp_v1_rc1_with_media$data$observations)) + expect_true("speed" %in% names(dp_v1_with_media$data$observations)) }) test_that( - "read observations v1.0-rc1: individualPositionRadius is renamed as radius", { + "read observations v1.0: individualPositionRadius is renamed as radius", { expect_false( "individualPositionRadius" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) - expect_true("radius" %in% names(dp_v1_rc1_with_media$data$observations)) + expect_true("radius" %in% names(dp_v1_with_media$data$observations)) } ) test_that( - "read observations v1.0-rc1: individualPositionAngle is renamed as angle", { + "read observations v1.0: individualPositionAngle is renamed as angle", { expect_false( "individualPositionAngle" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) - expect_true("angle" %in% names(dp_v1_rc1_with_media$data$observations)) + expect_true("angle" %in% names(dp_v1_with_media$data$observations)) } ) test_that( - "read observations v1.0-rc1: bounding box related columns are not present", { + "read observations v1.0: bounding box related columns are not present", { expect_false( "bboxX" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) expect_false( "bboxY" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) expect_false( "bboxWidth" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) expect_false( " bboxHeight" %in% - names(dp_v1_rc1_with_media$data$observations) + names(dp_v1_with_media$data$observations) ) } ) test_that( - "all cols `v0.1.6:observations` are present in `v1.0-rc1:observations`", { + "all cols `v0.1.6:observations` are present in `v1.0`", { # notice that cols with vernacular names are different due to use of ISO - # 693-3 in v1.0-rc1 vs ISO 693-2 in v0.1.6. + # 693-3 in v1.0 vs ISO 693-2 in v0.1.6. dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -525,43 +554,43 @@ test_that( file = dp_path, media = FALSE )) - cols_obs_dp_v1_rc1 <- dp_v1_rc1_with_media$data$observations %>% + cols_obs_dp_v1 <- dp_v1_with_media$data$observations %>% dplyr::select(-dplyr::starts_with("vernacularNames")) %>% names() cols_obs_dp_v0_1_6 <- dp_without_media$data$observations %>% dplyr::select(-dplyr::starts_with("vernacularNames")) %>% names() expect_true( - all(cols_obs_dp_v0_1_6 %in% cols_obs_dp_v1_rc1) + all(cols_obs_dp_v0_1_6 %in% cols_obs_dp_v1) ) } ) -test_that("read media v1.0-rc1: sequenceID is added", { - expect_true("sequenceID" %in% names(dp_v1_rc1_with_media$data$media)) +test_that("read media v1.0: sequenceID is added", { + expect_true("sequenceID" %in% names(dp_v1_with_media$data$media)) }) test_that( - "read media v1.0-rc1: filePublic is a new term in v1.0-rc1 and is ignored", { - expect_false("filePublic" %in% names(dp_v1_rc1_with_media$data$media)) + "read media v1.0: filePublic is a new term in v1.0 and is ignored", { + expect_false("filePublic" %in% names(dp_v1_with_media$data$media)) }) -test_that("read media v1.0-rc1: favorite is renamed as favourite", { - expect_false("favorite" %in% names(dp_v1_rc1_with_media$data$media)) - expect_true("favourite" %in% names(dp_v1_rc1_with_media$data$media)) +test_that("read media v1.0: favorite is renamed as favourite", { + expect_false("favorite" %in% names(dp_v1_with_media$data$media)) + expect_true("favourite" %in% names(dp_v1_with_media$data$media)) }) -test_that("read media v1.0-rc1: mediaComments is renamed as comments", { - expect_false("mediaComments" %in% names(dp_v1_rc1_with_media$data$media)) - expect_true("comments" %in% names(dp_v1_rc1_with_media$data$media)) +test_that("read media v1.0: mediaComments is renamed as comments", { + expect_false("mediaComments" %in% names(dp_v1_with_media$data$media)) + expect_true("comments" %in% names(dp_v1_with_media$data$media)) }) -test_that("read media v1.0-rc1: _id is left empty", { - expect_true(all(is.na(dp_v1_rc1_with_media$data$media$`_id`))) +test_that("read media v1.0: _id is left empty", { + expect_true(all(is.na(dp_v1_with_media$data$media$`_id`))) }) test_that( - "all cols `v0.1.6:media` are present in `v1.0-rc1:media`", { + "all cols `v0.1.6:media` are present in `v1.0:media`", { dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -569,10 +598,30 @@ test_that( file = dp_path, media = TRUE )) - cols_media_dp_v1_rc1 <- dp_v1_rc1_with_media$data$media %>% + cols_media_dp_v1 <- dp_v1_with_media$data$media %>% names() cols_media_dp_v0_1_6 <- dp_with_media$data$media %>% names() - expect_equal(cols_media_dp_v1_rc1, cols_media_dp_v0_1_6) + expect_identical(cols_media_dp_v1, cols_media_dp_v0_1_6) } ) + +test_that("v1.0:media$captureMethod values are replaced with v0.1.6 values",{ + expect_false( + "activityDetection" %in% dp_v1_with_media$data$media$captureMethod + ) + expect_identical( + levels(dp_v1_with_media$data$media$captureMethod), + c("motionDetection", "timeLapse") + ) +}) + +test_that("v1.0:project$captureMethod values are replaced with v0.1.6 values", { + expect_false( + "activityDetection" %in% dp_v1_with_media$project$captureMethod + ) + expect_identical( + dp_v1_with_media$project$captureMethod, + c("motionDetection", "timeLapse") + ) +}) diff --git a/tests/testthat/test-write_eml.R b/tests/testthat/test-write_eml.R index f68fbf8b..fcbd4d45 100644 --- a/tests/testthat/test-write_eml.R +++ b/tests/testthat/test-write_eml.R @@ -33,20 +33,24 @@ test_that("write_eml() can write an eml", { }) test_that("write_eml() checks for title", { - expect_error(write_eml(mica), - regexp = "The dataset must have a `title`.", - fixed = TRUE) + expect_error( + write_eml(mica), + "The dataset must have a `title`.", + fixed = TRUE + ) }) test_that("write_eml() checks for keywords", { - expect_error(write_eml(mica, title = "mica title", keywords = NULL), - regexp = "`keywords` should be a character (vector).", - fixed = TRUE) + expect_error( + write_eml(mica, title = "mica title", keywords = NULL), + "`keywords` should be a character (vector).", + fixed = TRUE + ) }) test_that("write_eml() notifies to check metadata", { suppressMessages(expect_message( write_eml(mica, title = "mica title", directory = NULL), - regexp = "Please review generated metadata carefully before publishing.", + "Please review generated metadata carefully before publishing.", fixed = TRUE)) })