R/finbif_informal_groups.R

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

#' FinBIF informal groups
#'
#' Display the informal taxonomic groups used in the FinBIF database.
#'
#' @aliases fb_informal_groups
#'
#' @param group Character. Optional, if supplied only display this top-level
#'   group and its subgroups.
#' @param limit Integer. The maximum number top-level informal groups (and their
#'   sub-groups) to display.
#' @param quiet Logical. Return informal group names without displaying them.
#' @param locale Character. One of the supported two-letter ISO 639-1 language
#'   codes. Current supported languages are English, Finnish and Swedish. For
#'   data where more than one language is available the language denoted by
#'   `locale` will be preferred while falling back to the other languages in the
#'   order indicated above.
#' @return A character vector (invisibly).
#' @examples \dontrun{
#'
#' # Display the informal taxonomic groups used by FinBIF
#' finbif_informal_groups()
#'
#' }
#' @export

finbif_informal_groups <- function(
  group,
  limit = 5,
  quiet = FALSE,
  locale = getOption("finbif_locale")
) {

  if (!locale %in% sysdata("supported_langs")) {

    locale <- "en"

  }

  cache <- getOption("finbif_use_cache")

  request <- list(
    path = "informal-taxon-groups/tree",
    query = list(pageSize = 1000L, lang = locale),
    cache = infer_cache(cache)
  )

  informal_grps <- api_get(request)

  informal_grps <- informal_grps[[c("content", "results")]]

  grps <- vapply(informal_grps, getElement, "", "name")

  if (!missing(group)) {

    groups <- grps == group

    stopifnot("Group not found" = any(groups))

    grp <- which(groups)

    informal_grps <- informal_grps[grp]

  }

  if (!quiet) {

    obj <- list(informal_grps = informal_grps, cntr = 0L, limit = limit)

    print_informal_group(obj)

  }

  informal_grps <- unlist(informal_grps)

  informal_grps <- unname(informal_grps)

  informal_grps <- grep("^MVL\\.", informal_grps, invert = TRUE, value = TRUE)

  class(informal_grps) <- "translation"

  invisible(informal_grps)

}

#' @noRd

print_informal_group <- function(obj) {

  informal_grps <- obj[["informal_grps"]]

  times <- max(obj[["cntr"]] - 1L, 0L)

  pad <- rep("    ", times)

  cntr1 <- obj[["cntr"]] + 1L

  cntr2 <- 1L

  len <- length(informal_grps)

  limit <- min(obj[["limit"]], len)

  for (informal_grp in informal_grps) {

    branch <- ""

    is_branch <- cntr1 > 1L

    if (is_branch) {

      branch <- "  --"

    }

    if (!is_branch && cntr2 > limit) {

      sq <- seq_len(cntr2 - 1L)

      extras <- informal_grps[-sq]

      extras <- unlist(extras)

      extras <- grep("MVL\\.", extras)

      extra <- length(extras)

      s <- ""

      if (extra > 1L) {

        s <- "s"

      }

      cat("...", extra, " more group", s, sep = "")

      break

    }

    cntr2 <- cntr2 + 1L

    cat(pad, branch, informal_grp[["name"]], "\n", sep = "")

    if ("hasSubGroup" %in% names(informal_grp)) {

      obj_i <- list(
        informal_grps = informal_grp[["hasSubGroup"]],
        cntr = cntr1,
        limit = limit
      )

      print_informal_group(obj_i)

    }

  }

  invisible(NULL)

}