diff --git a/DESCRIPTION b/DESCRIPTION index bd58a9ed..2115be5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: camtraptor Title: Read, Explore and Visualize Camera Trap Data Packages -Version: 0.26.0 +Version: 0.27.0 Authors@R: c( person("Damiano", "Oldoni", , "damiano.oldoni@inbo.be", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3445-7562")), @@ -33,6 +33,7 @@ BugReports: https://github.com/inbo/camtraptor/issues Depends: R (>= 3.5.0) Imports: + activity, assertthat, dplyr (>= 1.1.0), EML, @@ -42,6 +43,7 @@ Imports: leaflet, lifecycle, lubridate, + overlap, purrr, RColorBrewer, readr, diff --git a/NEWS.md b/NEWS.md index 882d8aa9..31ffb22a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# camtraptor 0.27.0 + +- `get_record_table()` returns now 4 new columns: `longitude`, `latitude` (deployment coordinates), `clock` (clock time of the observation in radians) and `solar` (sun time of the observation in radians) (#341). + # camtraptor 0.26.0 - `get_custom_effort()` returns now the effort for each deployment separately (#333). The returned data frame has two new columns: `deploymentID` and `locationName`. diff --git a/R/get_record_table.R b/R/get_record_table.R index 0f3f6235..6d263ca5 100644 --- a/R/get_record_table.R +++ b/R/get_record_table.R @@ -57,6 +57,10 @@ #' as defined in column `filePath` of `media`. #' - `Filename`: List, file names of the images linked to the given record, #' as defined in column `fileName` of `media`. +#' - `Latitude`: Numeric, latitude of the station, based on `deploymentID` of the observations. +#' - `Longitude`: Numeric, longitude of the station, based on `deploymentID` of the observations. +#' - `clock`: Numeric, clock time in radians. +#' - `solar`: Numeric, solar time in radians. Calculated using `overlap::sunTime`, which essentially uses the approach described in [Nouvellet et al. (2012)](https://doi.org/10.1111/j.1469-7998.2011.00864.x). #' @family exploration functions #' @importFrom dplyr .data %>% #' @importFrom rlang !! := @@ -172,6 +176,9 @@ get_record_table <- function(package = NULL, msg = "removeDuplicateRecords must be a logical: TRUE or FALSE." ) + # Add coordinates to observations + package <- add_coordinates(package) + # remove observations of unidentified individuals obs <- package$data$observations %>% dplyr::filter(!is.na(.data$scientificName)) @@ -180,6 +187,15 @@ get_record_table <- function(package = NULL, obs <- obs %>% dplyr::filter(!.data$scientificName %in% exclude) + + # Remove observations without timestamp and returns a warning message + # if there are any + if (any(is.na(obs$timestamp))) { + warning("Some observations have no timestamp and will be removed.") + obs <- obs %>% + dplyr::filter(!is.na(.data$timestamp)) + } + # apply filtering on deployments deployments <- apply_filter_predicate( df = package$data$deployments, @@ -276,6 +292,17 @@ get_record_table <- function(package = NULL, )) %>% dplyr::ungroup() + # Add clock time in radians + record_table <- record_table %>% + dplyr::mutate(clock = activity::gettime(.data$timestamp)) + # Add solar time in radians + matrix_coords <- matrix(c(record_table$longitude, record_table$latitude), + ncol = 2) + record_table <- record_table %>% + dplyr::mutate(solar = overlap::sunTime(.data$clock, + .data$timestamp, + matrix_coords)) + record_table <- record_table %>% dplyr::rename(Station := !!stationCol, Species = "scientificName", @@ -296,7 +323,11 @@ get_record_table <- function(package = NULL, "delta.time.hours", "delta.time.days", "Directory", - "FileName" + "FileName", + "latitude", + "longitude", + "clock", + "solar" ) # remove duplicates if needed if (isTRUE(removeDuplicateRecords)) { @@ -308,7 +339,9 @@ get_record_table <- function(package = NULL, .data$Date, .data$Time, .data$Directory, - .data$FileName + .data$FileName, + .data$latitude, + .data$longitude ) %>% dplyr::mutate(row_number = dplyr::row_number()) %>% dplyr::filter(.data$delta.time.secs == max(.data$delta.time.secs) & diff --git a/R/zzz.R b/R/zzz.R index 6d07e078..08691ce9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1009,3 +1009,26 @@ order_cols_observations <- function(df) { ) ) } + +#' Add deployment coordinates to observations +#' +#' This function adds deployment coordinates to observations based on +#' `deploymentID`. +#' +#' @param package Camera trap data package object. +#' @return Camera trap data package object with `observations` updated. +#' @noRd +add_coordinates <- function(package) { + + deployments <- package$data$deployments + observations <- package$data$observations + + # add coordinates to observations + observations <- observations %>% + dplyr::left_join(deployments %>% + dplyr::select("deploymentID", "longitude", "latitude"), + by = "deploymentID") + + package$data$observations <- observations + return(package) +} diff --git a/tests/testthat/test-get_record_table.R b/tests/testthat/test-get_record_table.R index 75a12015..abdf68bb 100644 --- a/tests/testthat/test-get_record_table.R +++ b/tests/testthat/test-get_record_table.R @@ -56,6 +56,14 @@ test_that("input of get_record_table, removeDuplicateRecords, is checked properl removeDuplicateRecords = NA )) }) +test_that("warning is returned if some observations have no timestamp", { + mica_no_timestamp <- mica + mica_no_timestamp$data$observations$timestamp[3:5] <- NA + expect_warning( + get_record_table(mica_no_timestamp), + "Some observations have no timestamp and will be removed." + ) +}) test_that("right columns are returned", { expect_named( @@ -72,7 +80,11 @@ test_that("right columns are returned", { "delta.time.hours", "delta.time.days", "Directory", - "FileName" + "FileName", + "latitude", + "longitude", + "clock", + "solar" ) ) }) @@ -209,6 +221,20 @@ test_that(paste( ) }) +test_that("clock is always in the range [0, 2*pi]", { + clock_values <- get_record_table(mica) %>% + dplyr::pull(clock) + expect_true(all(clock_values >= 0)) + expect_true(all(clock_values <= 2 * pi)) +}) + +test_that("solar is always in the range [0, 2*pi]", { + solar_values <- get_record_table(mica) %>% + dplyr::pull(solar) + expect_true(all(solar_values >= 0)) + expect_true(all(solar_values <= 2 * pi)) +}) + test_that("filtering predicates are allowed and work well", { stations <- unique( suppressMessages(get_record_table(mica, pred_lt("longitude", 4.0)))$Station