Nothing
#' Lookup names in all taxonomies in GBIF.
#'
#' @template namelkup
#' @export
#' @template occ
#' @references <https://www.gbif.org/developer/species#searching>
#' @examples \dontrun{
#' # Look up names like mammalia
#' name_lookup(query='mammalia', limit = 20)
#'
#' # Start with an offset
#' name_lookup(query='mammalia', limit=1)
#' name_lookup(query='mammalia', limit=1, start=2)
#'
#' # large requests (paging is internally implemented).
#' # hard maximum limit set by GBIF API: 99999
#' # name_lookup(query = "Carnivora", limit = 10000)
#'
#' # Get all data and parse it, removing descriptions which can be quite long
#' out <- name_lookup('Helianthus annuus', rank="species", verbose=TRUE)
#' lapply(out$data, function(x) {
#' x[!names(x) %in% c("descriptions","descriptionsSerialized")]
#' })
#'
#' # Search for a genus
#' name_lookup(query="Cnaemidophorus", rank="genus")
#
#' # Limit records to certain number
#' name_lookup('Helianthus annuus', rank="species", limit=2)
#'
#' # Query by habitat
#' name_lookup(habitat = "terrestrial", limit=2)
#' name_lookup(habitat = "marine", limit=2)
#' name_lookup(habitat = "freshwater", limit=2)
#'
#' # Using faceting
#' name_lookup(facet='status', limit=0, facetMincount='70000')
#' name_lookup(facet=c('status','higherTaxonKey'), limit=0,
#' facetMincount='700000')
#'
#' name_lookup(facet='nameType', limit=0)
#' name_lookup(facet='habitat', limit=0)
#' name_lookup(facet='datasetKey', limit=0)
#' name_lookup(facet='rank', limit=0)
#' name_lookup(facet='isExtinct', limit=0)
#'
#' name_lookup(isExtinct=TRUE, limit=0)
#'
#' # text highlighting
#' ## turn on highlighting
#' res <- name_lookup(query='canada', hl=TRUE, limit=5)
#' res$data
#' name_lookup(query='canada', hl=TRUE, limit=45)
#' ## and you can pass the output to gbif_names() function
#' res <- name_lookup(query='canada', hl=TRUE, limit=5)
#' gbif_names(res)
#'
#' # Lookup by datasetKey (set up sufficient high limit, API maximum: 99999)
#' # name_lookup(datasetKey='3f8a1297-3259-4700-91fc-acc4170b27ce',
#' # limit = 50000)
#'
#' # Some parameters accept many inputs, treated as OR
#' name_lookup(rank = c("family", "genus"))
#' name_lookup(higherTaxonKey = c("119", "120", "121", "204"))
#' name_lookup(status = c("misapplied", "synonym"))$data
#' name_lookup(habitat = c("marine", "terrestrial"))
#' name_lookup(nameType = c("cultivar", "doubtful"))
#' name_lookup(datasetKey = c("73605f3a-af85-4ade-bbc5-522bfb90d847",
#' "d7c60346-44b6-400d-ba27-8d3fbeffc8a5"))
#' name_lookup(datasetKey = "289244ee-e1c1-49aa-b2d7-d379391ce265",
#' origin = c("SOURCE", "DENORMED_CLASSIFICATION"))
#'
#' # Pass on curl options
#' name_lookup(query='Cnaemidophorus', rank="genus",
#' curlopts = list(verbose = TRUE))
#' }
name_lookup <- function(query=NULL,
rank=NULL,
higherTaxonKey=NULL,
status=NULL,
isExtinct=NULL,
habitat=NULL,
nameType=NULL,
datasetKey=NULL,
origin=NULL,
nomenclaturalStatus=NULL,
limit=100,
start=0,
facet=NULL,
facetMincount=NULL,
facetMultiselect=NULL,
type=NULL,
hl=NULL,
issue=NULL,
constituentKey=NULL,
verbose=FALSE,
return=NULL,
curlopts = list()) {
pchk(return, "name_lookup")
if (!is.null(facetMincount) && inherits(facetMincount, "numeric"))
stop("Make sure facetMincount is character")
if (!is.null(facet)) {
facetbyname <- facet
names(facetbyname) <- rep('facet', length(facet))
} else {
facetbyname <- NULL
}
rank <- as_many_args(rank)
higherTaxonKey <- as_many_args(higherTaxonKey)
status <- as_many_args(status)
habitat <- as_many_args(habitat)
nameType <- as_many_args(nameType)
datasetKey <- as_many_args(datasetKey)
origin <- as_many_args(origin)
issue <- as_many_args(issue)
constituentKey <- as_many_args(constituentKey)
url <- paste0(gbif_base(), '/species/search')
args <- rgbif_compact(list(q=query,
isExtinct=as_log(isExtinct),
nomenclaturalStatus=nomenclaturalStatus,
limit=limit, offset=start,
facetMincount=facetMincount,
facetMultiselect=as_log(facetMultiselect),
hl=as_log(hl),
type=type))
args <- c(args,
facetbyname,
rank,
higherTaxonKey,
status,
habitat,
nameType,
datasetKey,
origin,
issue,
constituentKey)
# paging implementation
if (limit > 1000) {
iter <- 0
sumreturned <- 0
numreturned <- 0
outout <- list()
while (sumreturned < limit) {
iter <- iter + 1
tt <- gbif_GET(url, args, FALSE, curlopts)
# if no results, assign numreturned var with 0
if (identical(tt$results, list())) {
numreturned <- 0}
else {
numreturned <- length(tt$results)}
sumreturned <- sumreturned + numreturned
# if less results than maximum
if ((numreturned > 0) && (numreturned < 1000)) {
# update limit for metadata before exiting
limit <- numreturned
args$limit <- limit
}
if (sumreturned < limit) {
# update args for next query
args$offset <- args$offset + numreturned
args$limit <- limit - sumreturned
}
outout[[iter]] <- tt
}
out <- list()
out$results <- do.call(c, lapply(outout, "[[", "results"))
out$offset <- args$offset
out$limit <- args$limit
out$count <- outout[[1]]$count
out$endOfRecords <- outout[[iter]]$endOfRecords
} else {
# retrieve data in a single query
out <- gbif_GET(url, args, FALSE, curlopts)
}
# metadata
meta <- out[c('offset', 'limit', 'endOfRecords', 'count')]
# facets
facets <- out$facets
if (!length(facets) == 0) {
facetsdat <- lapply(facets, function(x)
do.call(rbind, lapply(x$counts, data.frame, stringsAsFactors = FALSE)))
names(facetsdat) <- tolower(sapply(facets, "[[", "field"))
} else {
facetsdat <- NULL
}
# actual data
if (!verbose) {
data <- tibble::as_tibble(data.table::setDF(
data.table::rbindlist(
lapply(out$results, namelkupcleaner),
use.names = TRUE, fill = TRUE)))
if (NROW(data) > 0) data <- movecols(data, c('key', 'scientificName'))
} else {
data <- out$results
}
# hierarchies
hierdat <- lapply(out$results, function(x){
tmp <- x[ names(x) %in% "higherClassificationMap" ]
tmpdf <- data.frame(rankkey = names(rgbif_compact(tmp[[1]])),
name = unlist(unname(rgbif_compact(tmp[[1]]))),
stringsAsFactors = FALSE)
if (NROW(tmpdf) == 0) NULL else tmpdf
})
names(hierdat) <- vapply(out$results, "[[", numeric(1), "key")
# vernacular names
vernames <- lapply(out$results, function(x){
setdfrbind(lapply(x$vernacularNames, data.frame))
})
names(vernames) <- vapply(out$results, "[[", numeric(1), "key")
out <- list(meta = tibble::as_tibble(meta),
data = data,
facets = facetsdat,
hierarchies = compact_null(hierdat),
names = compact_null(vernames))
structure(out, class = "gbif", type = "single", args = args)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.