Merge pull request #35 from inbo/add-locations-function

Add locations function

NAMESPACE

@@ -2,8 +2,10 @@
 
 export(deployments)
 export(example_dataset)
+export(locations)
 export(media)
 export(observations)
 export(read_camtrapdp)
 export(version)
 importFrom(dplyr,"%>%")
+importFrom(dplyr,.data)

NEWS.md

@@ -3,6 +3,7 @@
 * New function `read_camtrapdp()` reads data files into memory (#9).
 * New function `version()` allows to get the version of a camtrapdp object.
 * New functions `deployments()`, `media()` and `observations()` return a data frame with respectively deployments, media and observations (#29).
+* New function `locations()` returns a data frame with unique locations derived from deployments (#22). 
 * New internal function `example_package()` returns the latest Camtrap DP example dataset (#24).
 * New internal function `check_camtrapdp()` validates a camtrapdp object (#34).
 * New internal function `convert()` converts camtrapdp objects to the latest version. This function is currently not used, as the only supported version is Camtrap DP 1.0 (#9).

R/camtrapdp-package.R

@@ -3,5 +3,6 @@
 
 ## usethis namespace: start
 #' @importFrom dplyr %>%
+#' @importFrom dplyr .data
 ## usethis namespace: end
 NULL

R/deployments.R

@@ -3,10 +3,13 @@
 #' Gets the deployments from a Camera Trap Data Package object.
 #'
 #' @inheritParams version
-#' @return Deployments tibble.
+#' @return [tibble()] data frame with deployments.
 #' @family accessor functions
 #' @export
+#' @examples
+#' x <- example_dataset()
+#' deployments(x)
 deployments <- function(x) {
   check_camtrapdp(x)
-  x$data$deployments
+  purrr::pluck(x, "data", "deployments")
 }

R/locations.R

@@ -0,0 +1,28 @@
+#' Get locations
+#'
+#' Gets the unique locations from the deployments of a Camera Trap Data Package
+#' object.
+#'
+#' @inheritParams version
+#' @return [tibble()] data frame with the following columns:
+#' - `locationID`
+#' - `locationName`
+#' - `latitude`
+#' - `longitude`
+#' - `coordinateUncertainty`
+#' @family accessor functions
+#' @export
+#' @examples
+#' x <- example_dataset()
+#' locations(x)
+locations <- function(x) {
+  check_camtrapdp(x)
+  deployments(x) %>%
+    dplyr::distinct(
+      .data$locationID,
+      .data$locationName,
+      .data$latitude,
+      .data$longitude,
+      .data$coordinateUncertainty
+    )
+}

R/media.R

@@ -3,10 +3,13 @@
 #' Gets the media from a Camera Trap Data Package object.
 #'
 #' @inheritParams version
-#' @return Media tibble.
+#' @return [tibble()] data frame with media.
 #' @family accessor functions
 #' @export
+#' @examples
+#' x <- example_dataset()
+#' media(x)
 media <- function(x) {
   check_camtrapdp(x)
-  x$data$media
+  purrr::pluck(x, "data", "media")
 }

R/observations.R

@@ -3,10 +3,13 @@
 #' Gets the observations from a Camera Trap Data Package object.
 #'
 #' @inheritParams version
-#' @return Observations tibble.
+#' @return [tibble()] data frame with observations.
 #' @family accessor functions
 #' @export
+#' @examples
+#' x <- example_dataset()
+#' observations(x)
 observations <- function(x) {
   check_camtrapdp(x)
-  x$data$observations
+  purrr::pluck(x, "data", "observations")
 }

tests/testthat/test-locations.R

@@ -0,0 +1,25 @@
+test_that("locations() returns a tibble", {
+  skip_if_offline()
+  x <- example_dataset()
+  expect_s3_class(locations(x), "tbl")
+})
+
+test_that("locations() returns expected columns", {
+  skip_if_offline()
+  x <- example_dataset()
+  expected_cols <- c(
+    "locationID",
+    "locationName",
+    "latitude",
+    "longitude",
+    "coordinateUncertainty"
+  )
+  expect_named(locations(x), expected_cols)
+})
+
+test_that("locations() returns unique location information", {
+  skip_if_offline()
+  x <- example_dataset()
+  expect_equal(nrow(locations(x)), 4)
+  # TODO: reduce cardinality of location information in deployments and expect fewer rows
+})