R/search_vt_smart.R

In ohvbd: One Health VBD Hub

#' @title Search VecTraits using the explorer's filters
#' @description Retrieve the IDs for any VecTraits datasets matching the given filter.
#'
#' @author Francis Windram
#'
#' @param field a field of VecTraits 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):
#' - `DatasetID` (*id*)
#' - `OriginalTraitName` (*traitname*)
#' - `Variables`
#' - `Interactor1Order` (*order*)
#' - `Interactor1Family` (*family*)
#' - `Interactor1Genus` (*genus*)
#' - `Interactor1Species` (*species, spp*)
#' - `Interactor1Stage` (*stage*)
#' - `Interactor1Sex` (*sex*)
#' - `Interactor2Genus` (*genus2*)
#' - `Interactor2Species` (*species2, spp2*)
#' - `Citation` (*cite*)
#' - `DOI`
#' - `CuratedByDOI` (*curateddoi*)
#' - `SubmittedBy` (*who*)
#' - `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*)
#'
#' @return An `ohvbd.ids` vector of VecTraits dataset IDs.
#'
#' @examplesIf interactive()
#' search_vt_smart("Interactor1Genus", "equals", "Anopheles")
#'
#' @concept vectraits
#'
#' @export
#'

search_vt_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
  )

  final_operators <- c(
    "contains",
    "ncontains",
    "eq",
    "neq",
    "sw",
    "nsw",
    "in",
    "nin"
  )

  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(
    "datasetid" = 1,
    "id" = 1,
    "originaltraitname" = 2,
    "traitname" = 2,
    "variables" = 3,
    "interactor1order" = 4,
    "order" = 4,
    "interactor1family" = 5,
    "family" = 5,
    "interactor1genus" = 6,
    "genus" = 6,
    "interactor1species" = 7,
    "species" = 7,
    "spp" = 7,
    "interactor1stage" = 8,
    "stage" = 8,
    "interactor1sex" = 9,
    "sex" = 9,
    "interactor2genus" = 10,
    "genus2" = 10,
    "interactor2species" = 11,
    "species2" = 10,
    "spp2" = 10,
    "citation" = 12,
    "cite" = 12,
    "doi" = 13,
    "curatedbydoi" = 14,
    "curateddoi" = 14,
    "submittedby" = 15,
    "who" = 15,
    "tags" = 16,
    "tag" = 16
  )
  final_fields <- c(
    "DatasetID",
    "OriginalTraitName",
    "Variables",
    "Interactor1Order",
    "Interactor1Family",
    "Interactor1Genus",
    "Interactor1Species",
    "Interactor1Stage",
    "Interactor1Sex",
    "Interactor2Genus",
    "Interactor2Species",
    "Citation",
    "DOI",
    "CuratedByDOI",
    "SubmittedBy",
    "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("vectraits-explorer") |>
    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()

  outids <- as.numeric(body$ids)
  outids <- new_ohvbd.ids(v = outids, db = "vt")
  return(outids)
}