diff --git a/R/get_cam_op.R b/R/get_cam_op.R index c90fa783..7203bcb0 100644 --- a/R/get_cam_op.R +++ b/R/get_cam_op.R @@ -51,6 +51,8 @@ get_cam_op <- function(package = NULL, # check camera trap data package package <- check_package(package, datapkg, "get_cam_op") + # Check that station_col is a single string + assertthat::assert_that(assertthat::is.string(station_col)) # Check that station_col is one of the columns in deployments assertthat::assert_that( station_col %in% names(package$data$deployments), @@ -59,6 +61,18 @@ get_cam_op <- function(package = NULL, "it must be one of the deployments column names." ) ) + + # Check that station_col doesn't contain empty values (NA) + n_na <- package$data$deployments %>% + dplyr::filter(is.na(.data[[station_col]])) %>% + nrow() + assertthat::assert_that( + n_na == 0, + msg = glue::glue( + "Column `{station_col}` must be non-empty: ", + "{n_na} NAs found." + ) + ) assertthat::assert_that( use_prefix %in% c(TRUE, FALSE), diff --git a/R/get_custom_effort.R b/R/get_custom_effort.R index e0041a0e..03322902 100644 --- a/R/get_custom_effort.R +++ b/R/get_custom_effort.R @@ -1,9 +1,9 @@ #' Get custom effort #' #' Gets the custom effort (deployment duration) for a custom time window and a -#' specific time interval such as day or month. -#' The custom effort is also calculated over all deployments, although -#' filtering predicates can be applied as well. +#' specific time interval such as day or month. The custom effort is also +#' calculated over all deployments, although filtering predicates can be applied +#' as well. This function calls `get_cam_op()` internally. #' #' @param package Camera trap data package object, as returned by #' `read_camtrap_dp()`. @@ -122,7 +122,7 @@ get_custom_effort <- function(package = NULL, deployments <- package$data$deployments # camera operation matrix with filter(s) on deployments - cam_op <- get_cam_op(package, ...) + cam_op <- get_cam_op(package, ..., station_col = "deploymentID") # Sum effort over all deployments for each day (in day units) sum_effort <- colSums(cam_op, na.rm = TRUE, dims = 1) diff --git a/R/get_record_table.R b/R/get_record_table.R index 39b12a9f..4bced81e 100644 --- a/R/get_record_table.R +++ b/R/get_record_table.R @@ -102,7 +102,7 @@ get_record_table <- function(package = NULL, removeDuplicateRecords = TRUE, datapkg = lifecycle::deprecated()) { # check data package - package <- check_package(package, datapkg, "get_record_table") + package <- check_package(package, datapkg, "get_record_table", media = TRUE) # check stationCol is a valid column name assertthat::assert_that( diff --git a/R/get_species.R b/R/get_species.R index 924d068a..226f8fe2 100644 --- a/R/get_species.R +++ b/R/get_species.R @@ -14,7 +14,7 @@ #' get_species(mica) get_species <- function(package = NULL, datapkg = lifecycle::deprecated()) { # Check camera trap data package - package <- check_package(package, datapkg, "get_species") + package <- check_package(package, datapkg, "get_species", media = FALSE) # Get taxonomic information from package metadata if (!"taxonomic" %in% names(package)) { diff --git a/R/map_dep.R b/R/map_dep.R index 5027c5a9..c18cac6b 100644 --- a/R/map_dep.R +++ b/R/map_dep.R @@ -523,7 +523,7 @@ map_dep <- function(package = NULL, ) } else if (feature == "rai") { feat_df <- get_rai(package, species = species, sex = sex, life_stage = life_stage, ...) - feat_df <- feat_df %>% dplyr::rename(n = rai) + feat_df <- feat_df %>% dplyr::rename(n = "rai") } else if (feature == "rai_individuals") { feat_df <- get_rai_individuals( package, @@ -537,7 +537,7 @@ map_dep <- function(package = NULL, effort_unit <- "hour" # default value of get_effort() } feat_df <- get_effort(package, unit = effort_unit, ...) - feat_df <- feat_df %>% dplyr::rename(n = effort) + feat_df <- feat_df %>% dplyr::rename(n = "effort") } # define title legend diff --git a/R/read_camtrap_dp.R b/R/read_camtrap_dp.R index 555ddf46..d98bca53 100644 --- a/R/read_camtrap_dp.R +++ b/R/read_camtrap_dp.R @@ -8,8 +8,8 @@ #' `observations` data frame. #' #' @param file Path or URL to a `datapackage.json` file. -#' @param media If `TRUE`, read media records into memory. If `FALSE`, ignore -#' media file to speed up reading larger Camtrap DP packages. +#' @param media If `TRUE` (default), read media records into memory. If `FALSE`, +#' ignore media file to speed up reading larger Camtrap DP packages. #' @param path Path to the directory containing the datapackage. Use `file` #' with path or URL to a `datapackage.json` file instead. #' @return List describing a Data Package (as returned by @@ -24,7 +24,10 @@ #' @examples #' \dontrun{ #' # Read Camtrap DP package -#' camtrap_dp_file <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor") +#' camtrap_dp_file <- system.file( +#' "extdata", "mica", "datapackage.json", +#' package = "camtraptor" +#' ) #' muskrat_coypu <- read_camtrap_dp(camtrap_dp_file) #' #' # Read Camtrap DP package and ignore media file @@ -46,8 +49,9 @@ read_camtrap_dp <- function(file = NULL, media = TRUE, path = lifecycle::deprecated()) { + # check path (deprecated) warning_detail <- paste( - "Use parameter `file` containing the path or URL to the `datapackage.json`", + "Use argument `file` containing the path or URL to the `datapackage.json`", "file. The use of parameter `path` with path to the local directory is ", "deprecated since version 0.6.0." ) @@ -58,7 +62,6 @@ read_camtrap_dp <- function(file = NULL, details = warning_detail ) } - # define the right file value if (lifecycle::is_present(path)) { file <- file.path(path, "datapackage.json") @@ -67,91 +70,105 @@ read_camtrap_dp <- function(file = NULL, if (dir.exists(file)) { file <- file.path(file, "datapackage.json") } - - # check media + # check media arg assertthat::assert_that( media %in% c(TRUE, FALSE), msg = "`media` must be a logical: TRUE or FALSE" ) - # read files + + # read package (metadata) package <- frictionless::read_package(file) - deployments <- frictionless::read_resource(package, "deployments") - issues_deployments <- readr::problems(deployments) - if (nrow(issues_deployments) > 0) { - warning(glue::glue( - "One or more parsing issues occurred while reading deployments. ", - "See `?read_camtrap_dp()` for examples on how to use ", - "`readr::problems()`." - )) - } - observations <- frictionless::read_resource(package, "observations") - issues_observations <- readr::problems(observations) - if (nrow(issues_observations) > 0) { - warning(glue::glue( - "One or more parsing issues occurred while reading observations. ", - "See `?read_camtrap_dp()` for examples on how to use ", - "`readr::problems()`." - )) + + # supported versions + supported_versions <- c("0.1.6", "1.0-rc.1") + + # 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" + } else { + if (profile == "https://raw.githubusercontent.com/tdwg/camtrap-dp/0.1.6/camtrap-dp-profile.json") { + version <- "0.1.6" + } else { + version <- profile + } } - # patch for non-standard values speed, radius, angle - # see https://github.com/inbo/camtraptor/issues/185 - obs_col_names <- names(observations) - if (all(c("X22", "X23", "X24") %in% names(observations))) { - observations <- observations %>% - dplyr::rename(speed = "X22", radius = "X23", angle = "X24") - message( - paste("Three extra fields in `observations` interpreted as `speed`,", - "`radius` and `angle`." - ) + # 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 "), + ".") + ) + + # get resource names + resource_names <- frictionless::resources(package) + #check needed resources are present + resources_to_read <- c("deployments", "media", "observations") + assertthat::assert_that( + all(resources_to_read %in% resource_names), + msg = glue::glue( + "One or more resources among ", + glue::glue_collapse(resources_to_read, sep = ", ", last = " and "), + " is missing." ) + ) + + # read deployments + deployments <- frictionless::read_resource(package, "deployments") + issues_deployments <- check_reading_issues(deployments, "deployments") + # read observations (needed to create sequenceID in media) + observations <- frictionless::read_resource(package, "observations") + issues_observations <- check_reading_issues(observations, "observations") + + if (version == "0.1.6"){ + observations <- add_speed_radius_angle(observations) } - # create first version datapackage with resources in data element + # create first version datapackage with resources in data slot data <- list( "deployments" = deployments, "media" = NULL, "observations" = observations ) + package$data <- data - # get taxonomic info - taxon_infos <- get_species(package) - # add vernacular names to observations - if (!is.null(taxon_infos)) { - cols_taxon_infos <- names(taxon_infos) - observations <- - dplyr::left_join( - observations, - taxon_infos, - by = c("taxonID", "scientificName") - ) - observations <- - observations %>% - dplyr::relocate(dplyr::one_of(cols_taxon_infos), .after = "cameraSetup") - # Inherit parsing issues from reading - attr(observations, which = "problems") <- issues_observations - package$data$observations <- observations + + # read media if needed + if (media) { + media_df <- frictionless::read_resource(package, "media") + issues_media <- check_reading_issues(media_df, "media") + data$media <- media_df } - if (media == TRUE) { - media <- frictionless::read_resource(package, "media") - issues_media <- readr::problems(media) - if (nrow(issues_media) > 0) { - warning(glue::glue( - "One or more parsing issues occurred while reading media. ", - "See `?read_camtrap_dp()` for examples on how to use ", - "`readr::problems()`." - )) - } + + package$data <- data + package <- check_package(package, media = media) + + package <- add_taxonomic_info(package) + + # convert to 0.1.6 + if (version == "1.0-rc.1") { + package <- convert_to_0.1.6(package, version, media = media) } - - # return list resources - if (is.data.frame(media)) { - data <- list( - "deployments" = deployments, - "media" = media, - "observations" = observations - ) - package$data <- data + + # order columns + package$data$deployments <- order_cols_deployments(package$data$deployments) + package$data$observations <- order_cols_observations( + package$data$observations + ) + if (!is.null(package$data$media)) { + package$data$media <- order_cols_media(package$data$media) } - package + + package <- check_package(package, media = media) + + # Inherit parsing issues from reading + attr(package$data$observations, which = "problems") <- issues_observations + + return(package) } diff --git a/R/write_eml.R b/R/write_eml.R index 6a71f970..8886a54a 100644 --- a/R/write_eml.R +++ b/R/write_eml.R @@ -209,8 +209,8 @@ write_eml <- function(package, taxonomy <- dplyr::filter(taxonomy, .data$taxonRank == "species") } sci_names <- - dplyr::rename(taxonomy, Species = scientificName) %>% - dplyr::select(Species) + dplyr::rename(taxonomy, Species = "scientificName") %>% + dplyr::select("Species") eml$dataset$coverage <- EML::set_coverage( begin = package$temporal$start, diff --git a/R/zzz.R b/R/zzz.R index 3a772adf..1235e748 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -4,16 +4,19 @@ #' It checks whether the data package is a list containing an element called #' `data` with the following resources as tibble data frames: #' - `observations` -#' - `multimedia` +#' - `media` #' - `deployments` #' #' @param package Camera trap data package #' @param datapkg Deprecated. Use `package` instead. +#' @param media Has the `media` resource been loaded while reading the data +#' package? Default: `FALSE`. #' @return A camera trap data package. #' @noRd check_package <- function(package = NULL, datapkg = NULL, - function_name) { + function_name, + media = FALSE) { if (lifecycle::is_present(datapkg) & !is.null(datapkg)) { lifecycle::deprecate_warn( when = "0.16.0", @@ -24,30 +27,43 @@ check_package <- function(package = NULL, package <- datapkg } } + # check media arg + assertthat::assert_that( + media %in% c(TRUE, FALSE), + msg = "`media` must be a logical: TRUE or FALSE" + ) # camera trap data package is a list assertthat::assert_that(is.list(package)) assertthat::assert_that(!is.data.frame(package)) # check existence of an element called data assertthat::assert_that("data" %in% names(package)) - # check validity data element of package: does it contain all 4 elements? - elements <- c("deployments", "media", "observations") - tables_absent <- names(elements)[ - !names(elements) %in% names(package$data) + # check validity data element of package: does it contain deployments and + # observations? + elements <- c("deployments", "observations") + if (media) { + elements <- c(elements, "media") + } + tables_absent <- elements[ + !elements %in% names(package$data) ] - n_tables_absent <- length(tables_absent) - assertthat::assert_that(n_tables_absent == 0, + assertthat::assert_that(length(tables_absent) == 0, msg = glue::glue( - "Can't find {n_tables_absent} elements in data package: {tables_absent*}", + "Can't find {tables_absent} elements in data package: {tables_absent*}", .transformer = collapse_transformer(sep = ", ", last = " and ") ) ) - + if (media) { + assertthat::assert_that( + !is.null(package$data$media), + msg = glue::glue("Can't find media in .$data.") + ) + } # check observations and deployments are data.frames assertthat::assert_that(is.data.frame(package$data$observations)) assertthat::assert_that(is.data.frame(package$data$deployments)) - # check multimedia is a data.frame (if imported, i.e. if not NULL) - if (!is.null(package$data$multimedia)) { - assertthat::assert_that(is.data.frame(package$data$multimedia)) + # check media is a data.frame (if imported, i.e. if not NULL) + if (!is.null(package$data$media)) { + assertthat::assert_that(is.data.frame(package$data$media)) } package } @@ -141,6 +157,29 @@ collapse_transformer <- function(regex = "[*]$", ...) { } } +#' Check reading issues +#' +#' This helper function throws a warning if issues while reading datapackage +#' resources (data.frames) are detected. The issues are also returned as +#' data.frame. +#' +#' @param df Data.frame. +#' @param df_name Character with name of the data.frame passed to `df`. +#' @noRd +#' @return Data.frame containing the issues as returned by `readr::problems()`. +check_reading_issues <- function(df, df_name) { + # get problems + issues_df <- readr::problems(df) + if (nrow(issues_df) > 0) { + warning(glue::glue( + "One or more parsing issues occurred while reading `{df_name}`. ", + "Check `?read_camtrap_dp()` for examples on how to use ", + "`readr::problems()`." + )) + } + return(issues_df) +} + #' Custom label format function #' #' Add "+" to last label of legend while using absolute scale. At the moment @@ -397,3 +436,567 @@ mutate_when_missing <- function(.data,...){ if(!rlang::is_empty(columns_to_add)){.data <- dplyr::mutate(.data,...)} return(.data) } + +#' Add taxonomic information to observations +#' +#' 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. +#' +#' @param package Camera trap data package. +#' @return Camera trap data package with taxonomic related cols added to +#' `.$data$observations`. +#' @noRd +add_taxonomic_info <- function(package) { + # get taxonomic info from metadata + taxon_infos <- get_species(package) + # select only basic taxonomic info as in v0.1.6 (no higher + # classification) + taxon_infos <- dplyr::select( + taxon_infos, + dplyr::any_of(c("taxonID", + "taxonIDReference", + "scientificName", + "taxonRank")), + dplyr::starts_with("vernacularNames") + ) + # add taxon infos to observations + if (!is.null(taxon_infos)) { + cols_taxon_infos <- names(taxon_infos) + observations <- + dplyr::left_join( + package$data$observations, + taxon_infos, + by = c("taxonID", "scientificName") + ) + package$data$observations <- observations + } + return(package) +} + +#' Add speed, radius, angle to a Camtrap DP version 0.1.6 +#' +#' This help function is a patch for adding non-standard columns `speed`, +#' `radius` and `angle` in `observations`. See +#' https://github.com/inbo/camtraptor/issues/185 +#' +#' @param obs Data.frame with `observations` from a Camtrap DP package, version +#' 0.1.6. +#' @return Data.frame with `observations`. +#' @noRd +add_speed_radius_angle <- function(obs){ + obs_col_names <- names(obs) + if (all(c("X22", "X23", "X24") %in% names(obs))) { + obs <- obs %>% + dplyr::rename(speed = "X22", radius = "X23", angle = "X24") + message( + paste("Three extra fields in `observations` interpreted as `speed`,", + "`radius` and `angle`." + ) + ) + } + return(obs) +} + +#' Convert a Camtrap DP to version 0.1.6 +#' +#' This conversion function takes as input a Camtrap DP and returns +#' +#' @param package Camera trap data package object. +#' @param from Character identifying the version of `package`. +#' @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){ + 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") + assertthat::assert_that( + from %in% supported_versions, + msg = paste0( + "Only conversion from ", + glue::glue_collapse(glue::glue("{supported_versions}"), + sep = " ", + last = " and "), + " to 0.1.6 is supported." + ) + ) + # check data slot is present in package + assertthat::assert_that( + "data" %in% names(package), + msg = "Can't find `data` element in `package`." + ) + + # 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." + ) + ) + ) + # convert metadata + package <- convert_metadata_to_0.1.6(package, from) + # convert deployments + package <- convert_deployments_to_0.1.6(package, from) + # convert media + if (media) { + package <- convert_media_to_0.1.6(package, from) + } + # convert observations + package <- convert_observations_to_0.1.6(package, from) + + return(package) +} + +#' 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 +#' breaking changes +#' +#' @param package Camera trap data package object. +#' @param from Character identifying the version of `package`. +#' @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"){ + 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( + "Roles ", + glue::glue_collapse(glue::glue("{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}." + ) + ) + } + if ("animalTypes" %in% names(package)) { + warning(glue::glue( + "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}." + ) + ) + } + package$platform <- package$sources[[1]]$title + # `title` value of the first contributor with role `rightsHolder` + package$rightsHolder <- purrr::map_df(package$contributors, unlist) %>% + dplyr::filter(.data$role == "rightsHolder") %>% + dplyr::slice(1) %>% + dplyr::pull(.data$title) + 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 +#' breaking changes +#' +#' @param package Camera trap data package object. +#' @param from Character identifying the version of `package`. +#' @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") { + + # check deployments slot is present + assertthat::assert_that( + "deployments" %in% names(package$data), + msg = "Can't find `deployments` element in `package$data`." + ) + + deployments <- package$data$deployments + + # rename required fields where needed + deployments <- deployments %>% + dplyr::relocate("latitude", .after = "longitude") + deployments <- deployments %>% + dplyr::rename(start = "deploymentStart", + end = "deploymentEnd") + if ("cameraDelay" %in% names(deployments)) { + deployments <- deployments %>% + dplyr::rename(cameraInterval = "cameraDelay") + } + # ignore detectionDistance + deployments$detectionDistance <- NULL + if ("baitUse" %in% names(deployments)) { + # baitUse values in version 0.1.6 + bait_uses_old <- c("none", "scent", "food", "visual", "acoustic", "other") + # transform Boolean to character and set FALSE to "none", TRUE to "other". + # Do not change NAs + deployments <- deployments %>% + dplyr::mutate(baitUse = as.character(.data$baitUse)) %>% + dplyr::mutate(baitUse = dplyr::case_when( + .data$baitUse == "FALSE" ~ "none", + is.na(.data$baitUse) ~ NA_character_, + .default = "other") + ) + # retrieve specific bait use info from tags if present + if ("deploymentTags" %in% names(deployments)) { + deployments <- deployments %>% + dplyr::mutate(bait_use = stringr::str_extract( + string = .data$deploymentTags, + pattern = "(?<=bait:).[a-zA-Z]+")) %>% + #remove whitespaces at the begin and end of the string (there shouldn't be) + dplyr::mutate(bait_use = stringr::str_trim(.data$bait_use)) %>% + # set baitUse based on found tags + dplyr::mutate(baitUse = dplyr::if_else( + .data$bait_use %in% bait_uses_old, + .data$bait_use, + .data$baitUse)) %>% + dplyr::select(-"bait_use") + } + # set baitUse to factor + deployments <- deployments %>% + 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}.") + ) + } else { + deployments <- deployments %>% + dplyr::mutate(session = NA) + } + if ("deploymentGroups" %in% names(deployments)) { + # 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 = " | "))) %>% + dplyr::select(-"deploymentGroups") + } + if ("array" %in% names(deployments)) { + 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}.") + ) + } else { + deployments <- deployments %>% + dplyr::mutate("_id" = NA) + } + if ("deploymentTags" %in% names(deployments)) { + deployments <- deployments %>% + dplyr::rename(tags = "deploymentTags") + } + if ("deploymentComments" %in% names(deployments)) { + deployments <- deployments %>% + dplyr::rename(comments = "deploymentComments") + } + + package$data$deployments <- deployments + return(package) +} + +#' 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 +#' breaking changes. Notice that this function `MUST` be run before +#' `convert_observations_to_0.1.6()`. +#' +#' @param package Camera trap data package object. +#' @param from Character identifying the version of `package`. +#' @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") { + + # check media slot is present + assertthat::assert_that( + "media" %in% names(package$data), + msg = "Can't find `deployments` element in `package$data`." + ) + + if (is.null(package$data$media)) { + return(package) + } + + # check observations slot is present + assertthat::assert_that( + "observations" %in% names(package$data), + msg = "Can't find `observations` element in `package$data`." + ) + + media <- package$data$media + observations <- package$data$observations + + # create sequenceID for media linked to event-based observations as + # sequenceID is used by `get_record_table()` + 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 + dplyr::filter(!is.na(.data$eventID)) + + # Join on deploymentID and timestamp between eventStart and eventEnd + by <- dplyr::join_by(deploymentID, + between(x$timestamp, y$eventStart, y$eventEnd)) + # Join media with event-based observations (obs without mediaID) + media <- media %>% + dplyr::full_join(event_obs, by) %>% + dplyr::rename(sequenceID = "eventID") %>% + dplyr::select(-c("eventStart", "eventEnd")) %>% + dplyr::relocate("sequenceID", .after = "deploymentID") + + if ("filePublic" %in% names(media)) { + media$filePublic <- NULL + } + if ("favorite" %in% names(media)) { + media <- media %>% + dplyr::rename(favourite = "favorite") + } + if ("mediaComments" %in% names(media)) { + media <- media %>% + dplyr::rename(comments = "mediaComments") + } + if ("_id" %in% names(media)) { + warning(glue::glue("The field `_id` of media is deprecated in", + "version {from}.") + ) + } else { + media <- media %>% + dplyr::mutate("_id" = NA) + } + + 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 +#' breaking changes +#' +#' @param package Camera trap data package object. +#' @param from Character identifying the version of `package`. +#' @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") { + + # check observations slot is present + assertthat::assert_that( + "observations" %in% names(package$data), + msg = "Can't find `observations` element in `package$data`." + ) + + observations <- package$data$observations + # only event-type obs are supported + observations <- observations %>% + dplyr::filter(.data$observationLevel == "event") + + if ("eventID" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(sequenceID = "eventID") + } else { + observations <- observations %>% + dplyr::mutate(sequenceID = NA) + } + observations <- dplyr::relocate(observations, + "sequenceID", + .after = "deploymentID" + ) + observations <- observations %>% + dplyr::rename(timestamp = "eventStart") + + observations$eventEnd <- NULL + observations$observationLevel <- NULL + + if ("cameraSetupType" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(cameraSetup = "cameraSetupType") + } else { + observations <- observations %>% + dplyr::mutate("cameraSetup" = NA) + } + if ("countNew" %in% names(observations)) { + warning(glue::glue( + "The field `countNew` of observations is deprecated in", + "version {from}." + ) + ) + } else { + observations <- observations %>% + dplyr::mutate("countNew" = NA) + } + observations <- dplyr::relocate(observations, + "countNew", + .after = dplyr::any_of("count") + ) + if ("behavior" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(behaviour = "behavior") + } + if ("classificationProbability" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(classificationConfidence = "classificationProbability") + } + if ("observationTags" %in% names(observations)) { + observations$observationTags <- NULL + } + if ("observationComments" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(comments = "observationComments") + } + if ("_id" %in% names(observations)) { + warning(glue::glue("The field `_id` of observations is deprecated in", + "version {from}.") + ) + } else { + observations <- observations %>% + dplyr::mutate("_id" = NA) + } + if ("individualSpeed" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(speed = "individualSpeed") + } + if ("individualPositionRadius" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(radius = "individualPositionRadius") + } + if ("individualPositionAngle" %in% names(observations)) { + observations <- observations %>% + dplyr::rename(angle = "individualPositionAngle") + } + # remove bounding box related cols if present + observations <- observations %>% dplyr::select(-dplyr::starts_with("bbox")) + + package$data$observations <- observations + return(package) +} + +#' Order the columns of deployments +#' +#' @param df A data.frame with `deployments` +#' @return Same data.frame as `df` with the right order of columns +#' @noRd +order_cols_deployments <- function(df) { + # Set right order of columns + df %>% + dplyr::relocate( + dplyr::any_of(c("deploymentID", + "locationID", + "locationName", + "longitude", + "latitude", + "coordinateUncertainty", + "start", + "end", + "setupBy", + "cameraID", + "cameraModel", + "cameraInterval", + "cameraHeight", + "cameraTilt", + "cameraHeading", + "timestampIssues", + "baitUse", + "session", + "array", + "featureType", + "habitat", + "tags", + "comments", + "_id") + ) + ) +} + +#' Order the columns of media +#' +#' @param df A data.frame with `media` +#' @return Same data.frame as `df` with the right order of columns +#' @noRd +order_cols_media <- function(df) { + # Set right order of columns + df %>% + dplyr::relocate( + dplyr::any_of(c("mediaID", + "deploymentID", + "sequenceID", + "captureMethod", + "timestamp", + "filePath", + "fileName", + "fileMediatype", + "exifData", + "favourite", + "comments", + "_id") + ) + ) +} + +#' Order the columns of observations +#' +#' @param df A data.frame with `observations` +#' @return Same data.frame as `df` with the right order of columns +#' @noRd +order_cols_observations <- function(df) { + # Set right order of columns + df %>% + dplyr::relocate( + dplyr::any_of(c("observationID", + "deploymentID", + "sequenceID", + "mediaID", + "timestamp", + "observationType", + "cameraSetup", + "taxonID", + "taxonIDReference", + "scientificName", + "taxonRank", + dplyr::starts_with("vernacularNames"), + "count", + "countNew", + "lifeStage", + "sex", + "behaviour", + "individualID", + "speed", + "radius", + "angle", + "classificationMethod", + "classifiedBy", + "classificationTimestamp", + "classificationConfidence", + "comments", + "_id") + ) + ) +} diff --git a/README.Rmd b/README.Rmd index a8f32613..aa08e1b2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,6 +25,14 @@ knitr::opts_chunk$set( 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. +## 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. + +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. + +## Get Started + To get started, see: - [Vignettes](https://inbo.github.io/camtraptor/articles/): tutorials showcasing functionality. diff --git a/README.md b/README.md index 5ebfdf8b..1d346c16 100644 --- a/README.md +++ b/README.md @@ -22,6 +22,25 @@ 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. + +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. + +## Get Started + To get started, see: - [Vignettes](https://inbo.github.io/camtraptor/articles/): tutorials diff --git a/man/figures/README-unnamed-chunk-3-1.png b/man/figures/README-unnamed-chunk-3-1.png index acc4f886..f644ddfd 100644 Binary files a/man/figures/README-unnamed-chunk-3-1.png and b/man/figures/README-unnamed-chunk-3-1.png differ diff --git a/man/get_custom_effort.Rd b/man/get_custom_effort.Rd index 72808050..47bade10 100644 --- a/man/get_custom_effort.Rd +++ b/man/get_custom_effort.Rd @@ -63,9 +63,9 @@ A tibble data frame with following columns: } \description{ Gets the custom effort (deployment duration) for a custom time window and a -specific time interval such as day or month. -The custom effort is also calculated over all deployments, although -filtering predicates can be applied as well. +specific time interval such as day or month. The custom effort is also +calculated over all deployments, although filtering predicates can be applied +as well. This function calls \code{get_cam_op()} internally. } \examples{ # A global effort over the entire duration of the project (datapackage) diff --git a/man/read_camtrap_dp.Rd b/man/read_camtrap_dp.Rd index 2a813aad..fea77426 100644 --- a/man/read_camtrap_dp.Rd +++ b/man/read_camtrap_dp.Rd @@ -9,8 +9,8 @@ read_camtrap_dp(file = NULL, media = TRUE, path = lifecycle::deprecated()) \arguments{ \item{file}{Path or URL to a \code{datapackage.json} file.} -\item{media}{If \code{TRUE}, read media records into memory. If \code{FALSE}, ignore -media file to speed up reading larger Camtrap DP packages.} +\item{media}{If \code{TRUE} (default), read media records into memory. If \code{FALSE}, +ignore media file to speed up reading larger Camtrap DP packages.} \item{path}{Path to the directory containing the datapackage. Use \code{file} with path or URL to a \code{datapackage.json} file instead.} @@ -35,7 +35,10 @@ Vernacular names found in the metadata (\code{package$taxonomic}) are added to t \examples{ \dontrun{ # Read Camtrap DP package -camtrap_dp_file <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor") +camtrap_dp_file <- system.file( + "extdata", "mica", "datapackage.json", + package = "camtraptor" +) muskrat_coypu <- read_camtrap_dp(camtrap_dp_file) # Read Camtrap DP package and ignore media file diff --git a/tests/testthat/test-get_cam_op.R b/tests/testthat/test-get_cam_op.R index 3bd2c88a..b1f4458e 100644 --- a/tests/testthat/test-get_cam_op.R +++ b/tests/testthat/test-get_cam_op.R @@ -3,8 +3,29 @@ test_that("input camtrap dp is checked properly", { expect_error(get_cam_op("aaa")) # numeric instead of datapackage expect_error(get_cam_op(1)) + # 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).", + 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).", + fixed = TRUE) # station_col value is not a column of deployments - expect_error(get_cam_op(mica, station_col = "bla")) + 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."), + fixed = TRUE + ) + # column specified by station_col contains empty values + mica_empty_location_name <- mica + mica_empty_location_name$data$deployments$locationName[2:3] <- NA + expect_error(get_cam_op(mica_empty_location_name), + "Column `locationName` must be non-empty: 2 NAs found." + ) # use_prefix must be TRUE or FALSE expect_error(get_cam_op(mica, use_prefix = "bla")) expect_error(get_cam_op(mica, use_prefix = NA)) diff --git a/tests/testthat/test-read_camtrap_dp.R b/tests/testthat/test-read_camtrap_dp.R index e4b4e692..60046226 100644 --- a/tests/testthat/test-read_camtrap_dp.R +++ b/tests/testthat/test-read_camtrap_dp.R @@ -1,35 +1,84 @@ -test_that("file is checked properly", { +test_that("file argument is checked properly", { expect_error(read_camtrap_dp("aaa")) expect_error(read_camtrap_dp(1)) }) -test_that("test warnings", { +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" + dp <- suppressMessages(read_camtrap_dp( + file = dp_path, + media = FALSE + )) + expect_true(is.list(dp)) + expect_true(all(c("tbl_df", "tbl", "data.frame") %in% + class(dp$data$deployments))) + expect_true(all(c("tbl_df", "tbl", "data.frame") %in% + class(dp$data$observations))) +}) + +test_that("only DP versions 1.0-rc.1 and dp 0.1.6 are supported", { + expect_error( + 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." + ) + + expect_error( + 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." + ) +}) + +## 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("extdata", "mica_parsing_issues", "datapackage_for_parsing_issues.json", package = "camtraptor") - # deployments - expect_warning( - camtraptor::read_camtrap_dp( - file = camtrap_dp_file_with_issues - ), - "One or more parsing issues occurred while reading deployments." + camtrap_dp_file_with_issues <- system.file( + "extdata", "mica_parsing_issues", + "datapackage_for_parsing_issues.json", + package = "camtraptor" + ) + w <- capture_warnings( + camtraptor::read_camtrap_dp(file = camtrap_dp_file_with_issues) + ) + # warning on deployments + expect_equal( + w[2], # w[1] is returned by readr via frictionless + paste0( + "One or more parsing issues occurred while reading `deployments`. ", + "Check `?read_camtrap_dp()` for examples on how to use ", + "`readr::problems()`." + ) ) - # observations - expect_warning( - camtraptor::read_camtrap_dp( - file = camtrap_dp_file_with_issues - ), - "One or more parsing issues occurred while reading observations." + # warning on observations + expect_equal( + w[4], # w[3] is returned by readr via frictionless + paste0( + "One or more parsing issues occurred while reading `observations`. ", + "Check `?read_camtrap_dp()` for examples on how to use ", + "`readr::problems()`." + ) ) - # media - expect_warning( - camtraptor::read_camtrap_dp( - file = camtrap_dp_file_with_issues - ), - "One or more parsing issues occurred while reading media." + # warning on media + expect_equal( + w[6], # w[5] is returned by readr via frictionless + paste0( + "One or more parsing issues occurred while reading `media`. ", + "Check `?read_camtrap_dp()` for examples on how to use ", + "`readr::problems()`." + ) ) }) - test_that("media is checked properly", { dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" @@ -50,6 +99,10 @@ test_that("output is a list", { )) 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") }) test_that("output data slot is a list of length 3", { @@ -62,6 +115,10 @@ test_that("output data slot is a list of length 3", { )) 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) }) test_that("media arg influences only slot media", { @@ -76,40 +133,45 @@ test_that("media arg influences only slot media", { file = dp_path, media = FALSE )) - # media is NULL only for dp_without_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)) # 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) # observations are the same expect_identical( - # remove columns with NA only - dp_with_media$data$observations[colSums( - !is.na(dp_with_media$data$observations) - ) > 0], - # remove columns with NA only - dp_without_media$data$observations[colSums( - !is.na(dp_without_media$data$observations) - ) > 0] + 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 ) # deployments are the same expect_identical( - # remove columns with NA only - dp_with_media$data$deployments[colSums( - !is.na(dp_with_media$data$deployments) - ) > 0], - # remove columns with NA only - dp_with_media$data$deployments[colSums( - !is.na(dp_with_media$data$deployments) - ) > 0] + dp_with_media$data$deployments, + dp_without_media$data$deployments + ) + expect_identical( + dp_v1_rc1_with_media$data$deployments, + dp_v1_rc1_without_media$data$deployments ) }) -test_that("Datapackage resources are named as in resource_names", { +test_that("datapackage data elements are named as in resource names", { + # check for v0.1.6 dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -117,11 +179,16 @@ test_that("Datapackage resources are named as in resource_names", { file = dp_path, media = FALSE )) - resource_names <- dp_without_media$resource_names - expect_true(all(resource_names %in% names(dp_without_media$data))) + 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))) }) -test_that("Datapackage resources are tibble dataframes", { +test_that("datapackage resources are tibble dataframes", { dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -129,13 +196,22 @@ test_that("Datapackage resources are tibble dataframes", { file = dp_path, media = FALSE )) + # check for v0.1.6 (only one of the two: chosen for the one without media) expect_true(all(c("tbl_df", "tbl", "data.frame") %in% 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) + expect_true(all(c("tbl_df", "tbl", "data.frame") %in% + class(dp_v1_rc1_with_media$data$deployments))) + expect_true(all(c("tbl_df", "tbl", "data.frame") %in% + class(dp_v1_rc1_with_media$data$observations))) + expect_true(all(c("tbl_df", "tbl", "data.frame") %in% + class(dp_v1_rc1_with_media$data$media))) }) -test_that("sc. names and vernacular names in obs match the info in taxonomic slot", { +test_that( + "v0.1.6: sc. names and vernacular names in obs match info in metadata", { dp_path <- system.file("extdata", "mica", "datapackage.json", package = "camtraptor" ) @@ -171,21 +247,39 @@ test_that("sc. names and vernacular names in obs match the info in taxonomic slo expect_true(all(nl_names %in% taxon_infos$vernacularNames.nl)) }) -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/bb046c85a55bef2ced709357c0047f0136df8326/example/datapackage.json" - dp <- suppressMessages(read_camtrap_dp( - file = dp_path, - media = FALSE - )) - expect_true(is.list(dp)) - expect_true(all(c("tbl_df", "tbl", "data.frame") %in% - class(dp$data$deployments))) - expect_true(all(c("tbl_df", "tbl", "data.frame") %in% - class(dp$data$observations))) -}) +test_that( + "v1.0-rc.1: sc. names and vernacular names in obs match info in metadata", { + taxon_infos <- purrr::map_dfr( + dp_v1_rc1_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)) + ) + # 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 + )] + 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) + ] + 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[ + !is.na( + dp_v1_rc1_with_media$data$observations$vernacularNames.nld + ) + ] + expect_true(all(nl_names %in% taxon_infos$vernacularNames.nld)) + }) test_that("path is deprecated", { dp_path_warning <- system.file("extdata", "mica", package = "camtraptor") @@ -204,3 +298,281 @@ 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 +}) + +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-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-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)) +}) + +test_that( + "read deployments v1.0-rc1: detectionDistance is a new term and is ignored", { + expect_false( + "detectionDistance" %in% names(dp_v1_rc1_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") + baitUse_levels <- c("none", "scent", "food", "visual", "acoustic", "other") + expect_equal( + levels(dp_v1_rc1_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-rc1: array is left empty", { + expect_true(all(is.na(dp_v1_rc1_with_media$data$deployments$array))) +}) + +test_that("read deployments v1.0-rc1: deploymentTags is renamed as tags", { + expect_false( + "deploymentTags" %in% names(dp_v1_rc1_with_media$data$deployments) + ) + expect_true("tags" %in% names(dp_v1_rc1_with_media$data$deployments)) +}) + +test_that( + "read deployments v1.0-rc1: deploymentComments is renamed as comments", { + expect_false( + "deploymentComments" %in% names(dp_v1_rc1_with_media$data$deployments) + ) + expect_true("comments" %in% names(dp_v1_rc1_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( + "all cols `v0.1.6:deployments` are present in `v1.0-rc1:deployments`", { + dp_path <- system.file("extdata", "mica", "datapackage.json", + package = "camtraptor" + ) + dp_without_media <- suppressMessages(read_camtrap_dp( + file = dp_path, + media = FALSE + )) + cols_deployments_dp_v1_rc1 <- dp_v1_rc1_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) + } +) + +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-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-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-rc1: eventEnd is a new term and is ignored", { + expect_false("eventEnd" %in% names(dp_v1_rc1_with_media$data$observations)) +}) + +test_that( + "read observations v1.0-rc1: observationLevel is a new term and is ignored", { + expect_false( + "observationLevel" %in% names(dp_v1_rc1_with_media$data$observations) + ) +}) + +test_that( + "read observations v1.0-rc1: cameraSetupType is renamed as cameraSetup", { + expect_false( + "cameraSetupType" %in% names(dp_v1_rc1_with_media$data$observations) + ) + expect_true("cameraSetup" %in% names(dp_v1_rc1_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-rc1: higher taxonomic ranks ignored", { + expect_false( + any(c("kingdom", "phylum", "class", "order", "family", "genus") %in% + names(dp_v1_rc1_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)) +}) + +test_that( + "read observations v1.0-rc1: classificationProbability renamed as classificationConfidence", + { + expect_false( + "classificationProbability" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_true( + "classificationConfidence" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + } +) + +test_that( + "read observations v1.0-rc1: observationComments is renamed as comments", { + expect_false( + "observationComments" %in% names(dp_v1_rc1_with_media$data$observations) + ) + expect_true("comments" %in% names(dp_v1_rc1_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-rc1: individualSpeed is renamed as speed", { + expect_false( + "individualSpeed" %in% names(dp_v1_rc1_with_media$data$observations) + ) + expect_true("speed" %in% names(dp_v1_rc1_with_media$data$observations)) +}) + +test_that( + "read observations v1.0-rc1: individualPositionRadius is renamed as radius", { + expect_false( + "individualPositionRadius" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_true("radius" %in% names(dp_v1_rc1_with_media$data$observations)) + } +) + +test_that( + "read observations v1.0-rc1: individualPositionAngle is renamed as angle", { + expect_false( + "individualPositionAngle" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_true("angle" %in% names(dp_v1_rc1_with_media$data$observations)) + } +) + +test_that( + "read observations v1.0-rc1: bounding box related columns are not present", { + expect_false( + "bboxX" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_false( + "bboxY" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_false( + "bboxWidth" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + expect_false( + " bboxHeight" %in% + names(dp_v1_rc1_with_media$data$observations) + ) + } +) + +test_that( + "all cols `v0.1.6:observations` are present in `v1.0-rc1:observations`", { + # 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. + dp_path <- system.file("extdata", "mica", "datapackage.json", + package = "camtraptor" + ) + dp_without_media <- suppressMessages(read_camtrap_dp( + file = dp_path, + media = FALSE + )) + cols_obs_dp_v1_rc1 <- dp_v1_rc1_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) + ) + } +) + +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-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)) +}) + +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-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-rc1: _id is left empty", { + expect_true(all(is.na(dp_v1_rc1_with_media$data$media$`_id`))) +}) + +test_that( + "all cols `v0.1.6:media` are present in `v1.0-rc1:media`", { + dp_path <- system.file("extdata", "mica", "datapackage.json", + package = "camtraptor" + ) + dp_with_media <- suppressMessages(read_camtrap_dp( + file = dp_path, + media = TRUE + )) + cols_media_dp_v1_rc1 <- dp_v1_rc1_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) + } +)