Add write_dwc() function

DESCRIPTION

@@ -25,6 +25,7 @@ Imports:
     DBI,
     dplyr,
     glue,
+    jsonlite,
     lubridate,
     methods,
     odbc,
@@ -42,4 +43,4 @@ LazyData: true
 Encoding: UTF-8
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.2

NAMESPACE

@@ -27,6 +27,7 @@ export(list_station_names)
 export(list_tag_ids)
 export(list_tag_serial_numbers)
 export(list_values)
+export(write_dwc)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
 importFrom(dplyr,distinct)

R/download_acoustic_dataset.R

@@ -53,16 +53,15 @@
 #'
 #' # Download data for the 2012_leopoldkanaal animal project (all scientific names)
 #' download_acoustic_dataset(animal_project_code = "2012_leopoldkanaal")
-#' #> Downloading data to directory "2012_leopoldkanaal":
-#' #> (existing files with the same name will be overwritten)
+#' #> Downloading data to directory `2012_leopoldkanaal`:
 #' #> * (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 "2012_leopoldkanaal":
+#' #> Summary statistics for dataset `2012_leopoldkanaal`:
 #' #> * number of animals:           104
 #' #> * number of tags:              103
 #' #> * number of detections:        2215243
@@ -85,28 +84,29 @@ download_acoustic_dataset <- function(connection = con,
   check_connection(connection)
 
   # Check animal_project_code
-  if (missing(animal_project_code) || is.null(animal_project_code)) {
-    stop("Please provide an animal_project_code")
-  } else {
-    animal_project_code <- tolower(animal_project_code)
-    valid_animal_project_codes <- tolower(list_animal_project_codes(connection))
-    check_value(animal_project_code, valid_animal_project_codes, "animal_project_code")
-  }
+  assertthat::assert_that(
+    length(animal_project_code) == 1,
+    msg = "`animal_project_code` must be a single value."
+  )
+  animal_project_code <- check_value(
+    animal_project_code,
+    list_animal_project_codes(connection),
+    "animal_project_code",
+    lowercase = TRUE
+  )
 
   # Check scientific_name
   if (!is.null(scientific_name)) {
-    valid_scientific_names <- list_scientific_names(connection)
-    check_value(scientific_name, valid_scientific_names, "scientific_name")
+    scientific_name <- check_value(
+      scientific_name,
+      list_scientific_names(connection),
+      "scientific_name"
+    )
   }
 
-  # Check directory
-  dir.create(directory, recursive = TRUE, showWarnings = FALSE)
-
   # Start downloading
-  message(glue::glue(
-    "Downloading data to directory \"{directory}\":
-    (existing files with the same name will be overwritten)"
-  ))
+  dir.create(directory, recursive = TRUE, showWarnings = FALSE)
+  message(glue::glue("Downloading data to directory `{directory}`:"))
 
   # ANIMALS
   message("* (1/6): downloading animals.csv")
@@ -199,7 +199,7 @@ 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))

R/get_acoustic_deployments.R

@@ -53,8 +53,11 @@ get_acoustic_deployments <- function(connection = con,
   if (is.null(deployment_id)) {
     deployment_id_query <- "True"
   } else {
-    valid_deployment_ids <- list_deployment_ids(connection)
-    check_value(deployment_id, valid_deployment_ids, "receiver_id")
+    deployment_id <- check_value(
+      deployment_id,
+      list_deployment_ids(connection),
+      "receiver_id"
+    )
     deployment_id_query <- glue::glue_sql(
       "dep.id_pk IN ({deployment_id*})",
       .con = connection
@@ -65,8 +68,11 @@ get_acoustic_deployments <- function(connection = con,
   if (is.null(receiver_id)) {
     receiver_id_query <- "True"
   } else {
-    valid_receiver_ids <- list_receiver_ids(connection)
-    check_value(receiver_id, valid_receiver_ids, "receiver_id")
+    receiver_id <- check_value(
+      receiver_id,
+      list_receiver_ids(connection),
+      "receiver_id"
+    )
     receiver_id_query <- glue::glue_sql(
       "receiver.receiver IN ({receiver_id*})",
       .con = connection
@@ -77,9 +83,12 @@ get_acoustic_deployments <- function(connection = con,
   if (is.null(acoustic_project_code)) {
     acoustic_project_code_query <- "True"
   } else {
-    acoustic_project_code <- tolower(acoustic_project_code)
-    valid_acoustic_project_codes <- tolower(list_acoustic_project_codes(connection))
-    check_value(acoustic_project_code, valid_acoustic_project_codes, "acoustic_project_code")
+    acoustic_project_code <- check_value(
+      acoustic_project_code,
+      list_acoustic_project_codes(connection),
+      "acoustic_project_code",
+      lowercase = TRUE
+    )
     acoustic_project_code_query <- glue::glue_sql(
       "LOWER(network_project.projectcode) IN ({acoustic_project_code*})",
       .con = connection
@@ -90,8 +99,11 @@ get_acoustic_deployments <- function(connection = con,
   if (is.null(station_name)) {
     station_name_query <- "True"
   } else {
-    valid_station_names <- list_station_names(connection)
-    check_value(station_name, valid_station_names, "station_name")
+    station_name <- check_value(
+      station_name,
+      list_station_names(connection),
+      "station_name"
+    )
     station_name_query <- glue::glue_sql(
       "dep.station_name IN ({station_name*})",
       .con = connection

R/get_acoustic_detections.R

@@ -107,8 +107,11 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(acoustic_tag_id)) {
     acoustic_tag_id_query <- "True"
   } else {
-    valid_acoustic_tag_ids <- list_acoustic_tag_ids(connection)
-    check_value(acoustic_tag_id, valid_acoustic_tag_ids, "acoustic_tag_id")
+    acoustic_tag_id <- check_value(
+      acoustic_tag_id,
+      list_acoustic_tag_ids(connection),
+      "acoustic_tag_id"
+    )
     acoustic_tag_id_query <- glue::glue_sql(
       "det.transmitter IN ({acoustic_tag_id*})",
       .con = connection
@@ -120,9 +123,12 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(animal_project_code)) {
     animal_project_code_query <- "True"
   } else {
-    animal_project_code <- tolower(animal_project_code)
-    valid_animal_project_codes <- tolower(list_animal_project_codes(connection))
-    check_value(animal_project_code, valid_animal_project_codes, "animal_project_code")
+    animal_project_code <- check_value(
+      animal_project_code,
+      list_animal_project_codes(connection),
+      "animal_project_code",
+      lowercase = TRUE
+    )
     animal_project_code_query <- glue::glue_sql(
       "LOWER(animal_project_code) IN ({animal_project_code*})",
       .con = connection
@@ -133,8 +139,11 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(scientific_name)) {
     scientific_name_query <- "True"
   } else {
-    valid_scientific_name_ids <- list_scientific_names(connection)
-    check_value(scientific_name, valid_scientific_name_ids, "scientific_name")
+    scientific_name <- check_value(
+      scientific_name,
+      list_scientific_names(connection),
+      "scientific_name"
+    )
     scientific_name_query <- glue::glue_sql(
       "animal_scientific_name IN ({scientific_name*})",
       .con = connection
@@ -145,9 +154,12 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(acoustic_project_code)) {
     acoustic_project_code_query <- "True"
   } else {
-    acoustic_project_code <- tolower(acoustic_project_code)
-    valid_acoustic_project_codes <- tolower(list_acoustic_project_codes(connection))
-    check_value(acoustic_project_code, valid_acoustic_project_codes, "acoustic_project_code")
+    acoustic_project_code <- check_value(
+      acoustic_project_code,
+      list_acoustic_project_codes(connection),
+      "acoustic_project_code",
+      lowercase = TRUE
+    )
     acoustic_project_code_query <- glue::glue_sql(
       "LOWER(network_project_code) IN ({acoustic_project_code*})",
       .con = connection
@@ -158,8 +170,11 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(receiver_id)) {
     receiver_id_query <- "True"
   } else {
-    valid_receiver_ids <- list_receiver_ids(connection)
-    check_value(receiver_id, valid_receiver_ids, "receiver_id")
+    receiver_id <- check_value(
+      receiver_id,
+      list_receiver_ids(connection),
+      "receiver_id"
+    )
     receiver_id_query <- glue::glue_sql(
       "det.receiver IN ({receiver_id*})",
       .con = connection
@@ -170,8 +185,11 @@ get_acoustic_detections <- function(connection = con,
   if (is.null(station_name)) {
     station_name_query <- "True"
   } else {
-    valid_station_names <- list_station_names(connection)
-    check_value(station_name, valid_station_names, "station_name")
+    station_name <- check_value(
+      station_name,
+      list_station_names(connection),
+      "station_name"
+    )
     station_name_query <- glue::glue_sql(
       "deployment_station_name IN ({station_name*})",
       .con = connection

R/get_acoustic_projects.R

@@ -30,9 +30,12 @@ get_acoustic_projects <- function(connection = con,
   if (is.null(acoustic_project_code)) {
     acoustic_project_code_query <- "True"
   } else {
-    acoustic_project_code <- tolower(acoustic_project_code)
-    valid_acoustic_project_codes <- tolower(list_acoustic_project_codes(connection))
-    check_value(acoustic_project_code, valid_acoustic_project_codes, "acoustic_project_code")
+    acoustic_project_code <- check_value(
+      acoustic_project_code,
+      list_acoustic_project_codes(connection),
+      "acoustic_project_code",
+      lowercase = TRUE
+    )
     acoustic_project_code_query <- glue::glue_sql(
       "LOWER(project.project_code) IN ({acoustic_project_code*})",
       .con = connection

R/get_animal_projects.R

@@ -30,9 +30,12 @@ get_animal_projects <- function(connection = con,
   if (is.null(animal_project_code)) {
     animal_project_code_query <- "True"
   } else {
-    animal_project_code <- tolower(animal_project_code)
-    valid_animal_project_codes <- tolower(list_animal_project_codes(connection))
-    check_value(animal_project_code, valid_animal_project_codes, "animal_project_code")
+    animal_project_code <- check_value(
+      animal_project_code,
+      list_animal_project_codes(connection),
+      "animal_project_code",
+      lowercase = TRUE
+    )
     animal_project_code_query <- glue::glue_sql(
       "LOWER(project.project_code) IN ({animal_project_code*})",
       .con = connection

R/get_animals.R

@@ -53,8 +53,11 @@ get_animals <- function(connection = con,
   if (is.null(animal_id)) {
     animal_id_query <- "True"
   } else {
-    valid_animal_ids <- list_animal_ids(connection)
-    check_value(animal_id, valid_animal_ids, "animal_id")
+    animal_id <- check_value(
+      animal_id,
+      list_animal_ids(connection),
+      "animal_id"
+    )
     animal_id_query <- glue::glue_sql(
       "animal.id_pk IN ({animal_id*})",
       .con = connection
@@ -66,9 +69,12 @@ get_animals <- function(connection = con,
   if (is.null(animal_project_code)) {
     animal_project_code_query <- "True"
   } else {
-    animal_project_code <- tolower(animal_project_code)
-    valid_animal_project_codes <- tolower(list_animal_project_codes(connection))
-    check_value(animal_project_code, valid_animal_project_codes, "animal_project_code")
+    animal_project_code <- check_value(
+      animal_project_code,
+      list_animal_project_codes(connection),
+      "animal_project_code",
+      lowercase = TRUE
+    )
     animal_project_code_query <- glue::glue_sql(
       "LOWER(animal_project.projectcode) IN ({animal_project_code*})",
       .con = connection
@@ -79,9 +85,11 @@ get_animals <- function(connection = con,
   if (is.null(tag_serial_number)) {
     tag_serial_number_query <- "True"
   } else {
-    valid_tag_serial_numbers <- list_tag_serial_numbers(connection)
-    tag_serial_number <- as.character(tag_serial_number) # Cast to character
-    check_value(tag_serial_number, valid_tag_serial_numbers, "tag_serial_number")
+    tag_serial_number <- check_value(
+      as.character(tag_serial_number), # Cast to character
+      list_tag_serial_numbers(connection),
+      "tag_serial_number"
+    )
     tag_serial_number_query <- glue::glue_sql(
       "tag.tag_serial_number IN ({tag_serial_number*})",
       .con = connection
@@ -92,8 +100,11 @@ get_animals <- function(connection = con,
   if (is.null(scientific_name)) {
     scientific_name_query <- "True"
   } else {
-    valid_scientific_names <- list_scientific_names(connection)
-    check_value(scientific_name, valid_scientific_names, "scientific_name")
+    scientific_name <- check_value(
+      scientific_name,
+      list_scientific_names(connection),
+      "scientific_name"
+    )
     scientific_name_query <- glue::glue_sql(
       "animal.scientific_name IN ({scientific_name*})",
       .con = connection

R/get_cpod_projects.R

@@ -30,9 +30,12 @@ get_cpod_projects <- function(connection = con,
   if (is.null(cpod_project_code)) {
     cpod_project_code_query <- "True"
   } else {
-    cpod_project_code <- tolower(cpod_project_code)
-    valid_cpod_project_codes <- tolower(list_cpod_project_codes(connection))
-    check_value(cpod_project_code, valid_cpod_project_codes, "cpod_project_code")
+    cpod_project_code <- check_value(
+      cpod_project_code,
+      list_cpod_project_codes(connection),
+      "cpod_project_code",
+      lowercase = TRUE
+    )
     cpod_project_code_query <- glue::glue_sql(
       "LOWER(project.project_code) IN ({cpod_project_code*})",
       .con = connection