Merge pull request #294 from inbo/add-pos-angle-to-event-obs

Add radius and angle to event-based observations

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: camtraptor
 Title: Read, Explore and Visualize Camera Trap Data Packages
-Version: 0.23.0
+Version: 0.24.0
 Authors@R: c(
     person("Damiano", "Oldoni", email = "[email protected]",
            role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3445-7562")),

R/zzz.R

@@ -743,10 +743,55 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0") {
   )
 
   observations <- package$data$observations
-  # only event-type obs are supported
-  observations <- observations %>%
+
+  # Get media-based observations
+  media_observations <- observations %>%
+    dplyr::filter(.data$observationLevel == "media")
+
+  # Extract first not NA individualPositionRadius and individualPositionAngle
+  # for each `eventID`
+  obs_first_radius_angle <- 
+    media_observations %>%
+    dplyr::filter(!is.na(.data$individualPositionRadius),
+                  !is.na(.data$individualPositionAngle)) %>%
+    dplyr::group_by(.data$eventID, .data$individualID) %>%
+    # Take the very first row with the lowest eventStart.
+    # Notice that multiple media could have the same value of eventStart
+    # Use with_ties = FALSE to be sure to take the very first element.
+    dplyr::slice_min(.data$eventStart, n = 1, with_ties = FALSE) %>%
+    dplyr::ungroup() %>%
+    dplyr::select(c("eventID",
+                    "individualID",
+                    "individualPositionRadius", 
+                    "individualPositionAngle")) %>%
+    dplyr::rename_with(~ paste0("media_", .x),
+                       dplyr::starts_with("individualPosition")
+    )
+
+  # Get event-based observations
+  event_observations <- observations %>%
     dplyr::filter(.data$observationLevel == "event")
 
+  # Add angle/radius to event based observations if missing
+  event_observations <- event_observations %>%
+    dplyr::left_join(obs_first_radius_angle,
+                     by = c("eventID", "individualID")) %>%
+    dplyr::mutate(
+      individualPositionAngle = dplyr::if_else(
+        condition = is.na(.data$individualPositionAngle),
+        true = .data$media_individualPositionAngle,
+        false = .data$individualPositionAngle),
+      individualPositionRadius = dplyr::if_else(
+        condition = is.na(.data$individualPositionRadius),
+        true = .data$media_individualPositionRadius,
+        false = .data$individualPositionRadius)) %>%
+    dplyr::select(-c("media_individualPositionAngle",
+                     "media_individualPositionRadius")
+    )
+
+  # only event-type obs are supported
+  observations <- event_observations
+
   if ("eventID" %in% names(observations)) {
     observations <- observations %>%
       dplyr::rename(sequenceID = "eventID")

tests/testthat/test-read_camtrap_dp.R

@@ -532,6 +532,12 @@ test_that(
   }
 )
 
+test_that(
+  "read observations v1.0: radius is NA as NA in media based obs too", {
+    expect_true(all(is.na(dp_v1_with_media$data$observations$radius)))
+  }
+)
+
 test_that(
   "read observations v1.0: individualPositionAngle is renamed as angle", {
     expect_false(
@@ -542,6 +548,12 @@ test_that(
   }
 )
 
+test_that(
+  "read observations v1.0: angle is NA as NA in media based obs too", {
+    expect_true(all(is.na(dp_v1_with_media$data$observations$angle)))
+  }
+)
+
 test_that(
   "read observations v1.0: bounding box related columns are not present", {
     expect_false(