Merge pull request #149 from inbo/create_individuals()

Create `individuals()`

NAMESPACE

@@ -12,6 +12,7 @@ export(example_dataset)
 export(filter_deployments)
 export(filter_media)
 export(filter_observations)
+export(individuals)
 export(locations)
 export(media)
 export(merge_camtrapdp)

NEWS.md

@@ -5,6 +5,7 @@
 * New function `write_eml()` transforms Camtrap DP metadata to EML (#99).
 * New function `round_coordinates()` allows to fuzzy/generalize location information by rounding deployment `latitude` and `longitude`. It also updates `coordinateUncertainty` in the deployments and `coordinatePrecision` and spatial scope in the metadata (#106).
 * New function `shift_time()` allows to shift/correct date-times in data and metadata for specified deploymentIDs and duration (#108).
+* New function `individuals()` returns a data frame with unique individuals (#149).
 * `filter_deployments()` and `deployments()<-` now update the spatial, temporal and taxonomic scope in the metadata based on the returned data (#100, #132).
 * `filter_observations()`, `filter_media()`, `media()<-` and `observations()<-` now update the taxonomic scope in the metadata based on the returned data (#89, #100, #130).
 * `read_camtrapdp()` now updates the spatial and temporal scope in metadata based on the data (#130).

R/individuals.R

@@ -0,0 +1,28 @@
+#' Get individuals
+#'
+#' Gets the (unique) individuals from the observations of a Camera Trap Data
+#' Package object.
+#'
+#' @inheritParams print.camtrapdp
+#' @return A [tibble::tibble()] data frame with the individuals that have an
+#' `individualID`, containing the following columns:
+#'   - `individualID`
+#'   - `scientificName`
+#'   - `lifeStage`
+#'   - `sex`
+#' @family accessor functions
+#' @export
+#' @examples
+#' x <- example_dataset()
+#' individuals(x)
+individuals <- function(x) {
+  check_camtrapdp(x)
+  observations(x) %>%
+    dplyr::filter(!is.na(individualID)) %>%
+    dplyr::distinct(
+      .data$individualID,
+      .data$scientificName,
+      .data$lifeStage,
+      .data$sex
+    )
+}

tests/testthat/test-individuals.R

@@ -0,0 +1,32 @@
+test_that("individuals() returns a tibble", {
+  skip_if_offline()
+  x <- example_dataset()
+  expect_s3_class(individuals(x), "tbl")
+})
+
+test_that("individuals() returns the expected columns", {
+  skip_if_offline()
+  x <- example_dataset()
+  expected_cols <- c(
+    "individualID",
+    "scientificName",
+    "lifeStage",
+    "sex"
+  )
+  expect_named(individuals(x), expected_cols)
+})
+
+test_that("individuals() returns the expected rows (unique individuals)", {
+  skip_if_offline()
+  x <- example_dataset()
+
+  # Expect 0 individuals
+  expect_equal(nrow(individuals(x)), 0)
+
+  # Add 3 individuals to event 79204343
+  # TODO: remove once https://github.com/tdwg/camtrap-dp/issues/396 is released
+  x$data$observations[x$data$observations$observationID == "05230014",]$individualID <- "Fezzik"
+  x$data$observations[x$data$observations$observationID == "5ead5692",]$individualID <- "Buttercup"
+  x$data$observations[x$data$observations$observationID == "29939500",]$individualID <- "Westley"
+  expect_equal(nrow(individuals(x)), 3)
+})