From 8e7133398cf79ff8a40bac5c607e21268c074503 Mon Sep 17 00:00:00 2001 From: Damiano Oldoni Date: Thu, 21 Dec 2023 15:51:27 +0100 Subject: [PATCH 1/4] Add pos/angle to event based obs Fix #291 --- R/zzz.R | 47 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 88f09f73..70f3ad1b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -743,10 +743,53 @@ 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) %>% + # 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", + "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 = "eventID") %>% + 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") From cb686020587b8b698912cc0f4f0a1afe6b6a4198 Mon Sep 17 00:00:00 2001 From: Damiano Oldoni Date: Thu, 21 Dec 2023 21:51:37 +0100 Subject: [PATCH 2/4] Add grouping (and join) by individualID See https://github.com/inbo/camtraptor/issues/291#issuecomment-1866912036 --- R/zzz.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 70f3ad1b..737a9232 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -754,13 +754,14 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0") { media_observations %>% dplyr::filter(!is.na(.data$individualPositionRadius), !is.na(.data$individualPositionAngle)) %>% - dplyr::group_by(.data$eventID) %>% + 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", + dplyr::select(c("eventID", + "individualID", "individualPositionRadius", "individualPositionAngle")) %>% dplyr::rename_with(~ paste0("media_", .x), @@ -773,7 +774,8 @@ convert_observations_to_0.1.6 <- function(package, from = "1.0") { # Add angle/radius to event based observations if missing event_observations <- event_observations %>% - dplyr::left_join(obs_first_radius_angle, by = "eventID") %>% + dplyr::left_join(obs_first_radius_angle, + by = c("eventID", "individualID")) %>% dplyr::mutate( individualPositionAngle = dplyr::if_else( condition = is.na(.data$individualPositionAngle), From bd6a364642209c78bf01d20b3960230b2ff31de4 Mon Sep 17 00:00:00 2001 From: Damiano Oldoni Date: Thu, 21 Dec 2023 21:52:07 +0100 Subject: [PATCH 3/4] Bump version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 00965ac3..5ee87b2b 100644 --- a/DESCRIPTION +++ b/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 = "damiano.oldoni@inbo.be", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3445-7562")), From 2f3729eed3a323dc43cc8157b41b5b08026173fc Mon Sep 17 00:00:00 2001 From: Damiano Oldoni Date: Fri, 22 Dec 2023 06:38:02 +0100 Subject: [PATCH 4/4] Add small tests about radius/angle radius and angle must be always NA if they are not filled in at media level obsrevations too. --- tests/testthat/test-read_camtrap_dp.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-read_camtrap_dp.R b/tests/testthat/test-read_camtrap_dp.R index 7b6d9da9..e1f2254e 100644 --- a/tests/testthat/test-read_camtrap_dp.R +++ b/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(