get_acoustic_deployments.R

#' Get acoustic deployment data
#'
#' Get data for deployments of acoustic receivers, with options to filter
#' results.
#'
#' @param credentials A list with the username and password to connect to the ETN database.
#' @param deployment_id Integer (vector). One or more deployment identifiers.
#' @param receiver_id Character (vector). One or more receiver identifiers.
#' @param acoustic_project_code Character (vector). One or more acoustic
#'   project codes. Case-insensitive.
#' @param station_name Character (vector). One or more deployment station
#'   names.
#' @param open_only Logical. Restrict deployments to those that are currently
#'   open (i.e. no end date defined). Defaults to `FALSE`.
#'
#' @return A tibble with acoustic deployment data, sorted by
#'   `acoustic_project_code`, `station_name` and `deploy_date_time`. See also
#'  [field definitions](https://inbo.github.io/etn/articles/etn_fields.html).
#'
#' @export
#'
#' @examples
#' # Set credentials
#' credentials <- list(
#'    username = Sys.getenv("ETN_USER"),
#'    password = Sys.getenv("ETN_PWD")
#'  )
#'
#' # Get all acoustic deployments
#' get_acoustic_deployments(credentials)
#'
#' # Get specific acoustic deployment
#' get_acoustic_deployments(credentials, deployment_id = 1437)
#'
#' # Get acoustic deployments for a specific receiver
#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070")
#'
#' # Get open acoustic deployments for a specific receiver
#' get_acoustic_deployments(credentials, receiver_id = "VR2W-124070", open_only = TRUE)
#'
#' # Get acoustic deployments for a specific acoustic project
#' get_acoustic_deployments(credentials, acoustic_project_code = "demer")
#'
#' # Get acoustic deployments for two specific stations
#' get_acoustic_deployments(credentials, station_name = c("de-9", "de-10"))
get_acoustic_deployments <- function(
    credentials = list(username = Sys.getenv("ETN_USER"),
                       password = Sys.getenv("ETN_PWD")),
    deployment_id = NULL,
    receiver_id = NULL,
    acoustic_project_code = NULL,
    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)

  # Ensure the connection is closed when the function exits, even when it fails.
  withr::defer(
    if (DBI::dbIsValid(connection)) {
      DBI::dbDisconnect(connection)
    }
  )
  
  # Check if we can make a connection
  check_connection(connection)

  # Check deployment_id
  if (is.null(deployment_id)) {
    deployment_id_query <- "True"
  } else {
    deployment_id <- check_value(
      deployment_id,
      list_deployment_ids(credentials),
      "receiver_id"
    )
    deployment_id_query <- glue::glue_sql(
      "dep.id_pk IN ({deployment_id*})",
      .con = connection
    )
  }

  # Check receiver_id
  if (is.null(receiver_id)) {
    receiver_id_query <- "True"
  } else {
    receiver_id <- check_value(
      receiver_id,
      list_receiver_ids(credentials),
      "receiver_id"
    )
    receiver_id_query <- glue::glue_sql(
      "receiver.receiver IN ({receiver_id*})",
      .con = connection
    )
  }

  # Check acoustic_project_code
  if (is.null(acoustic_project_code)) {
    acoustic_project_code_query <- "True"
  } else {
    acoustic_project_code <- check_value(
      acoustic_project_code,
      list_acoustic_project_codes(credentials),
      "acoustic_project_code",
      lowercase = TRUE
    )
    acoustic_project_code_query <- glue::glue_sql(
      "LOWER(network_project.projectcode) IN ({acoustic_project_code*})",
      .con = connection
    )
  }

  # Check station_name
  if (is.null(station_name)) {
    station_name_query <- "True"
  } else {
    station_name <- check_value(
      station_name,
      list_station_names(credentials),
      "station_name"
    )
    station_name_query <- glue::glue_sql(
      "dep.station_name IN ({station_name*})",
      .con = connection
    )
  }

  # Build query
  query <- glue::glue_sql("
    SELECT
      dep.id_pk AS deployment_id,
      receiver.receiver AS receiver_id,
      network_project.projectcode AS acoustic_project_code,
      dep.station_name AS station_name,
      location_name AS station_description,
      location_manager AS station_manager,
      dep.deploy_date_time AS deploy_date_time,
      dep.deploy_lat AS deploy_latitude,
      dep.deploy_long AS deploy_longitude,
      dep.intended_lat AS intended_latitude,
      dep.intended_long AS intended_longitude,
      dep.mooring_type AS mooring_type,
      dep.bottom_depth AS bottom_depth,
      dep.riser_length AS riser_length,
      dep.instrument_depth AS deploy_depth,
      dep.battery_install_date AS battery_installation_date,
      dep.drop_dead_date AS battery_estimated_end_date,
      dep.activation_datetime AS activation_date_time,
      dep.recover_date_time AS recover_date_time,
      dep.recover_lat AS recover_latitude,
      dep.recover_long AS recover_longitude,
      dep.download_date_time AS download_date_time,
      dep.data_downloaded AS download_file_name,
      dep.valid_data_until_datetime AS valid_data_until_date_time,
      dep.sync_date_time AS sync_date_time,
      dep.time_drift AS time_drift,
      dep.ar_battery_install_date AS ar_battery_installation_date,
      dep.ar_confirm AS ar_confirm,
      dep.transmit_profile AS transmit_profile,
      dep.transmit_power_output AS transmit_power_output,
      dep.log_temperature_stats_period AS log_temperature_stats_period,
      dep.log_temperature_sample_period AS log_temperature_sample_period,
      dep.log_tilt_sample_period AS log_tilt_sample_period,
      dep.log_noise_stats_period AS log_noise_stats_period,
      dep.log_noise_sample_period AS log_noise_sample_period,
      dep.log_depth_stats_period AS log_depth_stats_period,
      dep.log_depth_sample_period AS log_depth_sample_period,
      dep.comments AS comments
      -- dep.project: dep.project_fk instead
      -- dep.check_complete_time
      -- dep.voltage_at_deploy
      -- dep.voltage_at_download
      -- dep.location_description
      -- dep.date_created
      -- dep.date_modified
      -- dep.distance_to_mouth
      -- dep.source
      -- dep.acousticreleasenumber: cpod
      -- dep.hydrophonecablelength: cpod
      -- dep.recordingname: cpod
      -- dep.hydrophonesensitivity: cpod
      -- dep.amplifiersensitivity: cpod
      -- dep.sample_rate: cpod
      -- dep.external_id
    FROM
      acoustic.deployments AS dep
      LEFT JOIN acoustic.receivers AS receiver
        ON dep.receiver_fk = receiver.id_pk
      LEFT JOIN common.projects AS network_project
        ON dep.project_fk = network_project.id
    WHERE
      dep.deployment_type = 'acoustic_telemetry'
      AND {deployment_id_query}
      AND {receiver_id_query}
      AND {acoustic_project_code_query}
      AND {station_name_query}
    ", .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))
  }

  # Sort data
  deployments <-
    deployments |>
    dplyr::arrange(
      .data$acoustic_project_code,
      factor(.data$station_name, levels = list_station_names(credentials)),
      .data$deploy_date_time
    )

  dplyr::as_tibble(deployments)
}