284 add support for camtrap dp v1.0

R/read_camtrap_dp.R

@@ -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"
@@ -152,7 +152,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)
   }
 

R/zzz.R

@@ -371,7 +371,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 +384,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 +396,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,13 +436,13 @@ 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(
@@ -461,14 +460,13 @@ 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(paste0(
+    collapse = "\n",
+    c(
+      "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."
     )
-  )
+  ))
   # convert metadata
   package <- convert_metadata_to_0.1.6(package, from)  
   # convert deployments
@@ -485,15 +483,15 @@ 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.
 #' @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"){
+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")
@@ -537,20 +535,29 @@ 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.
 #' @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") {
+convert_deployments_to_0.1.6 <- function(package, from = "1.0") {
 
   # check deployments slot is present
   assertthat::assert_that(
@@ -572,6 +579,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")
@@ -615,12 +624,16 @@ 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)) {
@@ -654,7 +667,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 +676,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 +702,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
@@ -722,21 +735,31 @@ convert_media_to_0.1.6 <- function(package, from = "1.0-rc.1") {
       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.
 #' @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") {
+convert_observations_to_0.1.6 <- function(package, from = "1.0") {
 
   # check observations slot is present
   assertthat::assert_that(
@@ -824,6 +847,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_integer_)
+  }
+  # add taxonIDReference if missing
+  if(!"taxonIDReference" %in% colnames(observations)){
+    observations <- observations %>% 
+      dplyr::mutate(taxonIDReference = NA_character_)
+  }
 
   package$data$observations <- observations
   return(package)