diff --git a/DESCRIPTION b/DESCRIPTION index b3e548a..3fc48a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: etnservice Title: Serve Data from the European Tracking Network -Version: 0.0.0.9000 +Version: 0.1.0 Authors@R: c( person("Pieter", "Huybrechts", , "pieter.huybrechts@inbo.be", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6658-6062")), @@ -9,21 +9,26 @@ Authors@R: c( person("Research Institute for Nature and Forest (INBO)", role = "cph", comment = "https://www.vlaanderen.be/inbo/en-gb/"), person("LifeWatch Belgium", role = "fnd", - comment = "https://lifewatch.be")) -Description: Provides API endpoints to the European Tracking Network. Designed - to be used with OpenCPU and the 'etn' package. + comment = "https://lifewatch.be") + ) +Description: Provides API endpoints to the European Tracking Network. + Designed to be used with OpenCPU and the 'etn' package. License: MIT + file LICENSE -Encoding: UTF-8 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 Imports: assertthat, DBI, dplyr, glue, httr, + jsonlite, lubridate, methods, odbc, readr, stringr +Suggests: + testthat (>= 3.0.0) +Config/testthat/edition: 3 +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index c0ece93..e4cfe9d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,14 +6,20 @@ export(get_acoustic_detections) export(get_acoustic_projects) export(get_acoustic_receivers) export(get_animal_projects) +export(get_animals) +export(get_cpod_projects) +export(get_tags) export(list_acoustic_project_codes) export(list_acoustic_tag_ids) export(list_animal_ids) export(list_animal_project_codes) +export(list_cpod_project_codes) export(list_deployment_ids) export(list_receiver_ids) export(list_scientific_names) export(list_station_names) +export(list_tag_serial_numbers) +export(write_dwc) importFrom(dplyr,"%>%") importFrom(dplyr,.data) importFrom(dplyr,distinct) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..8ed05a5 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,5 @@ +# etnservice v0.1.0 + +- This is the first version of etnservice used in the beta of etn v2.3.0. +- This version is still lagging behind it's contemporary version of etn v2.2.1, which means that database queries made via etnservice, or via the OpenCPU API are not guaranteed to be identical as the results of the same queries made via the etn R package. + diff --git a/R/connect_to_etn.R b/R/connect_to_etn.R index f3a955f..3cdfe91 100644 --- a/R/connect_to_etn.R +++ b/R/connect_to_etn.R @@ -19,11 +19,28 @@ #' con <- connect_to_etn(username = "my_username", password = "my_password") #' } connect_to_etn <- function(username, password) { - connection <- DBI::dbConnect( - odbc::odbc(), - "ETN", - uid = paste("", tolower(username), "", sep = ""), - pwd = paste("", password, "", sep = "") + tryCatch( + { + # Attempt to connect to the database with the provided credentials + connection <- DBI::dbConnect( + odbc::odbc(), + "ETN", + uid = paste("", tolower(username), "", sep = ""), + pwd = paste("", password, "", sep = "") + ) + return(connection) + }, + error = function(e) { + # When the database connection fails, return the error message and some + # directions to try again. This is usually due to a wrong password, so + # let's include that as a clue in the error message. + stop(glue::glue(e$message, + "Failed to connect to the database.", + "Did you enter the right username/password?", + "Please try again.", + .sep = "\n"), + call. = FALSE) + + } ) - return(connection) } diff --git a/R/get_acoustic_deployments.R b/R/get_acoustic_deployments.R index 4bd708b..cd9e049 100644 --- a/R/get_acoustic_deployments.R +++ b/R/get_acoustic_deployments.R @@ -20,26 +20,29 @@ #' @export #' #' @examples -#' # Set default connection variable -#' con <- connect_to_etn() +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) #' #' # Get all acoustic deployments -#' get_acoustic_deployments(con) +#' get_acoustic_deployments(credentials) #' #' # Get specific acoustic deployment -#' get_acoustic_deployments(con, deployment_id = 1437) +#' get_acoustic_deployments(credentials, deployment_id = 1437) #' #' # Get acoustic deployments for a specific receiver -#' get_acoustic_deployments(con, receiver_id = "VR2W-124070") +#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070") #' #' # Get open acoustic deployments for a specific receiver -#' get_acoustic_deployments(con, receiver_id = "VR2W-124070", open_only = TRUE) +#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070", open_only = TRUE) #' #' # Get acoustic deployments for a specific acoustic project -#' get_acoustic_deployments(con, acoustic_project_code = "demer") +#' get_acoustic_deployments(credentials, acoustic_project_code = "demer") #' #' # Get acoustic deployments for two specific stations -#' get_acoustic_deployments(con, station_name = c("de-9", "de-10")) +#' get_acoustic_deployments(credentials, station_name = c("de-9", "de-10")) get_acoustic_deployments <- function( credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")), @@ -49,6 +52,9 @@ get_acoustic_deployments <- function( station_name = NULL, open_only = FALSE) { + # Check if credentials object has right shape + check_credentials(credentials) + # create connection object connection <- connect_to_etn(credentials$username, credentials$password) @@ -189,6 +195,9 @@ get_acoustic_deployments <- function( ", .con = connection) deployments <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Filter on open deployments if (open_only) { deployments <- filter(deployments, is.na(.data$recover_date_time)) diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index f014f22..4d978f6 100644 --- a/R/get_acoustic_detections.R +++ b/R/get_acoustic_detections.R @@ -90,6 +90,8 @@ get_acoustic_detections <- function(credentials = list( station_name = NULL, limit = FALSE) { + # Check if credentials object has right shape + check_credentials(credentials) # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) @@ -215,7 +217,7 @@ get_acoustic_detections <- function(credentials = list( } acoustic_tag_id_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")), + readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")), .con = connection ) @@ -272,6 +274,9 @@ get_acoustic_detections <- function(credentials = list( factor(.data$acoustic_tag_id, levels = list_acoustic_tag_ids(credentials)), .data$date_time ) + # Close connection + DBI::dbDisconnect(connection) + # Return detections dplyr::as_tibble(detections) } diff --git a/R/get_acoustic_projects.R b/R/get_acoustic_projects.R index 456875e..8bb5e92 100644 --- a/R/get_acoustic_projects.R +++ b/R/get_acoustic_projects.R @@ -13,19 +13,26 @@ #' @export #' #' @examples -#' # Set default connection variable -#' con <- connect_to_etn() +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) #' #' # Get all acoustic projects -#' get_acoustic_projects(con) +#' get_acoustic_projects(credentials) #' #' # Get a specific acoustic project -#' get_acoustic_projects(con, acoustic_project_code = "demer") +#' get_acoustic_projects(credentials, acoustic_project_code = "demer") get_acoustic_projects <- function(credentials = list( username = Sys.getenv("userid"), password = Sys.getenv("pwd") ), acoustic_project_code = NULL) { + + # Check if credentials object has right shape + check_credentials(credentials) + # create connection object connection <- connect_to_etn(credentials$username, credentials$password) @@ -50,7 +57,7 @@ get_acoustic_projects <- function(credentials = list( } project_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "project.sql", package = "etn")), + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), .con = connection ) @@ -66,6 +73,9 @@ get_acoustic_projects <- function(credentials = list( ", .con = connection) projects <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data projects <- projects %>% diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R index 7e7c5f3..dfdca3d 100644 --- a/R/get_acoustic_receivers.R +++ b/R/get_acoustic_receivers.R @@ -15,17 +15,20 @@ #' @export #' #' @examples -#' # Set default connection variable -#' con <- connect_to_etn() +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) #' #' # Get all acoustic receivers -#' get_acoustic_receivers(con) +#' get_acoustic_receivers(credentials) #' #' # Get lost and broken acoustic receivers -#' get_acoustic_receivers(con, status = c("lost", "broken")) +#' get_acoustic_receivers(credentials, status = c("lost", "broken")) #' #' # Get a specific acoustic receiver -#' get_acoustic_receivers(con, receiver_id = "VR2W-124070") +#' get_acoustic_receivers(credentials, receiver_id = "VR2W-124070") get_acoustic_receivers <- function(credentials = list( username = Sys.getenv("userid"), password = Sys.getenv("pwd") @@ -63,11 +66,11 @@ get_acoustic_receivers <- function(credentials = list( } receiver_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "receiver.sql", package = "etn")), + readr::read_file(system.file("sql", "receiver.sql", package = "etnservice")), .con = connection ) acoustic_tag_id_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")), + readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")), .con = connection ) @@ -124,5 +127,9 @@ get_acoustic_receivers <- function(credentials = list( receivers %>% dplyr::arrange(.data$receiver_id) + # Close connection + DBI::dbDisconnect(connection) + + # Return receivers dplyr::as_tibble(receivers) } diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R index 6049fee..96571b2 100644 --- a/R/get_animal_projects.R +++ b/R/get_animal_projects.R @@ -13,19 +13,26 @@ #' @export #' #' @examples -#' # Set default connection variable -#' con <- connect_to_etn() +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) #' #' # Get all animal projects -#' get_animal_projects(con) +#' get_animal_projects(credentials) #' #' # Get a specific animal project -#' get_animal_projects(con, animal_project_code = "2014_demer") +#' get_animal_projects(credentials, animal_project_code = "2014_demer") get_animal_projects <- function(credentials = list( username = Sys.getenv("userid"), password = Sys.getenv("pwd") ), animal_project_code = NULL) { + + # Check if credentials object has right shape + check_credentials(credentials) + # Create connection object connection <- connect_to_etn(credentials$username, credentials$password) @@ -38,7 +45,7 @@ get_animal_projects <- function(credentials = list( } else { animal_project_code <- check_value( animal_project_code, - list_animal_project_codes(connection), + list_animal_project_codes(credentials), "animal_project_code", lowercase = TRUE ) @@ -49,7 +56,7 @@ get_animal_projects <- function(credentials = list( } project_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "project.sql", package = "etn")), + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), .con = connection ) @@ -65,6 +72,9 @@ get_animal_projects <- function(credentials = list( ", .con = connection) projects <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data projects <- projects %>% diff --git a/R/get_animals.R b/R/get_animals.R new file mode 100644 index 0000000..18ee4e3 --- /dev/null +++ b/R/get_animals.R @@ -0,0 +1,255 @@ +#' Get animal data +#' +#' Get data for animals, with options to filter results. Associated tag +#' information is available in columns starting with `tag` and +#' `acoustic_tag_id`. If multiple tags are associated with a single animal, +#' the information is comma-separated. +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' @param animal_id Integer (vector). One or more animal identifiers. +#' @param animal_project_code Character (vector). One or more animal project +#' codes. Case-insensitive. +#' @param tag_serial_number Character (vector). One or more tag serial numbers. +#' @param scientific_name Character (vector). One or more scientific names. +#' +#' @return A tibble with animals data, sorted by `animal_project_code`, +#' `release_date_time` and `tag_serial_number`. See also +#' [field definitions](https://inbo.github.io/etn/articles/etn_fields.html). +#' +#' @export +#' +#' @examples +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) +#' +#' # Get all animals +#' get_animals(credentials) +#' +#' # Get specific animals +#' get_animals(credentials, animal_id = 305) # Or string value "305" +#' get_animals(credentials, animal_id = c(304, 305, 2827)) +#' +#' # Get animals from specific animal project(s) +#' get_animals(credentials, animal_project_code = "2014_demer") +#' get_animals(credentials, animal_project_code = c("2014_demer", "2015_dijle")) +#' +#' # Get animals associated with a specific tag_serial_number +#' get_animals(credentials, tag_serial_number = "1187450") +#' +#' # Get animals of specific species (across all projects) +#' get_animals(credentials, scientific_name = c("Rutilus rutilus", "Silurus glanis")) +#' +#' # Get animals of a specific species from a specific project +#' get_animals(credentials, animal_project_code = "2014_demer", scientific_name = "Rutilus rutilus") +get_animals <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ), + animal_id = NULL, + tag_serial_number = NULL, + animal_project_code = NULL, + scientific_name = NULL) { + + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check connection + check_connection(connection) + + # Check animal_id + if (is.null(animal_id)) { + animal_id_query <- "True" + } else { + animal_id <- check_value( + animal_id, + list_animal_ids(credentials), + "animal_id" + ) + animal_id_query <- glue::glue_sql( + "animal.id_pk IN ({animal_id*})", + .con = connection + ) + # animal_id_query seems to work correctly with integers or strings: 'animal_id IN (\'304\')' + } + + # Check animal_project_code + if (is.null(animal_project_code)) { + animal_project_code_query <- "True" + } else { + animal_project_code <- check_value( + animal_project_code, + list_animal_project_codes(credentials), + "animal_project_code", + lowercase = TRUE + ) + animal_project_code_query <- glue::glue_sql( + "LOWER(animal_project.projectcode) IN ({animal_project_code*})", + .con = connection + ) + } + + # Check tag_serial_number + if (is.null(tag_serial_number)) { + tag_serial_number_query <- "True" + } else { + tag_serial_number <- check_value( + as.character(tag_serial_number), # Cast to character + list_tag_serial_numbers(credentials), + "tag_serial_number" + ) + tag_serial_number_query <- glue::glue_sql( + "tag.tag_serial_number IN ({tag_serial_number*})", + .con = connection + ) + } + + # Check scientific_name + if (is.null(scientific_name)) { + scientific_name_query <- "True" + } else { + scientific_name <- check_value( + scientific_name, + list_scientific_names(credentials), + "scientific_name" + ) + scientific_name_query <- glue::glue_sql( + "animal.scientific_name IN ({scientific_name*})", + .con = connection + ) + } + + tag_sql <- glue::glue_sql( + readr::read_file(system.file("sql", "tag.sql", package = "etnservice")), + .con = connection + ) + + # Build query + query <- glue::glue_sql(" + SELECT + animal.id_pk AS animal_id, + animal_project.projectcode AS animal_project_code, + tag.tag_serial_number AS tag_serial_number, + tag.tag_type AS tag_type, + tag.tag_subtype AS tag_subtype, + tag.acoustic_tag_id AS acoustic_tag_id, + tag.thelma_converted_code AS acoustic_tag_id_alternative, + animal.scientific_name AS scientific_name, + animal.common_name AS common_name, + animal.aphia_id AS aphia_id, + animal.animal_id AS animal_label, + animal.animal_nickname AS animal_nickname, + animal.tagger AS tagger, + animal.catched_date_time AS capture_date_time, + animal.capture_location AS capture_location, + animal.capture_latitude AS capture_latitude, + animal.capture_longitude AS capture_longitude, + animal.capture_method AS capture_method, + animal.capture_depth AS capture_depth, + animal.temperature_change AS capture_temperature_change, + animal.utc_release_date_time AS release_date_time, + animal.release_location AS release_location, + animal.release_latitude AS release_latitude, + animal.release_longitude AS release_longitude, + animal.recapture_date AS recapture_date_time, + animal.length_type AS length1_type, + animal.length AS length1, + animal.length_units AS length1_unit, + animal.length2_type AS length2_type, + animal.length2 AS length2, + animal.length2_units AS length2_unit, + animal.length3_type AS length3_type, + animal.length3 AS length3, + animal.length3_units AS length3_unit, + animal.length4_type AS length4_type, + animal.length4 AS length4, + animal.length4_units AS length4_unit, + animal.weight AS weight, + animal.weight_units AS weight_unit, + animal.age AS age, + animal.age_units AS age_unit, + animal.sex AS sex, + animal.life_stage AS life_stage, + animal.wild_or_hatchery AS wild_or_hatchery, + animal.stock AS stock, + animal.date_of_surgery AS surgery_date_time, + animal.surgery_location AS surgery_location, + animal.surgery_latitude AS surgery_latitude, + animal.surgery_longitude AS surgery_longitude, + animal.treatment_type AS treatment_type, + animal.implant_type AS tagging_type, + animal.implant_method AS tagging_methodology, + animal.dna_sample_taken AS dna_sample, + animal.sedative AS sedative, + animal.sedative_concentration AS sedative_concentration, + animal.anaesthetic AS anaesthetic, + animal.buffer AS buffer, + animal.anaesthetic_concentration AS anaesthetic_concentration, + animal.buffer_concentration_in_anaesthetic AS buffer_concentration_in_anaesthetic, + animal.anesthetic_concentration_in_recirculation AS anaesthetic_concentration_in_recirculation, + animal.buffer_concentration_in_recirculation AS buffer_concentration_in_recirculation, + animal.dissolved_oxygen AS dissolved_oxygen, + animal.preop_holding_period AS pre_surgery_holding_period, + animal.post_op_holding_period AS post_surgery_holding_period, + animal.holding_temperature AS holding_temperature, + animal.comments AS comments + -- animal.project: animal.project_fk instead + -- animal.person_id + -- animal.est_tag_life + -- animal.date_modified + -- animal.date_created + -- animal.end_date_tag + -- animal.post_op_holding_period_new + -- animal.external_id + FROM common.animal_release_limited AS animal + LEFT JOIN common.animal_release_tag_device AS animal_with_tag + ON animal.id_pk = animal_with_tag.animal_release_fk + LEFT JOIN ({tag_sql}) AS tag + ON animal_with_tag.tag_device_fk = tag.tag_device_fk + LEFT JOIN common.projects AS animal_project + ON animal.project_fk = animal_project.id + WHERE + {animal_id_query} + AND {animal_project_code_query} + AND {tag_serial_number_query} + AND {scientific_name_query} + ", .con = connection) + animals <- DBI::dbGetQuery(connection, query) + + # Collapse tag information, to obtain one row = one animal + tag_cols <- + animals %>% + dplyr::select(dplyr::starts_with("tag"), dplyr::starts_with("acoustic_tag_id")) %>% + names() + other_cols <- + animals %>% + dplyr::select(-dplyr::starts_with("tag"), -dplyr::starts_with("acoustic_tag_id")) %>% + names() + animals <- + animals %>% + dplyr::group_by_at(other_cols) %>% + dplyr::summarize_at(tag_cols, paste, collapse = ",") %>% # Collapse multiple tags by comma + dplyr::ungroup() %>% + dplyr::mutate_at(tag_cols, gsub, pattern = "NA", replacement = "") %>% # Use "" instead of "NA" + dplyr::select(names(animals)) # Use the original column order + + # Sort data + animals <- + animals %>% + dplyr::arrange( + .data$animal_project_code, + .data$release_date_time, + factor(.data$tag_serial_number, levels = list_tag_serial_numbers(credentials)) + ) + + # Close connection + DBI::dbDisconnect(connection) + + # Return animals + dplyr::as_tibble(animals) # Is already a tibble, but added if code above changes +} diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R new file mode 100644 index 0000000..ef31e30 --- /dev/null +++ b/R/get_cpod_projects.R @@ -0,0 +1,84 @@ +#' Get cpod project data +#' +#' Get data for cpod projects, with options to filter results. +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' @param cpod_project_code Character (vector). One or more cpod project +#' codes. Case-insensitive. +#' +#' @return A tibble with animal project data, sorted by `project_code`. See +#' also +#' [field definitions](https://inbo.github.io/etn/articles/etn_fields.html). +#' +#' @export +#' +#' @examples +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) +#' +#' # Get all animal projects +#' get_cpod_projects(credentials) +#' +#' # Get a specific animal project +#' get_cpod_projects(credentials, cpod_project_code = "cpod-lifewatch") +get_cpod_projects <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ), + cpod_project_code = NULL) { + + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check connection + check_connection(connection) + + # Check cpod_project_code + if (is.null(cpod_project_code)) { + cpod_project_code_query <- "True" + } else { + cpod_project_code <- check_value( + cpod_project_code, + list_cpod_project_codes(credentials), + "cpod_project_code", + lowercase = TRUE + ) + cpod_project_code_query <- glue::glue_sql( + "LOWER(project.project_code) IN ({cpod_project_code*})", + .con = connection + ) + } + + project_sql <- glue::glue_sql( + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), + .con = connection + ) + + # Build query + query <- glue::glue_sql(" + SELECT + project.* + FROM + ({project_sql}) AS project + WHERE + project_type = 'cpod' + AND {cpod_project_code_query} + ", .con = connection) + projects <- DBI::dbGetQuery(connection, query) + + # Sort data + projects <- + projects %>% + dplyr::arrange(.data$project_code) + # Close connection + DBI::dbDisconnect(connection) + + # Return data + dplyr::as_tibble(projects) +} diff --git a/R/get_tags.R b/R/get_tags.R new file mode 100644 index 0000000..23886e4 --- /dev/null +++ b/R/get_tags.R @@ -0,0 +1,220 @@ +#' Get tag data +#' +#' Get data for tags, with options to filter results. Note that there +#' can be multiple records (`acoustic_tag_id`) per tag device +#' (`tag_serial_number`). +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' @param tag_serial_number Character (vector). One or more tag serial numbers. +#' @param tag_type Character (vector). `acoustic` or `archival`. Some tags are +#' both, find those with `acoustic-archival`. +#' @param tag_subtype Character (vector). `animal`, `built-in`, `range` or +#' `sentinel`. +#' @param acoustic_tag_id Character (vector). One or more acoustic tag +#' identifiers, i.e. identifiers found in [get_acoustic_detections()]. +#' +#' @return A tibble with tags data, sorted by `tag_serial_number`. See also +#' [field definitions](https://inbo.github.io/etn/articles/etn_fields.html). +#' Values for `owner_organization` and `owner_pi` will only be visible if you +#' are member of the group. +#' +#' @export +#' +#' @examples +#' # Set credentials +#' credentials <- list( +#' username = Sys.getenv("userid"), +#' password = Sys.getenv("pwd") +#' ) +#' +#' # Get all tags +#' get_tags(credentials) +#' +#' # Get archival tags, including acoustic-archival +#' get_tags(credentials, tag_type = c("archival", "acoustic-archival")) +#' +#' # Get tags of specific subtype +#' get_tags(credentials, tag_subtype = c("built-in", "range")) +#' +#' # Get specific tags (note that these can return multiple records) +#' get_tags(credentials, tag_serial_number = "1187450") +#' get_tags(credentials, acoustic_tag_id = "A69-1601-16130") +#' get_tags(credentials, acoustic_tag_id = c("A69-1601-16129", "A69-1601-16130")) +get_tags <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ), + tag_type = NULL, + tag_subtype = NULL, + tag_serial_number = NULL, + acoustic_tag_id = NULL) { + + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check connection + check_connection(connection) + + # Check tag_serial_number + if (is.null(tag_serial_number)) { + tag_serial_number_query <- "True" + } else { + tag_serial_number <- check_value( + as.character(tag_serial_number), # Cast to character + list_tag_serial_numbers(credentials), + "tag_serial_number" + ) + tag_serial_number_query <- glue::glue_sql( + "tag.tag_serial_number IN ({tag_serial_number*})", + .con = connection + ) + } + + # Check tag_type + if (is.null(tag_type)) { + tag_type_query <- "True" + } else { + tag_type <- check_value( + tag_type, + c("acoustic", "archival", "acoustic-archival"), + "tag_type" + ) + tag_type_query <- glue::glue_sql( + "tag.tag_type IN ({tag_type*})", + .con = connection + ) + } + + # Check tag_subtype + if (is.null(tag_subtype)) { + tag_subtype_query <- "True" + } else { + tag_subtype <- check_value( + tag_subtype, + c("animal", "built-in", "range", "sentinel"), + "tag_subtype" + ) + tag_subtype_query <- glue::glue_sql( + "tag.tag_subtype IN ({tag_subtype*})", + .con = connection + ) + } + + # Check acoustic_tag_id + if (is.null(acoustic_tag_id)) { + acoustic_tag_id_query <- "True" + } else { + check_value( + acoustic_tag_id, + list_acoustic_tag_ids(credentials), + "acoustic_tag_id" + ) + acoustic_tag_id_query <- glue::glue_sql( + "tag.acoustic_tag_id IN ({acoustic_tag_id*})", + .con = connection + ) + } + + tag_sql <- glue::glue_sql( + readr::read_file(system.file("sql", "tag.sql", package = "etnservice")), + .con = connection + ) + + # Build query + query <- glue::glue_sql(" + SELECT + tag.tag_serial_number AS tag_serial_number, + tag.tag_type AS tag_type, + tag.tag_subtype AS tag_subtype, + tag.sensor_type AS sensor_type, + tag.acoustic_tag_id AS acoustic_tag_id, + tag.thelma_converted_code AS acoustic_tag_id_alternative, + manufacturer.project AS manufacturer, + tag_device.model AS model, + tag.frequency AS frequency, + tag_status.name AS status, + tag_device.activation_date AS activation_date, + tag_device.battery_estimated_lifetime AS battery_estimated_life, + tag_device.battery_estimated_end_date AS battery_estimated_end_date, + tag_device.archive_length AS length, + tag_device.archive_diameter AS diameter, + tag_device.archive_weight AS weight, + tag_device.archive_floating AS floating, + tag_device.device_internal_memory AS archive_memory, + tag.slope AS sensor_slope, + tag.intercept AS sensor_intercept, + tag.range AS sensor_range, + tag.range_min AS sensor_range_min, + tag.range_max AS sensor_range_max, + tag.resolution AS sensor_resolution, + tag.unit AS sensor_unit, + tag.accurency AS sensor_accuracy, + tag.sensor_transmit_ratio AS sensor_transmit_ratio, + tag.accelerometer_algoritm AS accelerometer_algorithm, + tag.accelerometer_samples_per_second AS accelerometer_samples_per_second, + CASE + WHEN tag_device.owner_group_fk_limited IS NOT NULL THEN owner_organization.name + ELSE NULL + END AS owner_organization, + CASE + WHEN tag_device.owner_group_fk_limited IS NOT NULL THEN tag_device.owner_pi + ELSE NULL + END AS owner_pi, + financing_project.projectcode AS financing_project, + tag.min_delay AS step1_min_delay, + tag.max_delay AS step1_max_delay, + tag.power AS step1_power, + tag.duration_step1 AS step1_duration, + tag.acceleration_on_sec_step1 AS step1_acceleration_duration, + tag.min_delay_step2 AS step2_min_delay, + tag.max_delay_step2 AS step2_max_delay, + tag.power_step2 AS step2_power, + tag.duration_step2 AS step2_duration, + tag.acceleration_on_sec_step2 AS step2_acceleration_duration, + tag.min_delay_step3 AS step3_min_delay, + tag.max_delay_step3 AS step3_max_delay, + tag.power_step3 AS step3_power, + tag.duration_step3 AS step3_duration, + tag.acceleration_on_sec_step3 AS step3_acceleration_duration, + tag.min_delay_step4 AS step4_min_delay, + tag.max_delay_step4 AS step4_max_delay, + tag.power_step4 AS step4_power, + tag.duration_step4 AS step4_duration, + tag.acceleration_on_sec_step4 AS step4_acceleration_duration, + tag.tag_id AS tag_id, + tag_device.id_pk AS tag_device_id + -- tag_device.qc_migration + -- tag_device.order_number + -- tag_device.external_id + FROM ({tag_sql}) AS tag + LEFT JOIN common.tag_device_limited AS tag_device + ON tag.tag_device_fk = tag_device.id_pk + LEFT JOIN common.manufacturer AS manufacturer + ON tag_device.manufacturer_fk = manufacturer.id_pk + LEFT JOIN common.tag_device_status AS tag_status + ON tag_device.tag_device_status_fk = tag_status.id_pk + LEFT JOIN common.etn_group AS owner_organization + ON tag_device.owner_group_fk_limited = owner_organization.id_pk + LEFT JOIN common.projects AS financing_project + ON tag_device.financing_project_fk = financing_project.id + WHERE + {tag_serial_number_query} + AND {tag_type_query} + AND {tag_subtype_query} + AND {acoustic_tag_id_query} + ", .con = connection) + tags <- DBI::dbGetQuery(connection, query) + + # Close connection + DBI::dbDisconnect(connection) + + # Sort data + tags <- + tags %>% + dplyr::arrange(factor(.data$tag_serial_number, levels = list_tag_serial_numbers(credentials))) + + dplyr::as_tibble(tags) +} diff --git a/R/list_acoustic_project_codes.R b/R/list_acoustic_project_codes.R index a46634c..cc6d181 100644 --- a/R/list_acoustic_project_codes.R +++ b/R/list_acoustic_project_codes.R @@ -13,7 +13,7 @@ list_acoustic_project_codes <- function(credentials = list( connection <- connect_to_etn(credentials$username, credentials$password) project_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "project.sql", package = "etn")), + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), .con = connection ) query <- glue::glue_sql( @@ -22,5 +22,9 @@ list_acoustic_project_codes <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return acoustic_project_codes sort(data$project_code) } diff --git a/R/list_acoustic_tag_ids.R b/R/list_acoustic_tag_ids.R index b8a21e0..ab4d4bd 100644 --- a/R/list_acoustic_tag_ids.R +++ b/R/list_acoustic_tag_ids.R @@ -11,7 +11,7 @@ list_acoustic_tag_ids <- function(credentials = list( )) { connection <- connect_to_etn(credentials$username, credentials$password) acoustic_tag_id_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")), + readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etnservice")), .con = connection ) query <- glue::glue_sql(" @@ -21,5 +21,9 @@ list_acoustic_tag_ids <- function(credentials = list( ", .con = connection) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return acoustic_tag_ids stringr::str_sort(data$acoustic_tag_id, numeric = TRUE) } diff --git a/R/list_animal_ids.R b/R/list_animal_ids.R index 9155fd1..5f3a72a 100644 --- a/R/list_animal_ids.R +++ b/R/list_animal_ids.R @@ -20,5 +20,8 @@ list_animal_ids <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + sort(data$id_pk) } diff --git a/R/list_animal_project_codes.R b/R/list_animal_project_codes.R index 19455ea..e8328ad 100644 --- a/R/list_animal_project_codes.R +++ b/R/list_animal_project_codes.R @@ -13,7 +13,7 @@ list_animal_project_codes <- function(credentials = list( connection <- connect_to_etn(credentials$username, credentials$password) project_sql <- glue::glue_sql( - readr::read_file(system.file("sql", "project.sql", package = "etn")), + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), .con = connection ) query <- glue::glue_sql( @@ -22,5 +22,8 @@ list_animal_project_codes <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + sort(data$project_code) } diff --git a/R/list_cpod_project_codes.R b/R/list_cpod_project_codes.R new file mode 100644 index 0000000..445267c --- /dev/null +++ b/R/list_cpod_project_codes.R @@ -0,0 +1,37 @@ +#' List all available cpod project codes +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' +#' @return A vector of all unique `project_code` of `type = "cpod"` in +#' `project.sql`. +#' +#' @export +list_cpod_project_codes <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +)) { + + # Check if credentials object has right shape + check_credentials(credentials) + + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check if we can make a connection + check_connection(connection) + + project_query <- glue::glue_sql( + readr::read_file(system.file("sql", "project.sql", package = "etnservice")), + .con = connection + ) + query <- glue::glue_sql( + "SELECT DISTINCT project_code FROM ({project_query}) AS project WHERE project_type = 'cpod'", + .con = connection + ) + data <- DBI::dbGetQuery(connection, query) + + # Close connection + DBI::dbDisconnect(connection) + + sort(data$project_code) +} diff --git a/R/list_deployment_ids.R b/R/list_deployment_ids.R index 24ac77e..24994a2 100644 --- a/R/list_deployment_ids.R +++ b/R/list_deployment_ids.R @@ -18,5 +18,8 @@ list_deployment_ids <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + stringr::str_sort(data$id, numeric = TRUE) } diff --git a/R/list_receiver_ids.R b/R/list_receiver_ids.R index d4cabbe..c64f019 100644 --- a/R/list_receiver_ids.R +++ b/R/list_receiver_ids.R @@ -16,5 +16,9 @@ list_receiver_ids <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return receiver_ids stringr::str_sort(data$receiver, numeric = TRUE) } diff --git a/R/list_scientific_names.R b/R/list_scientific_names.R index b298be3..0780fd8 100644 --- a/R/list_scientific_names.R +++ b/R/list_scientific_names.R @@ -10,12 +10,15 @@ list_scientific_names <- function(credentials = list( username = Sys.getenv("userid"), password = Sys.getenv("pwd") )) { - connection <- connection <- connect_to_etn(credentials$username, credentials$password) + connection <- connect_to_etn(credentials$username, credentials$password) query <- glue::glue_sql( "SELECT DISTINCT scientific_name FROM common.animal_release", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + sort(data$scientific_name) } diff --git a/R/list_station_names.R b/R/list_station_names.R index 3d89a3c..a6f038d 100644 --- a/R/list_station_names.R +++ b/R/list_station_names.R @@ -18,5 +18,8 @@ list_station_names <- function(credentials = list( ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + stringr::str_sort(data$station_name, numeric = TRUE) } diff --git a/R/list_tag_serial_numbers.R b/R/list_tag_serial_numbers.R new file mode 100644 index 0000000..92b53fa --- /dev/null +++ b/R/list_tag_serial_numbers.R @@ -0,0 +1,30 @@ +#' List all available tag serial numbers +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' +#' @return A vector of all unique `tag_serial_numbers` present in +#' `common.tag_device`. +#' +#' @export +list_tag_serial_numbers <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +)) { + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check if we can make a connection + check_connection(connection) + + query <- glue::glue_sql( + "SELECT DISTINCT serial_number FROM common.tag_device", + .con = connection + ) + data <- DBI::dbGetQuery(connection, query) + + # Close connection + DBI::dbDisconnect(connection) + + # Return vector + stringr::str_sort(data$serial_number, numeric = TRUE) +} diff --git a/R/utils.R b/R/utils.R index 5e723f6..62e5ab3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -110,6 +110,49 @@ get_credentials <- stringr::str_glue('list(username = "{username}", password = "{password}")') } +#' Check if the provided credentials are valid. +#' +#' This function checks if the provided credentials contain a "username" and "password" field, +#' and if both fields are of type character. It also verifies that the credentials object has a length of 2. +#' +#' @param credentials A list or data frame containing the credentials to be checked. +#' +#' @return TRUE if the credentials are valid, an error otherwise +#' +#' @examples +#' \dontrun{ +#' credentials <- list(username = "john_doe", password = "password123") +#' check_credentials(credentials) +#' #> [1] TRUE +#' } +check_credentials <- function(credentials) { + + assertthat::assert_that( + assertthat::has_name(credentials, "username"), + msg = "The credentials need to contain a 'username' field." + ) + + assertthat::assert_that( + assertthat::has_name(credentials, "password"), + msg = "The credentials need to contain a 'password' field." + ) + + assertthat::assert_that( + length(credentials) == 2, + msg = "The credentials object should have a length of 2." + ) + + assertthat::assert_that( + assertthat::is.string(credentials$username) + ) + + assertthat::assert_that( + assertthat::is.string(credentials$password) + ) + + return(TRUE) +} + #' Extract the OCPU temp key from a response object #' #' When posting a request to the opencpu api service without the json flag, a diff --git a/R/write_dwc.R b/R/write_dwc.R new file mode 100644 index 0000000..a8c8208 --- /dev/null +++ b/R/write_dwc.R @@ -0,0 +1,107 @@ +#' Transform ETN data to Darwin Core +#' +#' Transforms and downloads data from a European Tracking Network +#' **animal project** to [Darwin Core](https://dwc.tdwg.org/). +#' The resulting dataframe can be saved as a CSV and be uploaded to an [IPT]( +#' https://www.gbif.org/ipt) for publication to OBIS and/or GBIF. +#' A `meta.xml` or `eml.xml` file are not created. +#' +#' @param credentials A list with the username and password to connect to the ETN database. +#' @param animal_project_code Animal project code. +#' @param rights_holder Acronym of the organization owning or managing the +#' rights over the data. +#' @param license Identifier of the license under which the data will be +#' published. +#' - [`CC-BY`](https://creativecommons.org/licenses/by/4.0/legalcode) (default). +#' - [`CC0`](https://creativecommons.org/publicdomain/zero/1.0/legalcode). +#' @return list of dataframes +#' @export +#' @section Transformation details: +#' Data are transformed into an +#' [Occurrence core](https://rs.gbif.org/core/dwc_occurrence_2022-02-02.xml). +#' This **follows recommendations** discussed and created by Peter Desmet, +#' Jonas Mortelmans, Jonathan Pye, John Wieczorek and others. +#' See the [SQL file(s)](https://github.com/inbo/etn/tree/main/inst/sql) +#' used by this function for details. +#' +#' Key features of the Darwin Core transformation: +#' - Deployments (animal+tag associations) are parent events, with capture, +#' surgery, release, recapture (human observations) and acoustic detections +#' (machine observations) as child events. +#' No information about the parent event is provided other than its ID, +#' meaning that data can be expressed in an Occurrence Core with one row per +#' observation and `parentEventID` shared by all occurrences in a deployment. +#' - The release event often contains metadata about the animal (sex, +#' lifestage, comments) and deployment as a whole. +#' - Acoustic detections are downsampled to the **first detection per hour**, +#' to reduce the size of high-frequency data. +#' Duplicate detections (same animal, tag and timestamp) are excluded. +#' It is possible for a deployment to contain no detections, e.g. if the +#' tag malfunctioned right after deployment. +write_dwc <- function(credentials = list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ), + animal_project_code, + rights_holder = NULL, + license = "CC-BY") { + + # Create connection object + connection <- connect_to_etn(credentials$username, credentials$password) + + # Check connection + check_connection(connection) + + # Check animal_project_code + assertthat::assert_that( + length(animal_project_code) == 1, + msg = "`animal_project_code` must be a single value." + ) + ## Set animal project code to lowercase for sql + animal_project_code <- stringr::str_to_lower(animal_project_code) + + # Check license + licenses <- c("CC-BY", "CC0") + assertthat::assert_that( + license %in% licenses, + msg = glue::glue( + "`license` must be `{licenses}`.", + licenses = glue::glue_collapse(licenses, sep = "`, `", last = "` or `") + ) + ) + license <- switch( + license, + "CC-BY" = "https://creativecommons.org/licenses/by/4.0/legalcode", + "CC0" = "https://creativecommons.org/publicdomain/zero/1.0/legalcode" + ) + + # Get imis dataset id and title + project <- get_animal_projects(credentials, animal_project_code) + imis_dataset_id <- project$imis_dataset_id + imis_url <- "https://www.vliz.be/en/imis?module=dataset&dasid=" + imis_json <- jsonlite::read_json(paste0(imis_url, imis_dataset_id, "&show=json")) + dataset_id <- paste0(imis_url, imis_dataset_id) + dataset_name <- imis_json$datasetrec$StandardTitle + + # Query database + + ## NOTE this message could be retained if moved to the client together with + ## above get_animal_projects() call + # message("Reading data and transforming to Darwin Core.") + + dwc_occurrence_sql <- glue::glue_sql( + readr::read_file(system.file("sql/dwc_occurrence.sql", + package = "etnservice")), + .con = connection, + .null = "NULL" + ) + dwc_occurrence <- DBI::dbGetQuery(connection, dwc_occurrence_sql) + + # Close connection + DBI::dbDisconnect(connection) + + # Return list of dataframes + return( + list(dwc_occurrence = dplyr::as_tibble(dwc_occurrence)) + ) +} diff --git a/README.md b/README.md index 8ac7404..5cf3151 100644 --- a/README.md +++ b/README.md @@ -73,7 +73,7 @@ response %>% jsonlite::fromJSON(simplifyVector = TRUE) ``` -However, a fork of the [etn package](https://github.com/inbo/etn) is +However, a branch of the [etn package](https://github.com/inbo/etn) is currently in development that will allow you to do this using built in functions. diff --git a/inst/postman-helpers/find-postman-test-mismatch.R b/inst/postman-helpers/find-postman-test-mismatch.R new file mode 100644 index 0000000..244f1c6 --- /dev/null +++ b/inst/postman-helpers/find-postman-test-mismatch.R @@ -0,0 +1,96 @@ +# check mismatch between js test and api response for list_acoustic_project_codes + + +# load libraries ---------------------------------------------------------- + +library(httr2) + + + +# set function to test ---------------------------------------------------- + +fn_to_test <- "list_acoustic_tag_ids" + + +# get reponse ------------------------------------------------------------- + + +## build request ---------------------------------------------------------- + +request <- + request( + glue::glue( + "https://opencpu.lifewatch.be/library/etnservice/R/{fn_to_test}/json" + ) + ) + +response <- + request %>% + req_headers( + "Content-Type" = "application/json", + "Cookie" = "vliz_webc=vliz_webc2" + ) %>% + req_body_json(list( + credentials = list( + username = "pieter.huybrechts@inbo.be", + password = askpass::askpass("Please provide ETN db pwd") + ) + )) %>% + req_method("POST") %>% + req_perform() + +request <- request %>% + req_headers( + "Content-Type" = "application/json", + "Cookie" = "vliz_webc=vliz_webc2" + ) %>% + req_body_json(list( + credentials = list( + username = "pieter.huybrechts@inbo.be", + password = askpass::askpass("Please provide ETN db pwd") + ) + )) %>% + req_method("POST") + +# check against expectation ----------------------------------------------- + +# Make sure we didn't get a HTTP error +assertthat::assert_that(!httr2::resp_is_error(response)) + + +## extract current expectation -------------------------------------------- +expectation <- readr::read_lines( + glue::glue("tests/postman/test-{fn_to_test}.js") +) %>% + grep("pm.expect(jsonData).to.include.members(", + ., + fixed = TRUE, + value = TRUE) %>% + stringr::str_extract_all('(?<=")[^,]*?(?=\\")') %>% + unlist() + + +## extract response -------------------------------------------------------- + +api_response_values <- httr2::resp_body_json(response) %>% unlist() + +# report mismatch --------------------------------------------------------- + +# missing expected project codes: +api_response_values[ + !expectation %in% api_response_values] + +# Values from expectation that are not in the values the api responded +expectation[!expectation %in% api_response_values] + +# Values from the api response that are in the values form the expectation +api_response_values[api_response_values %in% expectation] + +# check if the response is always the same -------------------------------- +library(furrr) +plan("multisession", workers = 10) +furrr::future_map(rep(list(request), 100), ~resp_body_json(req_perform(.x))) %>% + purrr::map(digest::digest) %>% + unlist %>% + unique %>% + length(.) == 1 diff --git a/inst/sql/acoustic_tag_id.sql b/inst/sql/acoustic_tag_id.sql new file mode 100644 index 0000000..5cb0346 --- /dev/null +++ b/inst/sql/acoustic_tag_id.sql @@ -0,0 +1,18 @@ +/* Unified acoustic_tag_id and acoustic_tag_id_alternative */ + SELECT + tag_device_fk, + tag_full_id AS acoustic_tag_id + FROM acoustic.tags + WHERE tag_full_id IS NOT NULL +UNION + SELECT + tag_device_fk, + thelma_converted_code AS acoustic_tag_id + FROM acoustic.tags + WHERE thelma_converted_code IS NOT NULL +UNION + SELECT + device_tag_fk AS tag_device_fk, + sensor_full_id AS acoustic_tag_id + FROM archive.sensor + WHERE sensor_full_id IS NOT NULL diff --git a/inst/sql/dwc_occurrence.sql b/inst/sql/dwc_occurrence.sql new file mode 100644 index 0000000..9cc9237 --- /dev/null +++ b/inst/sql/dwc_occurrence.sql @@ -0,0 +1,252 @@ +/* +Schema: https://rs.gbif.org/core/dwc_occurrence_2022-02-02.xml +*/ + +/* HELPER TABLES */ + +WITH +-- ANIMALS +-- Select animals from animal_project_code +animals AS ( + SELECT * + FROM common.animal_release_limited AS animal + LEFT JOIN common.projects AS animal_project + ON animal.project_fk = animal_project.id + WHERE + LOWER(animal_project.projectcode) = {animal_project_code} +), +-- EVENTS +-- Animals contain multiple events (capture, release, surgery, recapture) as columns +-- Transpose events to rows and exclude those without date information +events AS ( + SELECT * + FROM + ( + SELECT + animal.id_pk AS animal_id_pk, + 'capture' AS protocol, + animal.catched_date_time AS date, + animal.capture_location AS locality, + animal.capture_latitude AS latitude, + animal.capture_longitude AS longitude + FROM animals AS animal + UNION + SELECT + animal.id_pk AS animal_id_pk, + 'surgery' AS protocol, + animal.date_of_surgery AS date, + animal.surgery_location AS locality, + animal.surgery_latitude AS latitude, + animal.surgery_longitude AS longitude + FROM animals AS animal + UNION + SELECT + animal.id_pk AS animal_id_pk, + 'release' AS protocol, + animal.utc_release_date_time AS date, + animal.release_location AS locality, + animal.release_latitude AS latitude, + animal.release_longitude AS longitude + FROM animals AS animal + UNION + SELECT + animal.id_pk AS animal_id_pk, + 'recapture' AS protocol, + animal.recapture_date AS date, + NULL AS locality, + NULL AS latitude, + NULL AS longitude + FROM animals AS animal + ) AS events + WHERE + date IS NOT NULL + ORDER BY + animal_id_pk, + date +), +-- HOURLY DETECTION GROUPS +-- Select detections from animal_project_code +-- Group detections by animal+tag+date+hour combination and get first timestamp and count +detection_groups AS ( + SELECT + det.animal_id_pk || det.tag_serial_number || DATE_TRUNC('hour', det.datetime) AS det_group, + det.animal_id_pk, + det.tag_serial_number, + min(det.datetime) AS datetime, + count(*) AS det_group_count + FROM acoustic.detections_limited AS det + WHERE LOWER(animal_project_code) = {animal_project_code} + GROUP BY + det_group, + det.animal_id_pk, + det.tag_serial_number +), +-- SUBSAMPLED DETECTIONS +-- Join hour_groups with detections to get all fields +-- Exclude animal+tag+timestamp duplicates with DISTINCT ON +detections AS ( + SELECT DISTINCT ON (det_group.det_group) + det_group.det_group_count, + det.* + FROM detection_groups AS det_group + LEFT JOIN ( + SELECT * + FROM acoustic.detections_limited AS det + WHERE LOWER(det.animal_project_code) = {animal_project_code} + ) AS det + -- Joining on these 3 fields is faster than creating det_group again + ON + det_group.animal_id_pk = det.animal_id_pk + AND det_group.tag_serial_number = det.tag_serial_number + AND det_group.datetime = det.datetime +) + +/* DATASET-LEVEL */ + +SELECT + 'Event' AS "type", + {license} AS "license", + {rights_holder} AS "rightsHolder", + {dataset_id} AS "datasetID", + 'VLIZ' AS "institutionCode", + 'ETN' AS "collectionCode", + {dataset_name} AS "datasetName", + * +FROM ( + +/* HUMAN OBSERVATIONS */ + +SELECT +-- RECORD LEVEL + 'HumanObservation' AS "basisOfRecord", + NULL AS "dataGeneralizations", +-- OCCURRENCE + animal.id_pk || '_' || tag_device.serial_number || '_' || event.protocol AS "occurrenceID", -- Same as EventID + CASE + WHEN TRIM(LOWER(animal.sex)) IN ('male', 'm') THEN 'male' + WHEN TRIM(LOWER(animal.sex)) IN ('female', 'f') THEN 'female' + WHEN TRIM(LOWER(animal.sex)) IN ('hermaphrodite') THEN 'hermaphrodite' + WHEN TRIM(LOWER(animal.sex)) IN ('unknown', 'u') THEN 'unknown' + -- Exclude transitional, na, ... + END AS "sex", + CASE + WHEN event.protocol = 'release' THEN -- Only at release, can change over time + CASE + -- Follows http://vocab.nerc.ac.uk/collection/S11/current/, see https://github.com/inbo/etn/issues/262 + WHEN TRIM(LOWER(animal.life_stage)) IN ('juvenile', 'i', 'fii', 'fiii') THEN 'juvenile' + WHEN TRIM(LOWER(animal.life_stage)) IN ('sub-adult', 'fiv', 'fv', 'mii', 'silver') THEN 'sub-adult' + WHEN TRIM(LOWER(animal.life_stage)) IN ('adult', 'mature') THEN 'adult' + WHEN TRIM(LOWER(animal.life_stage)) IN ('immature', 'imature') THEN 'immature' + WHEN TRIM(LOWER(animal.life_stage)) IN ('smolt') THEN 'smolt' + -- Exclude unknown, and other values + END + END AS "lifeStage", + 'present' AS "occurrenceStatus", + animal.id_pk AS "organismID", + animal.animal_nickname AS "organismName", +-- EVENT + animal.id_pk || '_' || tag_device.serial_number || '_' || event.protocol AS "eventID", + animal.id_pk || '_' || tag_device.serial_number AS "parentEventID", + TO_CHAR(event.date, 'YYYY-MM-DD"T"HH24:MI:SS"Z"') AS "eventDate", + event.protocol AS "samplingProtocol", + CASE + WHEN event.protocol = 'capture' THEN + 'Caugth using ' || TRIM(LOWER(animal.capture_method)) + WHEN event.protocol = 'release' THEN + manufacturer.project || ' ' || tag_device.model || ' tag ' || + CASE + WHEN LOWER(animal.implant_type) = 'internal' THEN 'implanted in ' + WHEN LOWER(animal.implant_type) = 'external' THEN 'attached to ' + ELSE 'implanted in or attached to ' -- Includes `Acoutic and pit`, ... + END || + CASE + WHEN TRIM(LOWER(animal.wild_or_hatchery)) IN ('wild', 'w') THEN 'free-ranging animal' + WHEN TRIM(LOWER(animal.wild_or_hatchery)) IN ('hatchery', 'h') THEN 'hatched animal' + ELSE 'likely free-ranging animal' + END + END AS "eventRemarks", +-- LOCATION + NULL AS "locationID", + event.locality AS "locality", + event.latitude AS "decimalLatitude", + event.longitude AS "decimalLongitude", + CASE + WHEN event.latitude IS NOT NULL THEN 'EPSG:4326' + END AS "geodeticDatum", + CASE + -- Assume coordinate precision of 0.001 degree (157m) and recording by GPS (30m) + WHEN event.latitude IS NOT NULL THEN 187 + END AS "coordinateUncertaintyInMeters", +-- TAXON + 'urn:lsid:marinespecies.org:taxname:' || animal.aphia_id AS "scientificNameID", + animal.scientific_name AS "scientificName", + 'Animalia' AS "kingdom" +FROM + events AS event + LEFT JOIN animals AS animal + ON event.animal_id_pk = animal.id_pk + LEFT JOIN common.animal_release_tag_device AS animal_with_tag + ON animal.id_pk = animal_with_tag.animal_release_fk + LEFT JOIN common.tag_device_limited AS tag_device + ON animal_with_tag.tag_device_fk = tag_device.id_pk + LEFT JOIN common.tag_device_type AS tag_type + ON tag_device.tag_device_type_fk = tag_type.id_pk + LEFT JOIN common.manufacturer AS manufacturer + ON tag_device.manufacturer_fk = manufacturer.id_pk + +UNION + +/* DETECTIONS */ + +SELECT +-- RECORD LEVEL + 'MachineObservation' AS "basisOfRecord", + 'subsampled by hour: first of ' || det.det_group_count || ' record(s)' AS "dataGeneralizations", +-- OCCURRENCE + det.id_pk::text AS "occurrenceID", -- Same as EventID + CASE + WHEN TRIM(LOWER(animal.sex)) IN ('male', 'm') THEN 'male' + WHEN TRIM(LOWER(animal.sex)) IN ('female', 'f') THEN 'female' + WHEN TRIM(LOWER(animal.sex)) IN ('hermaphrodite') THEN 'hermaphrodite' + WHEN TRIM(LOWER(animal.sex)) IN ('unknown', 'u') THEN 'unknown' + -- Exclude transitional, na, ... + END AS "sex", + NULL AS "lifeStage", -- Value at release might not apply to all records + 'present' AS "occurrenceStatus", + animal.id_pk AS "organismID", + animal.animal_nickname AS "organismName", +-- EVENT + det.id_pk::text AS "eventID", + animal.id_pk || '_' || det.tag_serial_number AS "parentEventID", + TO_CHAR(det.datetime, 'YYYY-MM-DD"T"HH24:MI:SS"Z"') AS "eventDate", + 'acoustic telemetry' AS "samplingProtocol", + 'detected on receiver ' || det.receiver AS "eventRemarks", +-- LOCATION + det.deployment_station_name AS "locationID", + dep.location_name AS "locality", + det.deployment_latitude AS "decimalLatitude", + det.deployment_longitude AS "decimalLongitude", + CASE + WHEN det.deployment_latitude IS NOT NULL THEN 'EPSG:4326' + END AS "geodeticDatum", + CASE + -- Assume coordinate precision of 0.001 degree (157m), recording by GPS (30m) and detection range of around 800m ≈ 1000m + -- See https://github.com/inbo/etn/issues/256#issuecomment-1332224935 + WHEN det.deployment_latitude IS NOT NULL THEN 1000 + END AS "coordinateUncertaintyInMeters", +-- TAXON + 'urn:lsid:marinespecies.org:taxname:' || animal.aphia_id AS "scientificNameID", + animal.scientific_name AS "scientificName", + 'Animalia' AS "kingdom" +FROM + detections AS det + LEFT JOIN animals AS animal + ON det.animal_id_pk = animal.id_pk + LEFT JOIN acoustic.deployments AS dep + ON det.deployment_fk = dep.id_pk +) AS occurrences + +ORDER BY + "parentEventID", + "eventDate", + "samplingProtocol" -- capture, surgery, release, rerelease diff --git a/inst/sql/project.sql b/inst/sql/project.sql new file mode 100644 index 0000000..05846a8 --- /dev/null +++ b/inst/sql/project.sql @@ -0,0 +1,24 @@ +/* Projects with controlled type */ +SELECT + project.id AS project_id, + project.projectcode AS project_code, + CASE + WHEN project.type = 'animal' THEN 'animal' + WHEN project.type = 'network' AND project.context_type = 'acoustic_telemetry' THEN 'acoustic' + WHEN project.type = 'network' AND project.context_type = 'cpod' THEN 'cpod' + END AS project_type, + project.telemtry_type AS telemetry_type, + project.name AS project_name, + -- ADD coordinating_organization + -- ADD principal_investigator + -- ADD principal_investigator_email + project.startdate AS start_date, + project.enddate AS end_date, + project.latitude AS latitude, + project.longitude AS longitude, + project.moratorium AS moratorium, + project.imis_dataset_id AS imis_dataset_id + -- project.mrgid + -- project.mda_folder_id +FROM + common.projects AS project diff --git a/inst/sql/receiver.sql b/inst/sql/receiver.sql new file mode 100644 index 0000000..51a8209 --- /dev/null +++ b/inst/sql/receiver.sql @@ -0,0 +1,13 @@ +/* Receivers with controlled status */ +SELECT + *, + CASE + WHEN status = 'Active' THEN 'active' + WHEN status = 'Available' OR status = 'available' THEN 'available' + WHEN status = 'Broken' THEN 'broken' + WHEN status = 'Inactive' THEN 'inactive' + WHEN status = 'Lost' THEN 'lost' + WHEN status = 'Returned to manufacturer' THEN 'returned' + END AS controlled_status +FROM + acoustic.receivers_limited diff --git a/inst/sql/tag.sql b/inst/sql/tag.sql new file mode 100644 index 0000000..7a5fc3f --- /dev/null +++ b/inst/sql/tag.sql @@ -0,0 +1,62 @@ +/* Unified tags with controlled tag_type, tag_subtype */ +SELECT + tag_device.serial_number AS tag_serial_number, + CASE + WHEN tag_type.name = 'id-tag' THEN 'acoustic' + WHEN tag_type.name = 'sensor-tag' AND acoustic_tag_id IS NOT NULL THEN 'acoustic-archival' + WHEN tag_type.name = 'sensor-tag' THEN 'archival' + END AS tag_type, + CASE + WHEN tag_subtype.name = 'animal' THEN 'animal' + WHEN tag_subtype.name = 'built-in tag' THEN 'built-in' + WHEN tag_subtype.name = 'range tag' THEN 'range' + WHEN tag_subtype.name = 'sentinel tag' THEN 'sentinel' + END AS tag_subtype, + tag_union.* +FROM + common.tag_device_limited AS tag_device + LEFT JOIN common.tag_device_type AS tag_type + ON tag_device.tag_device_type_fk = tag_type.id_pk + LEFT JOIN acoustic.acoustic_tag_subtype AS tag_subtype + ON tag_device.acoustic_tag_subtype_fk = tag_subtype.id_pk + LEFT JOIN ( + SELECT + 'acoustic:' || acoustic_tag.id_pk AS tag_id, + tag_device_fk, + sensor_type, + tag_full_id AS acoustic_tag_id, + thelma_converted_code, + frequency, + NULL AS resolution, NULL AS unit, NULL AS accurency, NULL AS range_min, NULL AS range_max, + slope, intercept, range, sensor_transmit_ratio, accelerometer_algoritm, accelerometer_samples_per_second, + min_delay, max_delay, power, duration_step1, acceleration_on_sec_step1, + min_delay_step2, max_delay_step2, power_step2, duration_step2, acceleration_on_sec_step2, + min_delay_step3, max_delay_step3, power_step3, duration_step3, acceleration_on_sec_step3, + min_delay_step4, max_delay_step4, power_step4, duration_step4, acceleration_on_sec_step4 + -- serial_number_tbd, type_tbd, model_tbd, owner_pi_tbd, activation_date_tbd, + -- end_date_tbd, estimated_lifetime_tbd, acoustic_tag_type_tbd, manufacturer_fk_tbd, + -- owner_group_fk_tbd, financing_project_fk_tbd, status_tbd + -- id_code, tag_code_space AS protocol, id_pk, file, units, external_id + FROM + acoustic.tags AS acoustic_tag + UNION + SELECT + 'archive:' || archival_tag.id_pk AS tag_id, + device_tag_fk AS tag_device_fk, + sensor_type.description AS sensor_type, + sensor_full_id AS acoustic_tag_id, + NULL AS thelma_converted_code, + frequency, + resolution, unit, accurency, range_min, range_max, + slope, intercept, range, sensor_transmit_ratio, accelerometer_algoritm, accelerometer_samples_per_second, + min_delay, max_delay, power, duration_step1, acceleration_on_sec_step1, + min_delay_step2, max_delay_step2, power_step2, duration_step2, acceleration_on_sec_step2, + min_delay_step3, max_delay_step3, power_step3, duration_step3, acceleration_on_sec_step3, + min_delay_step4, max_delay_step4, power_step4, duration_step4, acceleration_on_sec_step4 + -- id_pk, id_code protocol + FROM + archive.sensor AS archival_tag + LEFT JOIN archive.sensor_type AS sensor_type + ON archival_tag.sensor_type_fk = sensor_type.id_pk + ) AS tag_union + ON tag_device.id_pk = tag_union.tag_device_fk diff --git a/man/check_credentials.Rd b/man/check_credentials.Rd new file mode 100644 index 0000000..72838d0 --- /dev/null +++ b/man/check_credentials.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{check_credentials} +\alias{check_credentials} +\title{Check if the provided credentials are valid.} +\usage{ +check_credentials(credentials) +} +\arguments{ +\item{credentials}{A list or data frame containing the credentials to be checked.} +} +\value{ +TRUE if the credentials are valid, an error otherwise +} +\description{ +This function checks if the provided credentials contain a "username" and "password" field, +and if both fields are of type character. It also verifies that the credentials object has a length of 2. +} +\examples{ +\dontrun{ +credentials <- list(username = "john_doe", password = "password123") +check_credentials(credentials) +#> [1] TRUE +} +} diff --git a/man/get_acoustic_deployments.Rd b/man/get_acoustic_deployments.Rd index d6ba9d2..b62b1d4 100644 --- a/man/get_acoustic_deployments.Rd +++ b/man/get_acoustic_deployments.Rd @@ -39,24 +39,27 @@ Get data for deployments of acoustic receivers, with options to filter results. } \examples{ -# Set default connection variable -con <- connect_to_etn() +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) # Get all acoustic deployments -get_acoustic_deployments(con) +get_acoustic_deployments(credentials) # Get specific acoustic deployment -get_acoustic_deployments(con, deployment_id = 1437) +get_acoustic_deployments(credentials, deployment_id = 1437) # Get acoustic deployments for a specific receiver -get_acoustic_deployments(con, receiver_id = "VR2W-124070") +get_acoustic_deployments(credentials, receiver_id = "VR2W-124070") # Get open acoustic deployments for a specific receiver -get_acoustic_deployments(con, receiver_id = "VR2W-124070", open_only = TRUE) +get_acoustic_deployments(credentials, receiver_id = "VR2W-124070", open_only = TRUE) # Get acoustic deployments for a specific acoustic project -get_acoustic_deployments(con, acoustic_project_code = "demer") +get_acoustic_deployments(credentials, acoustic_project_code = "demer") # Get acoustic deployments for two specific stations -get_acoustic_deployments(con, station_name = c("de-9", "de-10")) +get_acoustic_deployments(credentials, station_name = c("de-9", "de-10")) } diff --git a/man/get_acoustic_projects.Rd b/man/get_acoustic_projects.Rd index f50a12e..43e220d 100644 --- a/man/get_acoustic_projects.Rd +++ b/man/get_acoustic_projects.Rd @@ -24,12 +24,15 @@ also Get data for acoustic projects, with options to filter results. } \examples{ -# Set default connection variable -con <- connect_to_etn() +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) # Get all acoustic projects -get_acoustic_projects(con) +get_acoustic_projects(credentials) # Get a specific acoustic project -get_acoustic_projects(con, acoustic_project_code = "demer") +get_acoustic_projects(credentials, acoustic_project_code = "demer") } diff --git a/man/get_acoustic_receivers.Rd b/man/get_acoustic_receivers.Rd index 98a45f0..f69e123 100644 --- a/man/get_acoustic_receivers.Rd +++ b/man/get_acoustic_receivers.Rd @@ -28,15 +28,18 @@ the group. Get data for acoustic receivers, with options to filter results. } \examples{ -# Set default connection variable -con <- connect_to_etn() +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) # Get all acoustic receivers -get_acoustic_receivers(con) +get_acoustic_receivers(credentials) # Get lost and broken acoustic receivers -get_acoustic_receivers(con, status = c("lost", "broken")) +get_acoustic_receivers(credentials, status = c("lost", "broken")) # Get a specific acoustic receiver -get_acoustic_receivers(con, receiver_id = "VR2W-124070") +get_acoustic_receivers(credentials, receiver_id = "VR2W-124070") } diff --git a/man/get_animal_projects.Rd b/man/get_animal_projects.Rd index c17342a..68933ee 100644 --- a/man/get_animal_projects.Rd +++ b/man/get_animal_projects.Rd @@ -24,12 +24,15 @@ also Get data for animal projects, with options to filter results. } \examples{ -# Set default connection variable -con <- connect_to_etn() +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) # Get all animal projects -get_animal_projects(con) +get_animal_projects(credentials) # Get a specific animal project -get_animal_projects(con, animal_project_code = "2014_demer") +get_animal_projects(credentials, animal_project_code = "2014_demer") } diff --git a/man/get_animals.Rd b/man/get_animals.Rd new file mode 100644 index 0000000..5dd7694 --- /dev/null +++ b/man/get_animals.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_animals.R +\name{get_animals} +\alias{get_animals} +\title{Get animal data} +\usage{ +get_animals( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")), + animal_id = NULL, + tag_serial_number = NULL, + animal_project_code = NULL, + scientific_name = NULL +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} + +\item{animal_id}{Integer (vector). One or more animal identifiers.} + +\item{tag_serial_number}{Character (vector). One or more tag serial numbers.} + +\item{animal_project_code}{Character (vector). One or more animal project +codes. Case-insensitive.} + +\item{scientific_name}{Character (vector). One or more scientific names.} +} +\value{ +A tibble with animals data, sorted by \code{animal_project_code}, +\code{release_date_time} and \code{tag_serial_number}. See also +\href{https://inbo.github.io/etn/articles/etn_fields.html}{field definitions}. +} +\description{ +Get data for animals, with options to filter results. Associated tag +information is available in columns starting with \code{tag} and +\code{acoustic_tag_id}. If multiple tags are associated with a single animal, +the information is comma-separated. +} +\examples{ +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) + +# Get all animals +get_animals(credentials) + +# Get specific animals +get_animals(credentials, animal_id = 305) # Or string value "305" +get_animals(credentials, animal_id = c(304, 305, 2827)) + +# Get animals from specific animal project(s) +get_animals(credentials, animal_project_code = "2014_demer") +get_animals(credentials, animal_project_code = c("2014_demer", "2015_dijle")) + +# Get animals associated with a specific tag_serial_number +get_animals(credentials, tag_serial_number = "1187450") + +# Get animals of specific species (across all projects) +get_animals(credentials, scientific_name = c("Rutilus rutilus", "Silurus glanis")) + +# Get animals of a specific species from a specific project +get_animals(credentials, animal_project_code = "2014_demer", scientific_name = "Rutilus rutilus") +} diff --git a/man/get_cpod_projects.Rd b/man/get_cpod_projects.Rd new file mode 100644 index 0000000..302994f --- /dev/null +++ b/man/get_cpod_projects.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_cpod_projects.R +\name{get_cpod_projects} +\alias{get_cpod_projects} +\title{Get cpod project data} +\usage{ +get_cpod_projects( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")), + cpod_project_code = NULL +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} + +\item{cpod_project_code}{Character (vector). One or more cpod project +codes. Case-insensitive.} +} +\value{ +A tibble with animal project data, sorted by \code{project_code}. See +also +\href{https://inbo.github.io/etn/articles/etn_fields.html}{field definitions}. +} +\description{ +Get data for cpod projects, with options to filter results. +} +\examples{ +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) + +# Get all animal projects +get_cpod_projects(credentials) + +# Get a specific animal project +get_cpod_projects(credentials, cpod_project_code = "cpod-lifewatch") +} diff --git a/man/get_tags.Rd b/man/get_tags.Rd new file mode 100644 index 0000000..df32dfa --- /dev/null +++ b/man/get_tags.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_tags.R +\name{get_tags} +\alias{get_tags} +\title{Get tag data} +\usage{ +get_tags( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")), + tag_type = NULL, + tag_subtype = NULL, + tag_serial_number = NULL, + acoustic_tag_id = NULL +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} + +\item{tag_type}{Character (vector). \code{acoustic} or \code{archival}. Some tags are +both, find those with \code{acoustic-archival}.} + +\item{tag_subtype}{Character (vector). \code{animal}, \verb{built-in}, \code{range} or +\code{sentinel}.} + +\item{tag_serial_number}{Character (vector). One or more tag serial numbers.} + +\item{acoustic_tag_id}{Character (vector). One or more acoustic tag +identifiers, i.e. identifiers found in \code{\link[=get_acoustic_detections]{get_acoustic_detections()}}.} +} +\value{ +A tibble with tags data, sorted by \code{tag_serial_number}. See also +\href{https://inbo.github.io/etn/articles/etn_fields.html}{field definitions}. +Values for \code{owner_organization} and \code{owner_pi} will only be visible if you +are member of the group. +} +\description{ +Get data for tags, with options to filter results. Note that there +can be multiple records (\code{acoustic_tag_id}) per tag device +(\code{tag_serial_number}). +} +\examples{ +# Set credentials +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") + ) + +# Get all tags +get_tags(credentials) + +# Get archival tags, including acoustic-archival +get_tags(credentials, tag_type = c("archival", "acoustic-archival")) + +# Get tags of specific subtype +get_tags(credentials, tag_subtype = c("built-in", "range")) + +# Get specific tags (note that these can return multiple records) +get_tags(credentials, tag_serial_number = "1187450") +get_tags(credentials, acoustic_tag_id = "A69-1601-16130") +get_tags(credentials, acoustic_tag_id = c("A69-1601-16129", "A69-1601-16130")) +} diff --git a/man/list_cpod_project_codes.Rd b/man/list_cpod_project_codes.Rd new file mode 100644 index 0000000..acd1cba --- /dev/null +++ b/man/list_cpod_project_codes.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_cpod_project_codes.R +\name{list_cpod_project_codes} +\alias{list_cpod_project_codes} +\title{List all available cpod project codes} +\usage{ +list_cpod_project_codes( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")) +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} +} +\value{ +A vector of all unique \code{project_code} of \code{type = "cpod"} in +\code{project.sql}. +} +\description{ +List all available cpod project codes +} diff --git a/man/list_tag_serial_numbers.Rd b/man/list_tag_serial_numbers.Rd new file mode 100644 index 0000000..d79b7bd --- /dev/null +++ b/man/list_tag_serial_numbers.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_tag_serial_numbers.R +\name{list_tag_serial_numbers} +\alias{list_tag_serial_numbers} +\title{List all available tag serial numbers} +\usage{ +list_tag_serial_numbers( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")) +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} +} +\value{ +A vector of all unique \code{tag_serial_numbers} present in +\code{common.tag_device}. +} +\description{ +List all available tag serial numbers +} diff --git a/man/write_dwc.Rd b/man/write_dwc.Rd new file mode 100644 index 0000000..4477d64 --- /dev/null +++ b/man/write_dwc.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/write_dwc.R +\name{write_dwc} +\alias{write_dwc} +\title{Transform ETN data to Darwin Core} +\usage{ +write_dwc( + credentials = list(username = Sys.getenv("userid"), password = Sys.getenv("pwd")), + animal_project_code, + rights_holder = NULL, + license = "CC-BY" +) +} +\arguments{ +\item{credentials}{A list with the username and password to connect to the ETN database.} + +\item{animal_project_code}{Animal project code.} + +\item{rights_holder}{Acronym of the organization owning or managing the +rights over the data.} + +\item{license}{Identifier of the license under which the data will be +published. +\itemize{ +\item \href{https://creativecommons.org/licenses/by/4.0/legalcode}{\code{CC-BY}} (default). +\item \href{https://creativecommons.org/publicdomain/zero/1.0/legalcode}{\code{CC0}}. +}} +} +\value{ +list of dataframes +} +\description{ +Transforms and downloads data from a European Tracking Network +\strong{animal project} to \href{https://dwc.tdwg.org/}{Darwin Core}. +The resulting dataframe can be saved as a CSV and be uploaded to an \href{https://www.gbif.org/ipt}{IPT} for publication to OBIS and/or GBIF. +A \code{meta.xml} or \code{eml.xml} file are not created. +} +\section{Transformation details}{ + +Data are transformed into an +\href{https://rs.gbif.org/core/dwc_occurrence_2022-02-02.xml}{Occurrence core}. +This \strong{follows recommendations} discussed and created by Peter Desmet, +Jonas Mortelmans, Jonathan Pye, John Wieczorek and others. +See the \href{https://github.com/inbo/etn/tree/main/inst/sql}{SQL file(s)} +used by this function for details. + +Key features of the Darwin Core transformation: +\itemize{ +\item Deployments (animal+tag associations) are parent events, with capture, +surgery, release, recapture (human observations) and acoustic detections +(machine observations) as child events. +No information about the parent event is provided other than its ID, +meaning that data can be expressed in an Occurrence Core with one row per +observation and \code{parentEventID} shared by all occurrences in a deployment. +\item The release event often contains metadata about the animal (sex, +lifestage, comments) and deployment as a whole. +\item Acoustic detections are downsampled to the \strong{first detection per hour}, +to reduce the size of high-frequency data. +Duplicate detections (same animal, tag and timestamp) are excluded. +It is possible for a deployment to contain no detections, e.g. if the +tag malfunctioned right after deployment. +} +} + diff --git a/tests/postman/test-get_acoustic_deployments.js b/tests/postman/test-get_acoustic_deployments.js new file mode 100644 index 0000000..4564adb --- /dev/null +++ b/tests/postman/test-get_acoustic_deployments.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 10s", function () { + pm.expect(pm.response.responseTime).to.be.below(10000); + }); diff --git a/tests/postman/test-get_acoustic_detections REQUEST.js b/tests/postman/test-get_acoustic_detections REQUEST.js index f95797c..222b91c 100644 --- a/tests/postman/test-get_acoustic_detections REQUEST.js +++ b/tests/postman/test-get_acoustic_detections REQUEST.js @@ -7,6 +7,6 @@ savedData = responsePaths.split("\n")[0]; savedData = savedData.slice(6) pm.collectionVariables.set("savedData", savedData); -pm.test("Response time is less than 3s", function () { - pm.expect(pm.response.responseTime).to.be.below(3000); +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); }); diff --git a/tests/postman/test-get_acoustic_detections demer Rutilus.js b/tests/postman/test-get_acoustic_detections demer Rutilus.js new file mode 100644 index 0000000..2dfa8ed --- /dev/null +++ b/tests/postman/test-get_acoustic_detections demer Rutilus.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); + }); diff --git a/tests/postman/test-get_acoustic_detections.js b/tests/postman/test-get_acoustic_detections.js index fe4b1ec..2dfa8ed 100644 --- a/tests/postman/test-get_acoustic_detections.js +++ b/tests/postman/test-get_acoustic_detections.js @@ -2,6 +2,6 @@ pm.test("Status code is 201", function () { pm.response.to.have.status(201); }); -pm.test("Response time is less than 3s", function () { - pm.expect(pm.response.responseTime).to.be.below(3000); +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); }); diff --git a/tests/postman/test-get_acoustic_projects.js b/tests/postman/test-get_acoustic_projects.js new file mode 100644 index 0000000..4bb210e --- /dev/null +++ b/tests/postman/test-get_acoustic_projects.js @@ -0,0 +1,9 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + + +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); + }); + diff --git a/tests/postman/test-get_acoustic_receivers.js b/tests/postman/test-get_acoustic_receivers.js new file mode 100644 index 0000000..4bb210e --- /dev/null +++ b/tests/postman/test-get_acoustic_receivers.js @@ -0,0 +1,9 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + + +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); + }); + diff --git a/tests/postman/test-get_animal_projects.js b/tests/postman/test-get_animal_projects.js new file mode 100644 index 0000000..2dfa8ed --- /dev/null +++ b/tests/postman/test-get_animal_projects.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); + }); diff --git a/tests/postman/test-get_animals.js b/tests/postman/test-get_animals.js new file mode 100644 index 0000000..4564adb --- /dev/null +++ b/tests/postman/test-get_animals.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 10s", function () { + pm.expect(pm.response.responseTime).to.be.below(10000); + }); diff --git a/tests/postman/test-get_cpod_projects.js b/tests/postman/test-get_cpod_projects.js new file mode 100644 index 0000000..2dfa8ed --- /dev/null +++ b/tests/postman/test-get_cpod_projects.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 6s", function () { + pm.expect(pm.response.responseTime).to.be.below(6000); + }); diff --git a/tests/postman/test-get_tags.js b/tests/postman/test-get_tags.js new file mode 100644 index 0000000..85e21d6 --- /dev/null +++ b/tests/postman/test-get_tags.js @@ -0,0 +1,7 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 7.5s", function () { + pm.expect(pm.response.responseTime).to.be.below(7500); + }); diff --git a/tests/postman/test-list_ functions.js b/tests/postman/test-list_ functions.js new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/tests/postman/test-list_ functions.js @@ -0,0 +1 @@ + diff --git a/tests/postman/test-list_acoustic_project_codes.js b/tests/postman/test-list_acoustic_project_codes.js index 987d8d3..00773fd 100644 --- a/tests/postman/test-list_acoustic_project_codes.js +++ b/tests/postman/test-list_acoustic_project_codes.js @@ -3,11 +3,11 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right acoustic project codes", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values - pm.expect(jsonData).to.include.members(["Mobula_IMAR","Sudle_IMPULS","SVNL-FISH-WATCH","SwanseaBristolArray","2019_Grotenete","Inforbiomares","BOOGMR","ws2","V2LDBS","zeeschelde","LESPUR","ws3","RESBIO","ST08SWE","PTN-Silver-eel-Mondego","Jersey_Coastal","Deveron","KBTN","FISHINTEL","Siganid_Gulf_Aqaba","Danube_Sturgeons","VVV","Walloneel","V2LCASP","BOOPIRATA","2015_PhD_Gutmann_Roberts","OTN_UPLOAD","NTNU-Gaulosen","BTN-IMEDEA","Reelease","AZO","PhD_Marrocco","2017_Fremur","mepnsw","paintedcomber","none","ARAISOLA03","PhysFish","life4fish","GIBRALTRACK_pilot","Artevigo","SEM","V2LGOL","SWIMWAY_2021","PhD_Jeremy_Pastor","PTN/PROTECT2012","MIGRATOEBRE","MOPP","V2LNR","eemskanaal_III"]); + pm.expect(jsonData).to.include.members(["Mobula_IMAR","Sudle_IMPULS","SVNL-FISH-WATCH","SwanseaBristolArray","2019_Grotenete","Inforbiomares","BOOGMR","ws2","zeeschelde","LESPUR","ws3","RESBIO","ST08SWE","PTN-Silver-eel-Mondego","Jersey_Coastal","Deveron","KBTN","FISHINTEL","Siganid_Gulf_Aqaba","Danube_Sturgeons","VVV","Walloneel","V2LCASP","BOOPIRATA","2015_PhD_Gutmann_Roberts","OTN_UPLOAD","NTNU-Gaulosen","BTN-IMEDEA","Reelease","AZO","PhD_Marrocco","2017_Fremur","mepnsw","paintedcomber","none","ARAISOLA03","PhysFish","life4fish","GIBRALTRACK_pilot","Artevigo","SEM","V2LGOL","SWIMWAY_2021","PhD_Jeremy_Pastor","PTN/PROTECT2012","MIGRATOEBRE","MOPP","V2LNR","eemskanaal_III"]); }); pm.test("Response time is less than 3s", function () { diff --git a/tests/postman/test-list_acoustic_tag_ids.js b/tests/postman/test-list_acoustic_tag_ids.js index 9c9df2a..6c9dd86 100644 --- a/tests/postman/test-list_acoustic_tag_ids.js +++ b/tests/postman/test-list_acoustic_tag_ids.js @@ -3,11 +3,11 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right acoustic tag ids", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values - pm.expect(jsonData).to.include.members(["A69-1601-38746","R64K-0691","A69-1303-3966","A69-1602-20523","A69-9001-62964","A69-1602-24986","OPI-748","A69-1602-13430","A69-1105-72","A69-1602-35388","A69-9006-1852","A69-1601-2719","R64K-108","A180-1702-48915","OPI-494","A69-1602-20572","R64K-41143","A69-1303-12067","R64K-9396","A69-1602-13167","A69-1303-9363","A69-1602-37125","A69-1303-4120","A69-1008-210","A69-1303-9509","A69-1303-328","R64K-5037","A69-1303-6997","R64K-0701","R64K-0738","A69-1303-26461","A69-1602-13427","R64K-1094","A69-1602-25135","A69-1303-4095","A69-1602-3082","R64K-4167","A180-1702-51826","A69-1303-4194","A69-1303-0709","A69-1303-33684","A69-1303-4591","A69-1303-6478","A69-9007-2438","OPI-640","A69-1601-9609","A69-1303-12644","A69-1604-3342","A69-9006-4742","A69-1602-13493"]); + pm.expect(jsonData).to.include.members(["A69-1008-210","A69-1105-72","A69-1303-328","A69-1303-0709","A69-1303-3966","A69-1303-4095","A69-1303-4120","A69-1303-4194","A69-1303-4591","A69-1303-6478","A69-1303-6997","A69-1303-9363","A69-1303-9509","A69-1303-12067","A69-1303-12644","A69-1303-26461","A69-1303-33684","A69-1601-2719","A69-1601-9609","A69-1601-38746","A69-1602-3082","A69-1602-13167","A69-1602-13427","A69-1602-13430","A69-1602-13493","A69-1602-20523","A69-1602-20572","A69-1602-24986","A69-1602-25135","A69-9001-62964","A69-9006-1852","A69-9006-4742","A69-9007-2438","A180-1702-48915","A180-1702-51826","OPI-494","OPI-640","OPI-748","R64K-108","R64K-0691","R64K-0701","R64K-0738","R64K-1094","R64K-4167","R64K-5037","R64K-9396","R64K-41143"]); }); pm.test("Response time is less than 3s", function () { diff --git a/tests/postman/test-list_animal_project_codes.js b/tests/postman/test-list_animal_project_codes.js index 51e32f5..f0feb85 100644 --- a/tests/postman/test-list_animal_project_codes.js +++ b/tests/postman/test-list_animal_project_codes.js @@ -3,14 +3,14 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right animal project codes", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values - pm.expect(jsonData).to.include.members(["GIBRALTRACK_pilot","FISHINTEL","LamYorOus18-20","SMUCC","2016_Diaccia_Botrona","2015_fint","2013_albertkanaal","Rijke_Noordzee","mepnsw","VMLSOCBS","ASMOP2","Top-Predator","2014_Nene","Noordzeekanaal","2015_phd_verhelst_eel","CESB","Fish_Mig_Wad_Sea","2015_phd_verhelst_cod","MIGRATOEBRE","RNP","SARTELZINGARO","VVV","SVNL-WS","MBA_Massmo","Skye","FISHOWF","RAS","MICHIMIT","V2LNR","PTN/PROTECT2012/whiteseabream","PLASTIBE","2015_Albertkanaal_VPS_Ham","SU.MO.ELASMO.Adriatic","2021_Gudena","BFTDK","OP-Test","amsterdam","BTN-DeepWater-IMEDEA","KBTN_FISH","2012_leopoldkanaal","SEMP","BlueCrab2022Algarve","Eel-source-to-sea","SwanseaSeaTroutAdult","kornwerderzand","2015_dijle","codnoise","CONNECT-MED","FISHGAL","2013_Foyle"]); + pm.expect(jsonData).to.include.members(["GIBRALTRACK_pilot","FISHINTEL","LamYorOus18-20","SMUCC","2016_Diaccia_Botrona","2015_fint","2013_albertkanaal","Rijke_Noordzee","mepnsw","VMLSOCBS","ASMOP2","2014_Nene","Noordzeekanaal","2015_phd_verhelst_eel","CESB","Fish_Mig_Wad_Sea","2015_phd_verhelst_cod","MIGRATOEBRE","RNP","SARTELZINGARO","VVV","SVNL-WS","MBA_Massmo","Skye","FISHOWF","RAS","MICHIMIT","V2LNR","PTN/PROTECT2012/whiteseabream","PLASTIBE","2015_Albertkanaal_VPS_Ham","SU.MO.ELASMO.Adriatic","2021_Gudena","BFTDK","OP-Test","amsterdam","BTN-DeepWater-IMEDEA","KBTN_FISH","2012_leopoldkanaal","SEMP","BlueCrab2022Algarve","Eel-source-to-sea","SwanseaSeaTroutAdult","kornwerderzand","2015_dijle","codnoise","CONNECT-MED","FISHGAL","2013_Foyle"]); }); -pm.test("Response time is less than 3s", function () { - pm.expect(pm.response.responseTime).to.be.below(3000); +pm.test("Response time is less than 5s", function () { + pm.expect(pm.response.responseTime).to.be.below(5000); }); diff --git a/tests/postman/test-list_cpod_project_codes.js b/tests/postman/test-list_cpod_project_codes.js new file mode 100644 index 0000000..c915de0 --- /dev/null +++ b/tests/postman/test-list_cpod_project_codes.js @@ -0,0 +1,29 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 3s", function () { + pm.expect(pm.response.responseTime).to.be.below(3000); + }); + +const jsonData = pm.response.json(); +pm.test("returns the right cpod project codes", () => { + //array is not empty + pm.expect(jsonData).to.not.be.empty; + //ids include number of known values + pm.expect(jsonData).to.include.members([ + "Apelafico_acoustics", + "Apelafico_underwater", + "cpod-lifewatch", + "cpod-od-natuur", + "PAM-Borssele", + "PelFish", + "PhD_Parcerisas", + "SEAWave", + "SMGMIT", + "STRAITS_PAM", + "VLIZ-MRC-AMUC-001", + "VLIZ-MRC-AMUC-002", + "WaveHub" +]); + }); diff --git a/tests/postman/test-list_deployment_ids.js b/tests/postman/test-list_deployment_ids.js new file mode 100644 index 0000000..5c81024 --- /dev/null +++ b/tests/postman/test-list_deployment_ids.js @@ -0,0 +1,15 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 3s", function () { + pm.expect(pm.response.responseTime).to.be.below(3000); + }); + +const jsonData = pm.response.json(); +pm.test("returns the right deployment ids", () => { + //array is not empty + pm.expect(jsonData).to.not.be.empty; + //ids include number of known values + pm.expect(jsonData).to.include.members(["35375", "33373", "14999", "38605", "15228", "59021", "48695", "39014", "48628", "1489", "39591", "29737", "1553", "49270", "39151"]); + }); diff --git a/tests/postman/test-list_receiver_ids.js b/tests/postman/test-list_receiver_ids.js index f3b1cc8..2ebdccd 100644 --- a/tests/postman/test-list_receiver_ids.js +++ b/tests/postman/test-list_receiver_ids.js @@ -3,11 +3,11 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right receiver ids", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values - pm.expect(jsonData).to.include.members(["TBR700-001198","VR2W-113584","VR2TX-481233","VR2W-134861","VR2W-122356","VR2TX-480264","VR2W-126317","VR2AR-547510","VR2W-125699","VR2W-134234","HR2-180K-100-LI-461548","VR2TX-481427","VR2TX-482997","TBR700-33","VR2TX-482289","VR2TX-482923","VR2W-120630","VR2W-135891","VR2TX-482914","TBR700R-1441","VR2TX-480410","VR2W-112220","VR2W-125463","VR2W-135353","WHS 3250D-MAP6001500101","VR2W-136585","VR2W-134016","VR2TX-486358","VR2W-127720","VR2-5528","VR2TX-482938","VR2-7333c","VR2-5531","VR2W-130679","VR2W-130998","VR2AR-547670","VR2W-127562","VR2W-112364","VR2W-120448","VR2W-135804","VR2W-137075","TBR700L-1360","VR2AR-551407","VR2TX-482979","VR2W-134532","VR2W-115447","VR2W-135649","VR2W-134524","VR2W-126196","VR2W-134359"]); + pm.expect(jsonData).to.include.members(["HR2-180K-100-LI-461548","TBR700-33","TBR700-001198","TBR700L-1360","TBR700R-1441","VR2-5528","VR2-5531","VR2-7333c","VR2AR-547670","VR2AR-551407","VR2TX-480264","VR2TX-480410","VR2TX-481233","VR2TX-481427","VR2TX-482289","VR2TX-482914","VR2TX-482923","VR2TX-482938","VR2TX-482979","VR2TX-482997","VR2TX-486358","VR2W-112220","VR2W-112364","VR2W-115447","VR2W-120448","VR2W-120630","VR2W-122356","VR2W-125463","VR2W-125699","VR2W-126196","VR2W-126317","VR2W-127562","VR2W-127720","VR2W-130679","VR2W-130998","VR2W-134016","VR2W-134234","VR2W-134359","VR2W-134524","VR2W-134532","VR2W-134861","VR2W-135353","VR2W-135649","VR2W-135804","VR2W-135891","VR2W-136585","VR2W-137075","WHS 3250D-MAP6001500101"]); }); pm.test("Response time is less than 3s", function () { diff --git a/tests/postman/test-list_scientific_names.js b/tests/postman/test-list_scientific_names.js index ed2ec0f..e246bd2 100644 --- a/tests/postman/test-list_scientific_names.js +++ b/tests/postman/test-list_scientific_names.js @@ -3,7 +3,7 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right scientific names", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values diff --git a/tests/postman/test-list_station_names.js b/tests/postman/test-list_station_names.js index df0cc15..de4f70d 100644 --- a/tests/postman/test-list_station_names.js +++ b/tests/postman/test-list_station_names.js @@ -3,11 +3,11 @@ pm.test("Status code is 201", function () { }); const jsonData = pm.response.json(); -pm.test("returns the right animal ids", () => { +pm.test("returns the right station names", () => { //array is not empty pm.expect(jsonData).to.not.be.empty; //ids include number of known values - pm.expect(jsonData).to.include.members(["GARD5","ABDN Bay-4","PLANIER_EST","IMFSTP019","R1-0m-Sonotronics","101 CORVO","F36","84-PONTA-CEDROS-FUNDO","bpns-HD17","C2","OM 3","LOM28","D1.11","SN_E12_C","I27","2021-O53","O32","Vossemeer","PTN_#78","LOM 37","IMFSTP035","CoastNet_PTN_Tejo_071","Pedra do Leao","NB028","ngOudm","gn-14","VB14","F22","SB45","Ler15","IM11","HVALPSUND5","FSUS","APPA E","L5","PREVOST_MER","Sound6","FRASERBURGH12","r02","s-12","Nene25","76 127 w ","gm_2017_13","Rt2","SB14","113582","R 15","NB014","MR 23","G4"]); + pm.expect(jsonData).to.include.members(["76 127 w ","84-PONTA-CEDROS-FUNDO","101 CORVO","ABDN Bay-4","APPA E","bpns-HD17","C2","CoastNet_PTN_Tejo_071","D1.11","F22","F36","FSUS","G4","GARD5","gm_2017_13","gn-14","HVALPSUND5","I27","IMFSTP019","IMFSTP035","L5","Ler15","LOM28","MR 23","NB014","NB028","Nene25","ngOudm","O32","OM 3","Pedra do Leao","PLANIER_EST","PREVOST_MER","PTN_#78","R 15","r02","Rt2","s-12","SB14","SN_E12_C","Sound6","VB14","Vossemeer"]); }); pm.test("Response time is less than 3s", function () { diff --git a/tests/postman/test-list_tag_serial_numbers.js b/tests/postman/test-list_tag_serial_numbers.js new file mode 100644 index 0000000..1243638 --- /dev/null +++ b/tests/postman/test-list_tag_serial_numbers.js @@ -0,0 +1,16 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 3s", function () { + pm.expect(pm.response.responseTime).to.be.below(3000); + }); + +const jsonData = pm.response.json(); +pm.test("returns the right tag serial numbers", () => { + //array is not empty + pm.expect(jsonData).to.not.be.empty; + //ids include number of known values + pm.expect(jsonData).to.include.members(["04C6", "1734024", "20169187","A69-1602-30050", "1290765", "21293183", "JS031725", "A17665" +]); + }); diff --git a/tests/postman/test-write_dwc.js b/tests/postman/test-write_dwc.js new file mode 100644 index 0000000..9ad497c --- /dev/null +++ b/tests/postman/test-write_dwc.js @@ -0,0 +1,15 @@ +pm.test("Status code is 201", function () { + pm.response.to.have.status(201); + }); + +pm.test("Response time is less than 30s", function () { + pm.expect(pm.response.responseTime).to.be.below(30000); + }); + +pm.test("Response body contains the expected fields for the created record", function () { + const responseData = pm.response.json(); + + pm.expect(responseData).to.be.an('object'); + pm.expect(responseData).to.have.property('dwc_occurrence'); +}); + diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..622aa33 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/tests.html +# * https://testthat.r-lib.org/reference/test_package.html#special-files + +library(testthat) +library(etnservice) + +test_check("etnservice") diff --git a/tests/testthat/test-connect_to_etn.R b/tests/testthat/test-connect_to_etn.R index bffef61..3bb4558 100644 --- a/tests/testthat/test-connect_to_etn.R +++ b/tests/testthat/test-connect_to_etn.R @@ -6,4 +6,16 @@ test_that("connect_to_etn() allows to create a connection with passed credential connection <- connect_to_etn(credentials$username, credentials$password) expect_true(check_connection(connection)) expect_true(isClass(connection, "PostgreSQL")) + DBI::dbDisconnect(connection) +}) + +test_that("connect_to_etn() returns a clear error when connecting to db fails",{ + expect_error(connect_to_etn("only one argument"), + regexp = "Failed to connect to the database.") + expect_error(connect_to_etn(password = "missing username"), + regexp = "Failed to connect to the database.") + expect_error(connect_to_etn(username = "missing password"), + regexp = "Failed to connect to the database.") + expect_error(connect_to_etn(username = "", password = ""), + regexp = "Failed to connect to the database.") }) diff --git a/tests/testthat/test-get_acoustic_deployments.R b/tests/testthat/test-get_acoustic_deployments.R index 81a7552..f181c10 100644 --- a/tests/testthat/test-get_acoustic_deployments.R +++ b/tests/testthat/test-get_acoustic_deployments.R @@ -6,7 +6,13 @@ credentials <- list( test_that("get_acoustic_deployments() returns error for incorrect connection", { expect_error( get_acoustic_deployments(credentials = "not_a_credentials"), - "Not a credentials object to database." + "The credentials need to contain a 'username' field", + fixed = TRUE + ) + expect_error( + get_acoustic_deployments(credentials = list(username = "not a username", + password = "the wrong password")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_acoustic_detections.R b/tests/testthat/test-get_acoustic_detections.R index ab1b37a..450fd64 100644 --- a/tests/testthat/test-get_acoustic_detections.R +++ b/tests/testthat/test-get_acoustic_detections.R @@ -6,17 +6,33 @@ credentials <- list( test_that("get_acoustic_detections() returns error for incorrect connection", { expect_error( get_acoustic_detections(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_acoustic_detections(credentials = list(username = "username")), + "The credentials need to contain a 'password' field." + ) + expect_error( + get_acoustic_detections(credentials = list(unexpected_field = 4, + username = "username", + password = "not a password")), + "The credentials object should have a length of 2." + ) + expect_error( + get_acoustic_detections(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) -test_that("get_acoustic_detections() returns a tibble", { + test_that("get_acoustic_detections() returns a tibble", { df <- get_acoustic_detections(credentials, limit = TRUE) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") }) test_that("get_acoustic_detections() returns unique detection_id", { + skip("duplicate detection ids: https://github.com/inbo/etn/issues/283") df <- get_acoustic_detections(credentials, limit = TRUE) expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) }) @@ -281,19 +297,20 @@ test_that("get_acoustic_detections() returns acoustic and acoustic-archival tags }) # TODO: re-enable after https://github.com/inbo/etn/issues/252 -# test_that("get_acoustic_detections() returns detections from acoustic_tag_id_alternative", { -# # The following acoustic_tag_ids only occur as acoustic_tag_id_alternative -# -# # A69-1105-26 (tag_serial_number = 1734026) is associated with animal -# # - 5902 (2017_Fremur) from 2017-12-01 00:00 to open -# # Almost all its detections are from after the release date -# expect_gt(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-26")), 0) -# -# # A69-1105-155 (tag_serial_number = 1712155) is associated with animal -# # - 4140 (OTN-Skjerstadfjorden) from 2017-05-31 01:00 to open -# # All detections are from before the release date, so it should return 0 -# expect_equal(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-155")), 0) -# }) +test_that("get_acoustic_detections() returns detections from acoustic_tag_id_alternative", { + skip("TODO: re-enable after https://github.com/inbo/etn/issues/252") + # The following acoustic_tag_ids only occur as acoustic_tag_id_alternative + + # A69-1105-26 (tag_serial_number = 1734026) is associated with animal + # - 5902 (2017_Fremur) from 2017-12-01 00:00 to open + # Almost all its detections are from after the release date + expect_gt(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-26")), 0) + + # A69-1105-155 (tag_serial_number = 1712155) is associated with animal + # - 4140 (OTN-Skjerstadfjorden) from 2017-05-31 01:00 to open + # All detections are from before the release date, so it should return 0 + expect_equal(nrow(get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-155")), 0) +}) test_that("get_acoustic_detections() does not return duplicate detections across acoustic_id and acoustic_id_alternative", { # A69-1105-100 is used as acoustic_tag_id once and acoustic_tag_id_alternative twice: @@ -304,7 +321,8 @@ test_that("get_acoustic_detections() does not return duplicate detections across # Expect no duplicates df <- get_acoustic_detections(credentials, acoustic_tag_id = "A69-1105-100") - # expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) # TODO: https://github.com/inbo/etn/issues/216 + skip("TODO: https://github.com/inbo/etn/issues/216") + expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) # TODO: https://github.com/inbo/etn/issues/216 }) test_that("get_acoustic_detections() does not return duplicate detections when tags are reused", { diff --git a/tests/testthat/test-get_acoustic_projects.R b/tests/testthat/test-get_acoustic_projects.R index b850c58..32a34e9 100644 --- a/tests/testthat/test-get_acoustic_projects.R +++ b/tests/testthat/test-get_acoustic_projects.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_acoustic_projects() returns error for incorrect connection", { expect_error( get_acoustic_projects(credentials = "not_a_credentials"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_acoustic_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_acoustic_receivers.R b/tests/testthat/test-get_acoustic_receivers.R index 5c13f8b..847698b 100644 --- a/tests/testthat/test-get_acoustic_receivers.R +++ b/tests/testthat/test-get_acoustic_receivers.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_acoustic_receivers() returns error for incorrect credentials", { expect_error( get_acoustic_receivers(credentials = "not_a_credentials"), - "Not a connection object to database." + "Failed to connect to the database." + ) + expect_error( + get_acoustic_receivers(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_animal_projects.R b/tests/testthat/test-get_animal_projects.R index 71f0dbf..2cffc64 100644 --- a/tests/testthat/test-get_animal_projects.R +++ b/tests/testthat/test-get_animal_projects.R @@ -6,7 +6,12 @@ credentials <- list( test_that("get_animal_projects() returns error for incorrect connection", { expect_error( get_animal_projects(credentials = "not_a_connection"), - "Not a connection object to database." + "The credentials need to contain a 'username' field." + ) + expect_error( + get_animal_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." ) }) diff --git a/tests/testthat/test-get_animals.R b/tests/testthat/test-get_animals.R new file mode 100644 index 0000000..bc000e7 --- /dev/null +++ b/tests/testthat/test-get_animals.R @@ -0,0 +1,259 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("get_animals() returns error for incorrect connection", { + expect_error( + get_animals(credentials = "not_a_connection"), + "The credentials need to contain a 'username' field." + ) + expect_error( + get_animals(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." + ) +}) + +test_that("get_animals() returns a tibble", { + df <- get_animals(credentials) + expect_s3_class(df, "data.frame") + expect_s3_class(df, "tbl") +}) + +test_that("get_animals() returns unique animal_id", { + df <- get_animals(credentials) + expect_equal(nrow(df), nrow(df %>% distinct(animal_id))) +}) + +test_that("get_animals() returns the expected columns", { + df <- get_animals(credentials) + expected_col_names <- c( + "animal_id", + "animal_project_code", + "tag_serial_number", + "tag_type", + "tag_subtype", + "acoustic_tag_id", + "acoustic_tag_id_alternative", + "scientific_name", + "common_name", + "aphia_id", + "animal_label", + "animal_nickname", + "tagger", + "capture_date_time", + "capture_location", + "capture_latitude", + "capture_longitude", + "capture_method", + "capture_depth", + "capture_temperature_change", + "release_date_time", + "release_location", + "release_latitude", + "release_longitude", + "recapture_date_time", + "length1_type", + "length1", + "length1_unit", + "length2_type", + "length2", + "length2_unit", + "length3_type", + "length3", + "length3_unit", + "length4_type", + "length4", + "length4_unit", + "weight", + "weight_unit", + "age", + "age_unit", + "sex", + "life_stage", + "wild_or_hatchery", + "stock", + "surgery_date_time", + "surgery_location", + "surgery_latitude", + "surgery_longitude", + "treatment_type", + "tagging_type", + "tagging_methodology", + "dna_sample", + "sedative", + "sedative_concentration", + "anaesthetic", + "buffer", + "anaesthetic_concentration", + "buffer_concentration_in_anaesthetic", + "anaesthetic_concentration_in_recirculation", + "buffer_concentration_in_recirculation", + "dissolved_oxygen", + "pre_surgery_holding_period", + "post_surgery_holding_period", + "holding_temperature", + "comments" + ) + expect_equal(names(df), expected_col_names) +}) + +test_that("get_animals() allows selecting on animal_id", { + # Errors + expect_error(get_animals(credentials, animal_id = 0)) # Not an existing value + expect_error(get_animals(credentials, animal_id = c(305, 0))) + expect_error(get_animals(credentials, animal_id = 20.2)) # Not an integer + + # Select single value + single_select <- 305 + single_select_df <- get_animals(credentials, animal_id = single_select) + expect_equal( + single_select_df %>% distinct(animal_id) %>% pull(), + c(single_select) + ) + expect_equal(nrow(single_select_df), 1) + + # Select multiple values + multi_select <- c(304, "305") # Characters are allowed + multi_select_df <- get_animals(credentials, animal_id = multi_select) + expect_equal( + multi_select_df %>% distinct(animal_id) %>% pull() %>% sort(), + c(as.integer(multi_select)) # Output will be all integer + ) + expect_equal(nrow(multi_select_df), 2) +}) + +test_that("get_animals() allows selecting on animal_project_code", { + # Errors + expect_error(get_animals(credentials, animal_project_code = "not_a_project")) + expect_error(get_animals(credentials, animal_project_code = c("2014_demer", "not_a_project"))) + + # Select single value + single_select <- "2014_demer" + single_select_df <- get_animals(credentials, animal_project_code = single_select) + expect_equal( + single_select_df %>% distinct(animal_project_code) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Selection is case insensitive + expect_equal( + get_animals(credentials, animal_project_code = "2014_demer"), + get_animals(credentials, animal_project_code = "2014_DEMER") + ) + + # Select multiple values + multi_select <- c("2014_demer", "2015_dijle") + multi_select_df <- get_animals(credentials, animal_project_code = multi_select) + expect_equal( + multi_select_df %>% distinct(animal_project_code) %>% pull() %>% sort(), + c(multi_select) + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) + +test_that("get_animals() allows selecting on tag_serial_number", { + # Errors + expect_error(get_animals(credentials, tag_serial_number = "0")) # Not an existing value + expect_error(get_animals(credentials, tag_serial_number = c("1187450", "0"))) + + # Select single value + single_select <- "1187450" # From 2014_demer + single_select_df <- get_animals(credentials, tag_serial_number = single_select) + expect_equal( + single_select_df %>% distinct(tag_serial_number) %>% pull(), + c(single_select) + ) + expect_equal(nrow(single_select_df), 1) + # Note that not all tag_serial_number return a single row, e.g. "1119796" + + # Select multiple values + multi_select <- c(1187449, "1187450") # Integers are allowed + multi_select_df <- get_animals(credentials, tag_serial_number = multi_select) + expect_equal( + multi_select_df %>% distinct(tag_serial_number) %>% pull() %>% sort(), + c(as.character(multi_select)) # Output will be all character + ) + expect_equal(nrow(multi_select_df), 2) +}) + +test_that("get_animals() allows selecting on scientific_name", { + # Errors + expect_error(get_animals(credentials, scientific_name = "not_a_sciname")) + expect_error(get_animals(credentials, scientific_name = "rutilus rutilus")) # Case sensitive + expect_error(get_animals(credentials, scientific_name = c("Rutilus rutilus", "not_a_sciname"))) + + # Select single value + single_select <- "Rutilus rutilus" + single_select_df <- get_animals(credentials, scientific_name = single_select) + expect_equal( + single_select_df %>% distinct(scientific_name) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Select multiple values + multi_select <- c("Rutilus rutilus", "Silurus glanis") + multi_select_df <- get_animals(credentials, scientific_name = multi_select) + expect_equal( + multi_select_df %>% distinct(scientific_name) %>% pull() %>% sort(), + c(multi_select) + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) + +test_that("get_animals() allows selecting on multiple parameters", { + multiple_parameters_df <- get_animals( + credentials, + animal_project_code = "2014_demer", + scientific_name = "Rutilus rutilus" + ) + # There are 2 Rutilus rutilus records in 2014_demer + expect_equal(nrow(multiple_parameters_df), 2) +}) + +test_that("get_animals() collapses multiple associated tags to one row", { + # Animal 5841 (project SPAWNSEIS) has 2 associated tags (1280688,1280688) + animal_two_tags_df <- get_animals(credentials, animal_id = 5841) + + expect_equal(nrow(animal_two_tags_df), 1) # Rows should be collapsed + + # Columns starting with tag_ and acoustic_tag_id are collapsed with comma + tag_col_names <- c( + "tag_serial_number", + "tag_type", + "acoustic_tag_id", + "acoustic_tag_id_alternative", + "tagger", + "tagging_type", + "tagging_methodology" + ) + has_comma <- apply( + animal_two_tags_df %>% dplyr::select(dplyr::all_of(tag_col_names)), + MARGIN = 2, + function(x) grepl(pattern = ",", x = x) + ) + expect_true(all(has_comma)) +}) + +test_that("get_animals() returns correct tag_type and tag_subtype", { + df <- get_animals(credentials) + df <- df %>% filter(!stringr::str_detect(tag_type, ",")) # Remove multiple associated tags + df <- df %>% filter(tag_type != "") # TODO: remove after https://github.com/inbo/etn/issues/249 + expect_equal( + df %>% distinct(tag_type) %>% pull() %>% sort(), + c("acoustic", "acoustic-archival") # "archival" currently not in data + ) + expect_equal( + df %>% distinct(tag_subtype) %>% pull() %>% sort(), + c("animal", "built-in", "range", "sentinel") + ) +}) + +test_that("get_animals() does not return animals without tags", { + # All animals should be related with a tag + df <- get_animals(credentials) + expect_equal(df %>% filter(is.na(tag_serial_number)) %>% nrow(), 0) +}) diff --git a/tests/testthat/test-get_cpod_projects.R b/tests/testthat/test-get_cpod_projects.R new file mode 100644 index 0000000..a9e2d0b --- /dev/null +++ b/tests/testthat/test-get_cpod_projects.R @@ -0,0 +1,85 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("get_cpod_projects() returns error for incorrect connection", { + expect_error( + get_cpod_projects(credentials = "not_a_connection"), + "The credentials need to contain a 'username' field." + ) + expect_error( + get_cpod_projects(credentials = list(username = "not a username", + password = "the wrong pwd")), + "Failed to connect to the database." + ) +}) + +test_that("get_cpod_projects() returns a tibble", { + df <- get_cpod_projects(credentials) + expect_s3_class(df, "data.frame") + expect_s3_class(df, "tbl") +}) + +test_that("get_cpod_projects() returns unique project_id", { + df <- get_cpod_projects(credentials) + expect_equal(nrow(df), nrow(df %>% distinct(project_id))) +}) + +test_that("get_cpod_projects() returns the expected columns", { + df <- get_cpod_projects(credentials) + expected_col_names <- c( + "project_id", + "project_code", + "project_type", + "telemetry_type", + "project_name", + # "coordinating_organization", + # "principal_investigator", + # "principal_investigator_email", + "start_date", + "end_date", + "latitude", + "longitude", + "moratorium", + "imis_dataset_id" + ) + expect_equal(names(df), expected_col_names) +}) + +test_that("get_cpod_projects() allows selecting on cpod_project_code", { + # Errors + expect_error(get_cpod_projects(credentials, cpod_project_code = "not_a_project")) + expect_error(get_cpod_projects(credentials, cpod_project_code = c("cpod-lifewatch", "not_a_project"))) + + # Select single value + single_select <- "cpod-lifewatch" + single_select_df <- get_cpod_projects(credentials, cpod_project_code = single_select) + expect_equal( + single_select_df %>% distinct(project_code) %>% pull(), + c(single_select) + ) + expect_equal(nrow(single_select_df), 1) + + # Selection is case insensitive + expect_equal( + get_cpod_projects(credentials, cpod_project_code = "cpod-lifewatch"), + get_cpod_projects(credentials, cpod_project_code = "CPOD-LIFEWATCH") + ) + + # Select multiple values + multi_select <- c("cpod-lifewatch", "cpod-od-natuur") + multi_select_df <- get_cpod_projects(credentials, cpod_project_code = multi_select) + expect_equal( + multi_select_df %>% distinct(project_code) %>% pull() %>% sort(), + c(multi_select) + ) + expect_equal(nrow(multi_select_df), 2) +}) + +test_that("get_cpod_projects() returns projects of type 'cpod'", { + expect_equal( + get_cpod_projects(credentials) %>% distinct(project_type) %>% pull(), + "cpod" + ) +}) diff --git a/tests/testthat/test-get_tags.R b/tests/testthat/test-get_tags.R new file mode 100644 index 0000000..1a1bced --- /dev/null +++ b/tests/testthat/test-get_tags.R @@ -0,0 +1,234 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("get_tags() returns error for incorrect connection", { + expect_error( + get_tags(credentials = list(username = "not a username", + password = "not a password")), + "Failed to connect to the database." + ) +}) + +test_that("get_tags() returns a tibble", { + df <- get_tags(credentials) + expect_s3_class(df, "data.frame") + expect_s3_class(df, "tbl") +}) + +test_that("get_tags() returns the expected columns", { + df <- get_tags(credentials) + expected_col_names <- c( + "tag_serial_number", + "tag_type", + "tag_subtype", + "sensor_type", + "acoustic_tag_id", + "acoustic_tag_id_alternative", + "manufacturer", + "model", + "frequency", + "status", + "activation_date", + "battery_estimated_life", + "battery_estimated_end_date", + "length", + "diameter", + "weight", + "floating", + "archive_memory", + "sensor_slope", + "sensor_intercept", + "sensor_range", + "sensor_range_min", + "sensor_range_max", + "sensor_resolution", + "sensor_unit", + "sensor_accuracy", + "sensor_transmit_ratio", + "accelerometer_algorithm", + "accelerometer_samples_per_second", + "owner_organization", + "owner_pi", + "financing_project", + "step1_min_delay", + "step1_max_delay", + "step1_power", + "step1_duration", + "step1_acceleration_duration", + "step2_min_delay", + "step2_max_delay", + "step2_power", + "step2_duration", + "step2_acceleration_duration", + "step3_min_delay", + "step3_max_delay", + "step3_power", + "step3_duration", + "step3_acceleration_duration", + "step4_min_delay", + "step4_max_delay", + "step4_power", + "step4_duration", + "step4_acceleration_duration", + "tag_id", + "tag_device_id" + ) + expect_equal(names(df), expected_col_names) +}) + +test_that("get_tags() allows selecting on tag_serial_number", { + # Errors + expect_error(get_tags(credentials, tag_serial_number = "0")) # Not an existing value + expect_error(get_tags(credentials, tag_serial_number = c("1187450", "0"))) + + # Select single value + single_select <- "1187450" # From 2014_demer + single_select_df <- get_tags(credentials, tag_serial_number = single_select) + expect_equal( + single_select_df %>% distinct(tag_serial_number) %>% pull(), + c(single_select) + ) + expect_equal(nrow(single_select_df), 1) + # Note that not all tag_serial_number return a single row, see further test + + # Select multiple values + multi_select <- c(1187449, "1187450") # Integers are allowed + multi_select_df <- get_tags(credentials, tag_serial_number = multi_select) + expect_equal( + multi_select_df %>% distinct(tag_serial_number) %>% pull() %>% sort(), + c(as.character(multi_select)) # Output will be all character + ) + expect_equal(nrow(multi_select_df), 2) +}) + +test_that("get_tags() allows selecting on tag_type", { + # Errors + expect_error(get_tags(credentials, tag_type = "not_a_tag_type")) + expect_error(get_tags(credentials, tag_type = c("archival", "not_a_tag_type"))) + + # Select single value + single_select <- "archival" + single_select_df <- get_tags(credentials, tag_type = single_select) + expect_equal( + single_select_df %>% distinct(tag_type) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Select multiple values + multi_select <- c("acoustic-archival", "archival") + multi_select_df <- get_tags(credentials, tag_type = multi_select) + expect_equal( + multi_select_df %>% distinct(tag_type) %>% pull() %>% sort(), + c(multi_select) + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) + +test_that("get_tags() allows selecting on tag_subtype", { + # Errors + expect_error(get_tags(credentials, tag_subtype = "not_a_tag_subtype")) + expect_error(get_tags(credentials, tag_subtype = c("archival", "not_a_tag_subtype"))) + + # Select single value + single_select <- "built-in" + single_select_df <- get_tags(credentials, tag_subtype = single_select) + expect_equal( + single_select_df %>% distinct(tag_subtype) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Select multiple values + multi_select <- c("built-in", "range") + multi_select_df <- get_tags(credentials, tag_subtype = multi_select) + expect_equal( + multi_select_df %>% distinct(tag_subtype) %>% pull() %>% sort(), + c(multi_select) + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) + +test_that("get_tags() allows selecting on acoustic_tag_id", { + # Errors + expect_error(get_tags(credentials, acoustic_tag_id = "not_a_tag_id")) + expect_error(get_tags(credentials, acoustic_tag_id = c("A69-1601-16130", "not_a_tag_id"))) + + # Select single value + single_select <- "A69-1601-16130" # From 2014_demer + single_select_df <- get_tags(credentials, acoustic_tag_id = single_select) + expect_equal( + single_select_df %>% distinct(acoustic_tag_id) %>% pull(), + c(single_select) + ) + expect_equal(nrow(single_select_df), 1) + # Note that not all acoustic_tag_id return a single row, e.g. "A180-1702-48973" + + # Select multiple values + multi_select <- c("A69-1601-16129", "A69-1601-16130") + multi_select_df <- get_tags(credentials, acoustic_tag_id = multi_select) + expect_equal( + multi_select_df %>% distinct(acoustic_tag_id) %>% pull() %>% sort(), + c(multi_select) + ) + expect_equal(nrow(multi_select_df), 2) +}) + +test_that("get_tags() allows selecting on multiple parameters", { + multiple_parameters_df <- get_tags( + credentials, + tag_serial_number = "1187450", + tag_type = "acoustic", + tag_subtype = "animal", + acoustic_tag_id = "A69-1601-16130" + ) + expect_equal(nrow(multiple_parameters_df), 1) +}) + +test_that("get_tags() can return multiple rows for a single tag", { + # A sentinel acoustic-archival tag with temperature + pressure sensor + tag_1_df <- get_tags(credentials, tag_serial_number = 1400185) + expect_equal(nrow(tag_1_df), 2) # 2 rows: temperature + presure + expect_equal( + tag_1_df %>% + dplyr::arrange(acoustic_tag_id) %>% + distinct(tag_type, tag_subtype, sensor_type, acoustic_tag_id), + dplyr::as_tibble(data.frame( + tag_type = "acoustic-archival", + tag_subtype = "animal", + sensor_type = c("temperature", "pressure"), + acoustic_tag_id = c("A69-9006-11099", "A69-9006-11100"), + stringsAsFactors = FALSE + )) + ) + + # A built-in acoustic tag with two protocols: https://github.com/inbo/etn/issues/177#issuecomment-925578186 + tag_2_df <- get_tags(credentials, tag_serial_number = 461076) + expect_equal(nrow(tag_2_df), 2) # 2 rows: A180 + H170 + expect_equal( + tag_2_df %>% + dplyr::arrange(acoustic_tag_id) %>% + distinct(tag_type, tag_subtype, sensor_type, acoustic_tag_id), + dplyr::as_tibble(data.frame( + tag_type = "acoustic", + tag_subtype = "built-in", + sensor_type = NA_character_, + acoustic_tag_id = c("A180-1702-62076", "H170-1802-62076"), + stringsAsFactors = FALSE + )) + ) +}) + +test_that("get_tags() returns correct tag_type and tag_subtype", { + df <- get_tags(credentials) + expect_equal( + df %>% distinct(tag_type) %>% pull() %>% sort(), + c("acoustic", "acoustic-archival", "archival") + ) + expect_equal( + df %>% distinct(tag_subtype) %>% pull() %>% sort(), + c("animal", "built-in", "range", "sentinel") + ) +}) diff --git a/tests/testthat/test-list_cpod_project_codes.R b/tests/testthat/test-list_cpod_project_codes.R new file mode 100644 index 0000000..6a947f1 --- /dev/null +++ b/tests/testthat/test-list_cpod_project_codes.R @@ -0,0 +1,17 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("list_cpod_project_codes() returns unique list of values", { + vector <- list_cpod_project_codes(credentials) + + expect_is(vector, "character") + expect_false(any(duplicated(vector))) + expect_true(all(!is.na(vector))) + + expect_true("cpod-lifewatch" %in% vector) + # Should not include animal or network projects + expect_false("2014_demer" %in% vector) + expect_false("demer" %in% vector) +}) diff --git a/tests/testthat/test-list_receiver_ids.R b/tests/testthat/test-list_receiver_ids.R index a657d73..2f93201 100644 --- a/tests/testthat/test-list_receiver_ids.R +++ b/tests/testthat/test-list_receiver_ids.R @@ -3,12 +3,21 @@ credentials <- list( password = Sys.getenv("pwd") ) +vector <- list_receiver_ids(credentials) + test_that("list_receiver_ids() returns unique list of values", { - vector <- list_receiver_ids(credentials) + expect_false(any(duplicated(vector))) +}) +test_that("list_receiver_ids() returns a character vector", { expect_is(vector, "character") - expect_false(any(duplicated(vector))) +}) + +test_that("list_receiver_ids() does not return NA values", { + skip("Empty receiver value in acoustic.receivers, ISSUE https://github.com/inbo/etn/issues/333") expect_true(all(!is.na(vector))) +}) +test_that("list_receiver_ids() returns known value", { expect_true("VR2W-124070" %in% vector) }) diff --git a/tests/testthat/test-list_tag_serial_numbers.R b/tests/testthat/test-list_tag_serial_numbers.R new file mode 100644 index 0000000..f917699 --- /dev/null +++ b/tests/testthat/test-list_tag_serial_numbers.R @@ -0,0 +1,14 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("list_tag_serial_numbers() returns unique list of values", { + vector <- list_tag_serial_numbers(credentials) + + expect_is(vector, "character") + expect_false(any(duplicated(vector))) + expect_true(all(!is.na(vector))) + + expect_true("1187450" %in% vector) +}) diff --git a/tests/testthat/test-write_dwc.R b/tests/testthat/test-write_dwc.R new file mode 100644 index 0000000..0e0fd10 --- /dev/null +++ b/tests/testthat/test-write_dwc.R @@ -0,0 +1,54 @@ +credentials <- list( + username = Sys.getenv("userid"), + password = Sys.getenv("pwd") +) + +test_that("write_dwc() can return data as list of tibbles rather than files", { + result <- suppressMessages( + write_dwc(credentials, animal_project_code = "2014_demer") + ) + + expect_identical(names(result), "dwc_occurrence") + expect_s3_class(result$dwc_occurrence, "tbl") +}) + +test_that("write_dwc() returns the expected Darwin Core terms as columns", { + result <- suppressMessages( + write_dwc(credentials, animal_project_code = "2014_demer") + ) + + expect_identical( + colnames(result$dwc_occurrence), + c( + "type", + "license", + "rightsHolder", + "datasetID", + "institutionCode", + "collectionCode", + "datasetName", + "basisOfRecord", + "dataGeneralizations", + "occurrenceID", + "sex", + "lifeStage", + "occurrenceStatus", + "organismID", + "organismName", + "eventID", + "parentEventID", + "eventDate", + "samplingProtocol", + "eventRemarks", + "locationID", + "locality", + "decimalLatitude", + "decimalLongitude", + "geodeticDatum", + "coordinateUncertaintyInMeters", + "scientificNameID", + "scientificName", + "kingdom" + ) + ) +})