Merge pull request #274 from inbo/depth-in-meters

add depth_in_meters field to get_acoustic_detections()
inbo · Nov 21, 2023 · 326d9e8 · 326d9e8
2 parents abfe5b0 + 9553689
commit 326d9e8
Show file tree

Hide file tree

Showing 32 changed files with 563 additions and 228 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,9 +1,11 @@
 Package: etn
 Title: Access Data from the European Tracking Network
-Version: 2.1.0
+Version: 2.2.0
 Authors@R: c(
+    person("Pieter", "Huybrechts", email = "[email protected]",
+           role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6658-6062")),
     person("Peter", "Desmet", email = "[email protected]",
-           role = c("aut", "cre"), comment =  c(ORCID = "0000-0002-8442-8025")),
+           role = "aut", comment =  c(ORCID = "0000-0002-8442-8025")),
     person("Damiano", "Oldoni", email = "[email protected]",
            role = "aut", comment = c(ORCID = "0000-0003-3445-7562")),
     person("Stijn", "Van Hoey", email = "[email protected]",
@@ -37,10 +39,13 @@ Suggests:
     kableExtra,
     knitr,
     rmarkdown,
-    testthat,
-    tidyr
+    testthat (>= 3.0.0),
+    tidyr,
+    frictionless,
+    withr
 LazyData: true
 Encoding: UTF-8
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.2
+RoxygenNote: 7.2.3
+Config/testthat/edition: 3
diff --git a/NEWS.md b/NEWS.md
@@ -0,0 +1,20 @@
+# etn 2.2.0
+
+* Add `NEWS.md` file to communicate changes to the package.
+* Add `depth_in_meters` field to `get_acoustic_detections()` (#261).
+* Fix issue in `download_acoustic_dataset()` where some fields were missing from `datapackage.json`.
+* Stricter unit tests (#268).
+
+# etn 2.1.0
+
+* Add funder and use default README.Rmd (#247).
+* New function `write_dwc()` to transform acoustic telemetry data to Darwin Core that can be harvested by OBIS and GBIF (#257).
+
+# etn 2.0.0
+
+This releases updates the package to make use of the new model and scope of ETN. Have a look at [this milestone](https://github.com/inbo/etn/milestone/2) for all issues that are included.
+
+* `tag_serial_number` is now the primary identifier for tags. Tags can have multiple types, subtypes and sensors. Acoustic information is related to the `acoustic_tag_id`.
+* `acoustic` scope remains completely covered, but is now reflected in function names. This allows us to implement additional scopes (e.g. `cpod`) in the future.
+* Deprecations for old function names.
+* New tutorial on acoustic scope ([acoustic_telemetry.Rmd](https://github.com/inbo/etn/blob/main/vignettes/acoustic_telemetry.Rmd)).
diff --git a/R/download_acoustic_dataset.R b/R/download_acoustic_dataset.R
@@ -60,7 +60,7 @@
 #' #> * (4/6): downloading deployments.csv
 #' #> * (5/6): downloading receivers.csv
 #' #> * (6/6): adding datapackage.json as file metadata
-
+#' #>
 #' #> Summary statistics for dataset `2012_leopoldkanaal`:
 #' #> * number of animals:           104
 #' #> * number of tags:              103
@@ -71,7 +71,7 @@
 #' #> * last date of detection:      2021-09-02
 #' #> * included scientific names:   Anguilla anguilla
 #' #> * included acoustic projects:  albert, Apelafico, bpns, JJ_Belwind, leopold, MOBEIA, pc4c, SPAWNSEIS, ws2, zeeschelde
-
+#' #>
 #' #> Warning message:
 #' #> In download_acoustic_dataset(animal_project_code = "2012_leopoldkanaal") :
 #' #> Found tags associated with multiple animals: 1145373
@@ -116,7 +116,7 @@ download_acoustic_dataset <- function(connection = con,
     animal_project_code = animal_project_code,
     scientific_name = scientific_name
   )
-  readr::write_csv(animals, paste(directory, "animals.csv", sep = "/"), na = "")
+  readr::write_csv(animals, file.path(directory, "animals.csv"), na = "")
 
   # TAGS
   message("* (2/6): downloading tags.csv")
@@ -135,7 +135,7 @@ download_acoustic_dataset <- function(connection = con,
     connection = connection,
     tag_serial_number = tag_serial_numbers
   )
-  readr::write_csv(tags, paste(directory, "tags.csv", sep = "/"), na = "")
+  readr::write_csv(tags, file.path(directory, "tags.csv"), na = "")
 
   # DETECTIONS
   message("* (3/6): downloading detections.csv")
@@ -151,7 +151,7 @@ download_acoustic_dataset <- function(connection = con,
   detections <-
     detections %>%
     distinct(.data$detection_id, .keep_all = TRUE)
-  readr::write_csv(detections, paste(directory, "detections.csv", sep = "/"), na = "")
+  readr::write_csv(detections, file.path(directory, "detections.csv"), na = "")
 
   # DEPLOYMENTS
   message("* (4/6): downloading deployments.csv")
@@ -170,8 +170,14 @@ download_acoustic_dataset <- function(connection = con,
   # Remove linebreaks in deployment comments to get single lines in csv:
   deployments <-
     deployments %>%
-    dplyr::mutate(comments = stringr::str_replace_all(.data$comments, "[\r\n]+", " "))
-  readr::write_csv(deployments, paste(directory, "deployments.csv", sep = "/"), na = "")
+    dplyr::mutate(
+      comments = stringr::str_replace_all(.data$comments, "[\r\n]+", " ")
+    )
+  readr::write_csv(
+    deployments,
+    file.path(directory, "deployments.csv"),
+    na = ""
+  )
 
   # RECEIVERS
   message("* (5/6): downloading receivers.csv")
@@ -184,12 +190,16 @@ download_acoustic_dataset <- function(connection = con,
     connection = connection,
     receiver_id = receiver_ids
   )
-  readr::write_csv(receivers, paste(directory, "receivers.csv", sep = "/"), na = "")
+  readr::write_csv(receivers, file.path(directory, "receivers.csv"), na = "")
 
   # DATAPACKAGE.JSON
   message("* (6/6): adding datapackage.json as file metadata")
   datapackage <- system.file("assets", "datapackage.json", package = "etn")
-  file.copy(datapackage, paste(directory, "datapackage.json", sep = "/"), overwrite = TRUE)
+  file.copy(
+    datapackage,
+    file.path(directory, "datapackage.json"),
+    overwrite = TRUE
+  )
 
   # Create summary stats
   scientific_names <-
@@ -199,21 +209,35 @@ download_acoustic_dataset <- function(connection = con,
     sort()
 
   message("")
-  message(glue::glue("\nSummary statistics for dataset `{animal_project_code}`:"))
+  message(
+    glue::glue("\nSummary statistics for dataset `{animal_project_code}`:")
+  )
   message("* number of animals:           ", nrow(animals))
   message("* number of tags:              ", nrow(tags))
   message("* number of detections:        ", nrow(detections))
   message("* number of deployments:       ", nrow(deployments))
   message("* number of receivers:         ", nrow(receivers))
   if (nrow(detections) > 0) {
-    message("* first date of detection:     ", detections %>% dplyr::summarize(min(as.Date(.data$date_time))) %>% pull())
-    message("* last date of detection:      ", detections %>% dplyr::summarize(max(as.Date(.data$date_time))) %>% pull())
+    message(
+      "* first date of detection:     ",
+      detections %>% dplyr::summarize(min(as.Date(.data$date_time))) %>% pull()
+    )
+    message(
+      "* last date of detection:      ",
+      detections %>% dplyr::summarize(max(as.Date(.data$date_time))) %>% pull()
+    )
   } else {
     message("* first date of detection:     ", NA)
     message("* last date of detection:      ", NA)
   }
-  message("* included scientific names:   ", paste(scientific_names, collapse = ", "))
-  message("* included acoustic projects:  ", paste(acoustic_project_codes, collapse = ", "))
+  message(
+    "* included scientific names:   ",
+    paste(scientific_names, collapse = ", ")
+  )
+  message(
+    "* included acoustic projects:  ",
+    paste(acoustic_project_codes, collapse = ", ")
+  )
   message("")
 
   # Create warnings
@@ -239,15 +263,28 @@ download_acoustic_dataset <- function(connection = con,
   duplicate_detections_count <- detections_orig_count - nrow(detections)
 
   if (length(animals_multiple_tags) > 0) {
-    warning("Found animals with multiple tags: ", paste(animals_multiple_tags, collapse = ", "))
+    warning(
+      "Found animals with multiple tags: ",
+      paste(animals_multiple_tags, collapse = ", ")
+    )
   }
   if (length(tags_multiple_animals) > 0) {
-    warning("Found tags associated with multiple animals: ", paste(tags_multiple_animals, collapse = ", "))
+    warning(
+      "Found tags associated with multiple animals: ",
+      paste(tags_multiple_animals, collapse = ", ")
+    )
   }
   if (length(orphaned_deployments) > 0) {
-    warning("Found deployments without acoustic project: ", paste(orphaned_deployments, collapse = ", "))
+    warning(
+      "Found deployments without acoustic project: ",
+      paste(orphaned_deployments, collapse = ", ")
+    )
   }
   if (duplicate_detections_count > 0) {
-    warning("Found and removed duplicate detections: ", duplicate_detections_count, " detections")
+    warning(
+      "Found and removed duplicate detections: ",
+      duplicate_detections_count,
+      " detections"
+    )
   }
 }
diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R
@@ -224,6 +224,7 @@ get_acoustic_detections <- function(connection = con,
       deployment_station_name AS station_name, -- exclusive to detections_limited
       deployment_latitude AS deploy_latitude, -- exclusive to detections_limited
       deployment_longitude AS deploy_longitude, -- exclusive to detections_limited
+      det.depth_in_meters AS depth_in_meters,
       det.sensor_value AS sensor_value,
       det.sensor_unit AS sensor_unit,
       det.sensor2_value AS sensor2_value,

diff --git a/R/list_values.R b/R/list_values.R
@@ -47,25 +47,35 @@ list_values <- function(.data, column, split = ",") {
 
   arguments <- as.list(match.call())
 
-  if (is.numeric(arguments$column)){
+  if (is.numeric(arguments$column)) {
     col_number <- arguments$column
     n_col_df <- ncol(.data)
-    assertthat::assert_that(as.integer(col_number) == col_number,
-                msg = "column number must be an integer")
-    assertthat::assert_that(col_number <= ncol(.data),
-                msg = glue::glue("column number exceeds the number of columns ",
-                                 "of .data ({n_col_df})"))
+    assertthat::assert_that(
+      as.integer(col_number) == col_number,
+      msg = "column number must be an integer"
+    )
+    assertthat::assert_that(
+      col_number <= ncol(.data),
+      msg = glue::glue(
+        "column number exceeds the number of columns ",
+        "of .data ({n_col_df})"
+      )
+    )
     # extract values
-    values <- .data[,col_number]
+    values <- .data[, col_number]
     # extract column name
     col_name <- names(.data)[col_number]
   } else {
-    #check column name
+    # check column name
     col_name <- as.character(arguments$column)
-    assertthat::assert_that(length(col_name) == 1,
-                msg = "invalid column value")
-    assertthat::assert_that(col_name %in% names(.data),
-                msg = glue::glue("column {col_name} not found in .data"))
+    assertthat::assert_that(
+      length(col_name) == 1,
+      msg = "invalid column value"
+    )
+    assertthat::assert_that(
+      col_name %in% names(.data),
+      msg = glue::glue("column {col_name} not found in .data")
+    )
 
     # extract values
     if (class(arguments$column) == "name") {
@@ -77,9 +87,10 @@ list_values <- function(.data, column, split = ",") {
     }
   }
 
-  if (is.character(values))
+  if (is.character(values)) {
     # extract all values by splitting strings using split value
     values <- unlist(strsplit(x = values, split = split))
+  }
 
   # remove duplicates, unique values only
   values <- unique(values)

diff --git a/inst/CITATION b/inst/CITATION
@@ -0,0 +1,11 @@
+authors <- eval(parse(text = meta$`Authors@R`))
+authors <- authors[which(unlist(lapply(authors, function(x) { "aut" %in% x$role })))]
+
+bibentry(
+  bibtype  = "manual",
+  title    = paste(meta$Package, meta$Title, sep = ": "),
+  author   = authors,
+  year     = format(Sys.Date(), "%Y"),
+  note = sprintf("R package version %s", meta$Version),
+  url = "https://inbo.github.io/etn/"
+)
diff --git a/inst/assets/datapackage.json b/inst/assets/datapackage.json
@@ -346,6 +346,26 @@
             "name": "battery_estimated_end_date",
             "type": "datetime"
           },
+          {
+            "name": "length",
+            "type": "number"
+          },
+          {
+            "name": "diameter",
+            "type": "number"
+          },
+          {
+            "name": "weight",
+            "type": "number"
+          },
+          {
+            "name": "floating",
+            "type": "boolean"
+          },
+          {
+            "name": "archive_memory",
+            "type": "string"
+          },
           {
             "name": "sensor_slope",
             "type": "number"
@@ -550,6 +570,10 @@
             "name": "deploy_longitude",
             "type": "number"
           },
+          {
+            "name": "depth_in_meters",
+            "type": "number"
+          },
           {
             "name": "sensor_value",
             "type": "number"
@@ -894,4 +918,4 @@
       }
     }
   ]
-}
+}
diff --git a/man/download_acoustic_dataset.Rd b/man/download_acoustic_dataset.Rd
diff --git a/man/etn-package.Rd b/man/etn-package.Rd
diff --git a/tests/testthat/_snaps/download_acoustic_dataset.md b/tests/testthat/_snaps/download_acoustic_dataset.md
@@ -0,0 +1,25 @@
+# download_acoustic_dataset() returns message and summary stats
+
+    Code
+      cat(download_acoustic_dataset(con, animal_project_code = "2014_demer"))
+    Message <simpleMessage>
+      Downloading data to directory `2014_demer`:
+      * (1/6): downloading animals.csv
+      * (2/6): downloading tags.csv
+      * (3/6): downloading detections.csv
+      * (4/6): downloading deployments.csv
+      * (5/6): downloading receivers.csv
+      * (6/6): adding datapackage.json as file metadata
+      
+      Summary statistics for dataset `2014_demer`:
+      * number of animals:           16
+      * number of tags:              16
+      * number of detections:        236918
+      * number of deployments:       1081
+      * number of receivers:         244
+      * first date of detection:     2014-04-18
+      * last date of detection:      2018-09-15
+      * included scientific names:   Petromyzon marinus, Rutilus rutilus, Silurus glanis, Squalius cephalus
+      * included acoustic projects:  V2LCHASES, albert, demer, dijle, zeeschelde
+      
+