Merge pull request #344 from inbo/add-clock-sun-record-table

Add clock sun record table

Author: damianooldoni

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,

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`.

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) &

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)
+}

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