R/finbif_check_taxa.R

In finbif: Interface for the 'Finnish Biodiversity Information Facility' API

#' Check FinBIF taxa
#'
#' Check that taxa are in the FinBIF database.
#'
#' @aliases fb_check_taxa
#'
#' @param taxa Character (or list of named character) vector(s). If a list each
#'   vector can have the name of a taxonomic rank (genus, species, etc.,).
#'   The elements of the vectors should be the taxa to check.
#' @param cache Logical or Integer. If `TRUE` or a number greater than zero,
#'   then data-caching will be used. If not logical then cache will be
#'   invalidated after the number of hours indicated by the argument.
#' @return An object of class `finbif_taxa`. A list with the same form as
#'   `taxa`.
#' @examples \dontrun{
#'
#' # Check a scientific name
#' finbif_check_taxa("Cygnus cygnus")
#'
#' # Check a common name
#' finbif_check_taxa("Whooper swan")
#'
#' # Check a genus
#' finbif_check_taxa("Cygnus")
#'
#' # Check a list of taxa
#' finbif_check_taxa(
#'   list(
#'     species = c("Cygnus cygnus", "Ursus arctos"),
#'     genus   = "Betula"
#'   )
#' )
#' }
#' @export
finbif_check_taxa <- function(
  taxa,
  cache = getOption("finbif_use_cache")
) {
  taxa_list <- as.list(taxa)
  taxa_list_names <- names(taxa_list)
  taxa_list_names <- tolower(taxa_list_names)
  has_names <- length(taxa_list_names) > 0L

  for (i in seq_along(taxa_list)) {
    taxa_list_name <- character()

    if (has_names) {
      taxa_list_name <- taxa_list_names[[i]]
    }

    taxa_list_name_length <- length(taxa_list_name)
    no_name <- identical(taxa_list_name_length, 0L)

    taxa_i <- taxa_list[[i]]
    taxa_names <- taxa_i

    for (j in seq_along(taxa_i)) {
      id <- NA_character_

      taxon <- taxa_i[[j]]
      resp <- finbif_taxa(taxon, cache = cache)

      if (length(resp[["content"]]) > 0L) {
        content <- resp[["content"]][[1L]]
        check_rank_obj <- list(name = taxa_list_name, rank = content)

        if (no_name || check_rank(check_rank_obj)) {
          id <- content[["id"]]
        }

      }

      taxa_i[[j]] <- id
    }

    names(taxa_i) <- taxa_names
    taxa_list[[i]] <- taxa_i

  }

  if (has_names) {
    names(taxa_list) <- taxa_list_names
  }

  structure(taxa_list, class = c("list", "finbif_taxa_list"))
}

#' @noRd
check_rank <- function(obj) {
  rank <- sub("MX.", "", obj[[c("rank", "taxonRank")]])
  identical(obj[["name"]], rank)
}