R/search_vd_smart.R

In ohvbd: One Health VBD Hub

#' @title Search VecDyn using the explorer's filters
#' @description Retrieve the IDs for any VecDyn datasets matching the given filter.
#'
#' @author Francis Windram
#'
#' @param field a field of VecDyn to search.
#' @param operator an operator to use when searching.
#' @param value the value that the field might/might not be.
#' @param basereq an [httr2 request][httr2::request()] object, as generated by [vb_basereq()]. If `NA`, uses the default request.
#'
#' @section Valid fields:
#' The following field names are valid (shortcut names are listed in brackets):
#' - `SpeciesName` (*species*)
#' - `Title`
#' - `Collections`
#' - `Years` (*yrs*)
#' - `CollectionMethods` (*methods*)
#' - `Tags`
#'
#' @section Valid operators:
#' The following operators are valid (alternative names are listed in brackets):
#' - `contains` (*contain, has, have*)
#' - `!contains` (*!contains, !has, !have, ncontains*)
#' - `equals` (*=, ==, equal, eq*)
#' - `!equals` (*!=, not, !equal, !eq, neq*)
#' - `starts` (*starts with, start with, start, sw*)
#' - `!starts` (*not starts with, not start with, !start, nsw*)
#' - `in` (*within*)
#' - `!in` (*not in, not within, !within, nin*)
#' - `greater` (*greater than, gt, >*)
#' - `less` (*less than, lt, <*)
#'
#' @return An `ohvbd.ids` vector of VecDyn dataset IDs.
#'
#' @examplesIf interactive()
#' search_vd_smart("Collections", "gt", "1000")
#'
#' @concept vecdyn
#'
#' @export
#'

search_vd_smart <- function(field, operator, value, basereq = vb_basereq()) {

  # Operator lookup table.
  poss_operators <- c(
    "contains" = 1,
    "contain" = 1,
    "has" = 1,
    "have" = 1,
    "!contains" = 2,
    "!contain" = 2,
    "!has" = 2,
    "!have" = 2,
    "ncontains" = 2,
    "=" = 3,
    "==" = 3,
    "equal" = 3,
    "equals" = 3,
    "eq" = 3,
    "!=" = 4,
    "not" = 4,
    "!equal" = 4,
    "!equals" = 4,
    "!eq" = 4,
    "neq" = 4,
    "starts with" = 5,
    "start with" = 5,
    "start" = 5,
    "starts" = 5,
    "sw" = 5,
    "not starts with" = 6,
    "not start with" = 6,
    "!start" = 6,
    "!starts" = 6,
    "nsw" = 6,
    "in" = 7,
    "within" = 7,
    "not in" = 8,
    "!in" = 8,
    "not within" = 8,
    "!within" = 8,
    "nin" = 8,
    "greater than" = 9,
    "greater" = 9,
    "gt" = 9,
    ">" = 9,
    "less than" = 10,
    "less" = 10,
    "lt" = 10,
    "<" = 10
  )
  final_operators <- c(
    "contains",
    "ncontains",
    "eq",
    "neq",
    "sw",
    "nsw",
    "in",
    "nin",
    "gt",
    "lt"
  )

  human_operators <- c(
    "contains",
    "!contains",
    "equals",
    "!equals",
    "starts",
    "!starts",
    "in",
    "!in",
    "greater",
    "less"
  )
  # Translate operator to proper operator name
  matched_operator_list <- .match_term(
    operator,
    poss_operators,
    final_operators,
    default_term = "contains",
    term_name = "operator",
    human_terms = human_operators
    )

  final_operator <- matched_operator_list$term

  # Fields lookup table
  poss_fields <- c(
    "speciesname" = 1,
    "species" = 1,
    "title" = 2,
    "collections" = 3,
    "years" = 4,
    "yrs" = 4,
    "collectionmethods" = 5,
    "methods" = 5,
    "tags" = 6,
    "tag" = 6
  )
  final_fields <- c(
    "SpeciesName",
    "Title",
    "Collections",
    "Years",
    "CollectionMethods",
    "Tags"
  )
  # Translate field to proper field name
  matched_field_list <- .match_term(
    field,
    poss_fields,
    final_fields,
    default_term = NULL,
    term_name = "field"
  )

  final_field <- matched_field_list$term

  req <- basereq |>
    req_url_path_append("vecdynbyprovider") |>
    req_url_query("format" = "json") |>
    req_url_query("field" = final_field) |>
    req_url_query("operator" = final_operator) |>
    req_url_query("term" = value)

  if (getOption("ohvbd_dryrun", default = FALSE)) {
    cli::cli_alert_warning("Debug option {.val ohvbd_dryrun} is TRUE.")
    cli::cli_alert_info("Returning request object...")
    return(req)
  }

  resplist <- tryCatch(
    {
      resp <- req |>
        req_perform()
      list("resp" = resp, "err_code" = 0, "err_obj" = NULL)
    },
    error = function(e) {
      # Get the last response instead
      list("resp" = last_response(), "err_code" = 1, "err_obj" = e)
    }
  )

  if (resplist$err_code == 1) {
    cli::cli_abort(c(
      "No records found for {.val {paste(final_field, final_operator, value)}}"
    ))
  }

  body <- resplist$resp |> resp_body_json()
  if (length(body) > 2) {
    # This is a bit of a kludge, the API does not return count in the same place if no results are found
    cli::cli_abort(c(
      "No records found for {.val {paste(final_field, final_operator, value)}}"
    ))
  } else {
    outids <- as.numeric(body$ids)
    outids <- new_ohvbd.ids(v = outids, db = "vd")
    return(outids)
  }
}