Nothing
#' @title get_downloads
#' @author Socorro Dominguez \email{s.dominguez@ht-data.com}
#' @import gtools
#' @import lubridate
#' @import dplyr
#' @import jsonlite
#' @importFrom methods new
#' @description
#' Information for Fossil Datasets
#' @param x Use a single number to extract site information
#' @param verbose Status bar of items being downloaded
#' @param ... accepted arguments: sites, datasets
#' @details
#' The `get_downloads()` command wraps the Neotoma API
#' ([api.neotomadb.org](https://api.neotomadb.org)) call for `downloads`.
#' The call itself uses a SQL query which accepts any one of the following
#' parameters:
#' * `datasetid` The unique dataset ID (integer) in Neotoma. Can be passed
#' as a vector of dataset IDs.
#' * `all_data` The API only downloads the first 25 records of the query.
#' For the complete records, use `all_data=TRUE`
#' @returns The function returns either a single item of class
#' \code{"try-error"} describing the reason for failure
#' (either misdefined parameters or an error from the Neotoma API),
#' or a table of sites, with rows corresponding to the number of
#' individual sites and datasets returned by the Neotoma API.
#' Each "site" object contains 6 parameters that can be accessed as well:
#' \item{ \code{siteid} }{site ID number}
#' \item{ \code{sitename} }{site's name}
#' \item{ \code{location} }{sf object that describes site's location}
#' \item{ \code{description} }{}
#' \item{ \code{collunits} }{limited information on collunits}
#' Each "collection unit" embedded in the "sites" object contains
#' 6 parameters that can be accessed as well:
#' \item{ \code{collunitid}}{collection unit ID number}
#' \item{ \code{handle} }{collection unit's handle}
#' \item{ \code{collunitname} }{collection unit's name}
#' \item{ \code{colldate} }{date in collection unit}
#' \item{ \code{substrate} }{substrate}
#' \item{ \code{location} }{sf object that describes site's location}
#' \item{ \code{datasets} }{detailed information regarding dataset}
#' Each "dataset" nested in the "collection unit" contains the
#' following detail of information:
#' \item{ \code{datasetid} }{dataset ID number}
#' \item{ \code{datasetname} }{site's name}
#' \item{ \code{datasettype} }{type of data found}
#' \item{ \code{location} }{sf object that describes site's location}
#' \item{ \code{notes} }{notes on the dataset}
#' \item{ \code{taxa table} }{taxa table}
#' \item{ \code{pi list} }{P.I. info}
#' \item{ \code{analyst} }{analyst info}
#' \item{ \code{metadata} }{dataset metadata}
#' @examples \donttest{
#' # To find the downloads object of dataset 24:
#' downloads24 <- get_downloads(24)
#'
#' # To find all downloads in Brazil
#' brazil <- '{"type": "Polygon",
#' "coordinates": [[
#' [-73.125, -9.102096738726443],
#' [-56.953125,-33.137551192346145],
#' [-36.5625,-7.710991655433217],
#' [-68.203125,13.923403897723347],
#' [-73.125,-9.102096738726443]]]}'
#' brazil_datasets <- get_datasets(loc = brazil[1])
#' brazil_downloads <- get_downloads(brazil_datasets)
#' }
#' @export
get_downloads <- function(x = NA, verbose = TRUE, ...) {
if (!missing(x)) {
UseMethod("get_downloads", x)
}else {
UseMethod("get_downloads", NA)
}
}
parse_download <- function(result, verbose = TRUE) {
dls <- result$data %>%
cleanNULL()
dl_index <- purrr::map(dls, function(x) {
data.frame(siteid = x$site$siteid,
collunitid = x$site$collectionunit$collectionunitid,
datasetid = x$site$collectionunit$dataset$datasetid )}) %>%
dplyr::bind_rows()
my_sites_list <- c()
siteids <- c()
check_match <- function(dl_row, ids) {
apply(ids, 1, function(x) sum(dl_row == x))
}
for (i in 1:length(dls)) {
if (length(my_sites_list) == 0) {
my_site <- build_sites(dls[[i]])
my_sites_list <- c(my_sites_list, my_site)
} else {
ids <- getids(my_sites_list, order = FALSE)
matches <- check_match(dl_index[i,], ids)
if (max(matches) == 0) {
# We're adding a site:
my_site <- build_sites(dls[[i]])
my_sites_list <- c(my_sites_list, my_site)
# for some reason, the 19 sites where added fine
} else if (max(matches) == 1) {
# We're adding a collection unit somewhere:
st <- match(ids$siteid[which.max(matches)], unique(ids$siteid))
newcu <- build_collunits(dls[[i]]$site$collectionunit)
oldcu <- my_sites_list[[st]]@collunits@collunits
my_sites_list[[st]]@collunits@collunits <- c(oldcu, newcu)
} else if (max(matches) == 2) {
# We're adding a dataset to an existing collection unit:
st <- match(ids$siteid[which.max(matches)], unique(ids$siteid))
cuids <- ids %>%
dplyr::filter(siteid == unique(ids$siteid)[st], .preserve = TRUE)
cuid <- which(unique(cuids$collunitid) == dl_index$collunitid[i])
collunit <- my_sites_list[[st]]@collunits@collunits[[cuid]]
newds <- build_dataset(dls[[i]]$site$collectionunit$dataset)
collunit@datasets@datasets <- c(collunit@datasets@datasets,
newds)
my_sites_list[[st]]@collunits@collunits[[cuid]] <- collunit
}
}
if (verbose) {
cat(".")
}
}
return(my_sites_list)
}
#' @title get_downloads
#' @param x Use a single number to extract site information
#' @param verbose Should text be printed during the download process?
#' @param ... arguments in ellipse form
#' @returns The function returns either a single item of class
#' \code{"try-error"} describing the reason for failure
#' (either misdefined parameters or an error from the Neotoma API),
#' or a table of sites, with rows corresponding to the number of
#' individual sites and datasets returned by the Neotoma API.
#' @export
get_downloads.numeric <- function(x, verbose = TRUE, ...) {
if (length(x) > 0) {
dataset <- paste0(x, collapse = ",")
}
base_url <- paste0("data/downloads?datasetid=", dataset)
result <- parseURL(base_url, ...) # nolint
output <- parse_download(result, verbose = verbose)
return(output)
}
#' @title get_downloads sites
#' @param x sites object
#' @param verbose Should text be printed during the download process?
#' @param ... arguments in ellipse form
#' @importFrom stats na.omit
#' @returns The function returns either a single item of class
#' \code{"try-error"} describing the reason for failure
#' (either misdefined parameters or an error from the Neotoma API),
#' or a table of sites, with rows corresponding to the number of
#' individual sites and datasets returned by the Neotoma API.
#' @export
get_downloads.sites <- function(x, verbose = TRUE, ...) {
output <- getids(x) %>%
dplyr::filter(!is.na(suppressWarnings(as.numeric(siteid))),
!is.na(suppressWarnings(as.numeric(datasetid))))
ids2 <- getids(x) %>% dplyr::filter(is.na(suppressWarnings(as.numeric(siteid))) |
is.na(suppressWarnings(as.numeric(datasetid))))
if(nrow(ids2)!=0){
warnsite <- sprintf("SiteID %s or DatasetID %s does not exist in the Neotoma DB yet or it has been removed.
It will be removed from your search.", paste0(ids2$siteid,collapse = ", "), paste0(ids2$datasetid,collapse = ", "))
warning(warnsite)
}
output <- output %>%
dplyr::select(datasetid) %>%
stats::na.omit() %>%
unique() %>%
unlist() %>%
as.numeric() %>%
suppressWarnings()
## Fixing all data
cl <- as.list(match.call())
cl[[1]] <- NULL
if('all_data' %in% names(cl)){
all_data = cl$all_data
}else{
cl[['all_data']] = TRUE
}
if('limit' %in% names(cl)){
cl[['all_data']] = FALSE
}
if('offset' %in% names(cl)){
cl[['all_data']] = FALSE
}
## Fixing all data line
cl[['x']] <- output
cl[['verbose']] <- verbose
output <- do.call(get_downloads, cl)
return(output)
}
#' @title get_downloads JSON
#' @param x sites object
#' @param verbose Should text be printed during the download process?
#' @param ... arguments in ellipse form
#' @returns The function returns either a single item of class
#' \code{"try-error"} describing the reason for failure
#' (either misdefined parameters or an error from the Neotoma API),
#' or a table of sites, with rows corresponding to the number of
#' individual sites and datasets returned by the Neotoma API.
#' @importFrom stats na.omit
#' @export
get_downloads.character <- function(x, verbose = TRUE, ...) {
result <- jsonlite::fromJSON(x,
flatten = FALSE,
simplifyVector = FALSE)
result <- result %>%
cleanNULL()
output <- parse_download(result, verbose = verbose)
return(output)
}
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.