#' Facetted count occurrence search.
#'
#' @param keys (numeric) GBIF keys, a vector. optional
#' @param by (character) One of georeferenced, basisOfRecord, country, or
#' publishingCountry. default: country
#' @param countries (numeric) Number of countries to facet on, or a vector of
#' country names. default: 10
#' @param removezeros (logical) remove zeros or not? default: `FALSE`
#' @export
#' @examples \dontrun{
#' # Select number of countries to facet on
#' count_facet(by='country', countries=3, removezeros = TRUE)
#' # Or, pass in country names
#' count_facet(by='country', countries='AR', removezeros = TRUE)
#'
#' spplist <- c('Geothlypis trichas','Tiaris olivacea','Pterodroma axillaris',
#' 'Calidris ferruginea','Pterodroma macroptera',
#' 'Gallirallus australis',
#' 'Falco cenchroides','Telespiza cantans','Oreomystis bairdi',
#' 'Cistothorus palustris')
#' keys <- sapply(spplist,
#' function(x) name_backbone(x, rank="species")$usageKey)
#' count_facet(keys, by='country', countries=3, removezeros = TRUE)
#' count_facet(keys, by='country', countries=3, removezeros = FALSE)
#' count_facet(by='country', countries=20, removezeros = TRUE)
#' count_facet(keys, by='basisOfRecord', countries=5, removezeros = TRUE)
#'
#' # get occurrences by georeferenced state
#' ## across all records
#' count_facet(by='georeferenced')
#'
#' ## by keys
#' count_facet(keys, by='georeferenced')
#'
#' # by basisOfRecord
#' count_facet(by="basisOfRecord")
#' }
count_facet <- function(keys = NULL,
by = 'country',
countries = 10,
removezeros = FALSE) {
.Deprecated(msg="count_facet() is deprecated since rgbif 3.7.6. Use occ_count(facet='x') instead.")
assert(by, "character")
assert(countries, c("numeric", "integer", "character"))
assert(removezeros, "logical")
# faceting data vectors
if (is.numeric(countries)) {
countrynames <- list(country = as.character(enumeration_country()$iso2)[1:countries])
} else{
countrynames <- list(country = as.character(countries))
}
georefvals <- list(georeferenced = c(TRUE, FALSE))
basisvals <- list(basisOfRecord =
c("FOSSIL_SPECIMEN", "HUMAN_OBSERVATION", "LITERATURE",
"LIVING_SPECIMEN", "MACHINE_OBSERVATION", "OBSERVATION",
"PRESERVED_SPECIMEN", "UNKNOWN"))
byvar <- switch(by,
georeferenced = georefvals,
basisOfRecord = basisvals,
country = countrynames,
publishingCountry = countrynames)
if (!is.null(keys)) {
out <- lapply(keys, occ_by_keys, tt = byvar)
names(out) <- keys
df <- ldfast_names(lapply(out, function(x){
rbind_rows(x, by)
}))
} else {
out <- occ_by(byvar)
df <- rbind_rows(out, by)
}
# remove NAs (which were caused by errors in country names)
df <- stats::na.omit(df)
if (removezeros) {
df[!df$count == 0, ]
} else {
df
}
}
# Function to get data for each name
occ_by_keys <- function(spkey=NULL, tt){
occ_count_safe <- fail_with(NULL, occ_count)
tmp <- lapply(tt[[1]], function(x){
xx <- list(x)
names(xx) <- names(tt)
if (!is.null(spkey)) {
xx$taxonKey <- spkey
}
do.call(occ_count_safe, xx)
})
names(tmp) <- tt[[1]]
tmp[grep("No enum", tmp)] <- NA
tmp
}
# Function to get data for each name
occ_by <- function(tt){
occ_count_safe <- fail_with(NULL, occ_count)
tmp <- lapply(tt[[1]], function(x){
xx <- list(x)
names(xx) <- names(tt)
do.call(occ_count_safe, xx)
})
names(tmp) <- tt[[1]]
tmp[grep("No enum", tmp)] <- NA
tmp
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.