diff --git a/DESCRIPTION b/DESCRIPTION index 37e8173..c337d7d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: ebirdst Title: Access and Analyze eBird Status and Trends Data Products -Version: 4.2023.0 +Version: 4.2023.1 Authors@R: c( person("Matthew", "Strimas-Mackey", , "mes335@cornell.edu", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-8929-7776")), diff --git a/NAMESPACE b/NAMESPACE index 932d4f8..cf412fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,6 @@ S3method(print,ebirdst_inventory) export("%>%") -export(abundance_palette) export(assign_to_grid) export(calculate_mcc_f1) export(convert_ppy_to_cumulative) @@ -10,17 +9,11 @@ export(date_to_st_week) export(ebirdst_data_dir) export(ebirdst_data_inventory) export(ebirdst_delete) -export(ebirdst_download) export(ebirdst_download_data_coverage) export(ebirdst_download_status) export(ebirdst_download_trends) -export(ebirdst_extent) -export(ebirdst_habitat) export(ebirdst_palettes) -export(ebirdst_ppms) -export(ebirdst_ppms_ts) export(ebirdst_regional_stats) -export(ebirdst_subset) export(ebirdst_version) export(get_species) export(get_species_path) @@ -30,23 +23,14 @@ export(list_available_pis) export(load_config) export(load_data_coverage) export(load_fac_map_parameters) -export(load_pds) export(load_pi) -export(load_pis) export(load_ppm) -export(load_predictions) export(load_ranges) export(load_raster) export(load_regional_stats) -export(load_stixels) export(load_trends) -export(parse_raster_dates) -export(plot_pds) -export(plot_pis) -export(project_extent) export(rasterize_trends) export(set_ebirdst_access_key) -export(stixelize) export(vectorize_trends) importFrom(magrittr,"%>%") importFrom(rlang,.data) diff --git a/NEWS.md b/NEWS.md index 6bc186e..a30aa2a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,24 @@ +# ebirdst 4.2023.1 + +- Removed all functions previously listed as deprecated or defunct + (`abundance_palette()`, `ebirdst_download()`, `ebirdst_extent()`, + `ebirdst_habitat()`, `ebirdst_ppms()`, `ebirdst_ppms_ts()`, + `ebirdst_subset()`, `load_pds()`, `load_pis()`, `load_predictions()`, + `load_stixels()`, `parse_raster_dates()`, `plot_pds()`, `plot_pis()`, + `project_extent()`, `stixelize()`); they have been unavailable or erroring + since at least v3.2022.1 +- Backend approach to file download has been refactored to an on-demand first approach +- `list_available_pis()` no longer downloads every predictor importance raster to determine availability, only `pi_rangewide.csv` +- The http fallback for VPNs that block https now also applies to file downloads, not just file listings. The fallback is only attempted when https fails to reach the server at all, never when the server responds, so the access key isn't sent over an unencrypted connection unnecessarily +- Errors for data that can't be found on-demand now include function-specific guidance, e.g. pointing to `list_available_pis()` +- Files are now downloaded to a temporary file and only moved into place once the transfer completes. Previously a transfer that was cut short part way left a partial file behind, which was treated as a completed download and never re-downloaded; a forced re-download that failed also deleted the existing local copy of the file +- Downloads that fail for a reason other than the data not being available, e.g. a dropped connection, now raise an error saying so rather than reporting the data as missing +- The access key is no longer included in download error messages. The key is passed to the API in the query string of the request URL, and errors from failed downloads quoted that URL, so users reporting a download problem were inadvertently sharing their private key. Download errors now report the reason for the failure with the key redacted +- `vectorize_trends()` now assigns the smallest circle radius to locations with zero relative abundance; previously these locations were given a missing radius +- `ebirdst_palettes()` now requires `n` to be a whole number, rather than accepting a value such as `n = 10.5` +- `ebirdst_regional_stats()` no longer prints a message while downloading +- Various small bug fixes and typos + # ebirdst 4.2023.0 - Transition to having all the `load_*()` functions download directly rather than having to call `ebirdst_download_status()` diff --git a/R/access-key.R b/R/access-key.R index cc04d0b..3c32ca2 100644 --- a/R/access-key.R +++ b/R/access-key.R @@ -58,10 +58,12 @@ set_ebirdst_access_key <- function(key, overwrite = FALSE) { Sys.setenv(EBIRDST_KEY = key) message("eBird Status and Trends access key stored in: ", renv_path) - invisible(renv_path) + return(invisible(renv_path)) } +# internal ---- + get_ebirdst_access_key <- function() { key <- Sys.getenv("EBIRDST_KEY") if (is.na(key) || key == "" || nchar(key) == 0) { @@ -73,8 +75,8 @@ get_ebirdst_access_key <- function() { ) stop( "Valid eBird Status and Trends access key not found. ", - "Note that keys expire after 6 month, you may need a new key." + "Note that keys expire after 6 months, so you may need a new key." ) } - invisible(key) + return(invisible(key)) } diff --git a/R/data.R b/R/data.R index c7ffa6a..bdc950d 100644 --- a/R/data.R +++ b/R/data.R @@ -5,11 +5,11 @@ #' Trends results for each species. #' #' For the Status Data Products, the dates defining the boundaries of the -#' seasons are provided in additional to a quality rating from 0-3 for each +#' seasons are provided in addition to a quality rating from 0-3 for each #' season. These dates and quality ratings are assigned through a process of #' [expert review](https://science.ebird.org/status-and-trends/faq#seasons). -#' expert review. Note that missing dates imply that a season failed expert -#' review for that species within that season. +#' Note that missing dates imply that a season failed expert review for that +#' species within that season. #' #' Trends Data Products are only available for a subset of species, indicated by #' the `has_trends` variable, and for each species the trends is estimated for a @@ -39,16 +39,16 @@ #' - `is_resident`: classifies this species a resident or a migrant. #' - `breeding_quality`: breeding season quality. #' - `breeding_start`: breeding season start date. -#' - `breeding_end`: breeding season start date. +#' - `breeding_end`: breeding season end date. #' - `nonbreeding_quality`: non-breeding season quality. #' - `nonbreeding_start`: non-breeding season start date. -#' - `nonbreeding_end`: non-breeding season start date. +#' - `nonbreeding_end`: non-breeding season end date. #' - `postbreeding_migration_quality`: post-breeding season quality. #' - `postbreeding_migration_start`: post-breeding season start date. -#' - `postbreeding_migration_end`: post-breeding season start date. +#' - `postbreeding_migration_end`: post-breeding season end date. #' - `prebreeding_migration_quality`: pre-breeding season quality. #' - `prebreeding_migration_start`: pre-breeding season start date. -#' - `prebreeding_migration_end`: pre-breeding season start date. +#' - `prebreeding_migration_end`: pre-breeding season end date. #' - `resident_quality`: resident quality. #' - `resident_start`: for resident species, the year-round start date. #' - `resident_end`: for resident species, the year-round end date. diff --git a/R/download.R b/R/download.R index 161081a..eb029fe 100644 --- a/R/download.R +++ b/R/download.R @@ -118,11 +118,22 @@ ebirdst_download_status <- function( } # complete list of all available files for this species - files <- get_download_file_list( - species_code = species, - path = path, - dataset = "status" + keys <- list_object_keys(species_code = species, dataset = "status") + + # decide which files to download + keys <- select_status_keys( + keys, + download_abundance = download_abundance, + download_occurrence = download_occurrence, + download_count = download_count, + download_ranges = download_ranges, + download_regional = download_regional, + download_pis = download_pis, + download_ppms = download_ppms, + download_all = download_all, + pattern = pattern ) + # path to data package run_path <- file.path( path, @@ -130,69 +141,24 @@ ebirdst_download_status <- function( species ) - # decide which files to download - # always download config file - dl <- stringr::str_detect(files$file, pattern = "config.json$") - if (download_abundance || download_all) { - # add abundance - dl <- stringr::str_detect(files$file, "\\_abundance\\_") | dl - # add proportion of population - dl <- stringr::str_detect(files$file, "\\_proportion-population\\_") | dl - } - if (download_occurrence || download_all) { - # add occurrence - dl <- stringr::str_detect(files$file, "\\_occurrence\\_") | dl - } - if (download_count || download_all) { - # add count - dl <- stringr::str_detect(files$file, "\\_count\\_") | dl - } - if (download_ranges || download_all) { - # add ranges - dl <- stringr::str_detect(files$file, "/ranges/") | dl - } - if (download_regional || download_all) { - # add regional summary stats - dl <- stringr::str_ends(files$file, "regional_stats.csv") | dl - } - if (download_pis || download_all) { - # add pis - dl <- stringr::str_detect(files$file, "/pis/") | dl - } - if (download_ppms || download_all) { - # add ppms - dl <- stringr::str_detect(files$file, "/ppms/") | dl - } - files <- files[dl, ] - - # apply pattern - if (!is.null(pattern)) { - stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern)) - pat_match <- stringr::str_detect(basename(files$file), pattern = pattern) - if (!any(pat_match)) { - stop("No files matched pattern") - } - - # always download config file - is_config <- stringr::str_detect( - basename(files$file), - pattern = "config.json$" - ) - files <- files[pat_match | is_config, ] - } - # print files to download for dry run if (dry_run) { message("Downloading Status Data Products for ", species, " to:\n ", path) - message(paste(c("File list:", files$file), collapse = "\n ")) - return(invisible(files$file)) + message(paste(c("File list:", keys), collapse = "\n ")) + return(invisible(keys)) } if (show_progress) { message(stringr::str_glue("Downloading Status Data Products for {species}")) } - download_files(files, force = force, show_progress = show_progress) + fetch_data( + keys, + path = path, + force = force, + show_progress = show_progress, + report_existing = TRUE + ) return(invisible(normalizePath(run_path))) } @@ -267,22 +233,33 @@ ebirdst_download_trends <- function( run_paths <- character() for (s in species_code) { # complete list of all available files for this species - files <- get_download_file_list( - species_code = s, - path = path, - dataset = "trends" - ) + keys <- list_object_keys(species_code = s, dataset = "trends") + # only trends files + keys <- keys[stringr::str_detect(keys, "/trends/")] + if (length(keys) == 0) { + stop( + "No Trends Data Products are available for ", + s, + ", despite it being identified as having trends estimates in ", + "ebirdst_runs. Please report this at ", + "https://github.com/ebird/ebirdst/issues" + ) + } + # path to data package run_path <- file.path(path, ebirdst_version()[["trends_version_year"]], s) - # only trends files - files <- files[stringr::str_detect(files$file, "/trends/"), ] - # download if (show_progress) { message(stringr::str_glue("Downloading Trends Data Products for {s}")) } - download_files(files, force = force, show_progress = show_progress) + fetch_data( + keys, + path = path, + force = force, + show_progress = show_progress, + report_existing = TRUE + ) run_paths <- c(run_paths, run_path) } @@ -329,7 +306,7 @@ ebirdst_download_data_coverage <- function( stopifnot(is_flag(show_progress)) # complete list of all available files for this species - files <- get_download_file_list(species_code = "data_coverage", path = path) + keys <- list_object_keys(species_code = "data_coverage", dataset = "status") # path to data package run_path <- file.path( path, @@ -340,25 +317,31 @@ ebirdst_download_data_coverage <- function( # apply pattern if (!is.null(pattern)) { stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern)) - pat_match <- stringr::str_detect(basename(files$file), pattern = pattern) + pat_match <- stringr::str_detect(basename(keys), pattern = pattern) if (!any(pat_match)) { stop("No files matched pattern") } - files <- files[pat_match, ] + keys <- keys[pat_match] } # print files to download for dry run if (dry_run) { message("Downloading Data Coverage Products to:\n ", path) - message(paste(c("File list:", files$file), collapse = "\n ")) - return(invisible(files$file)) + message(paste(c("File list:", keys), collapse = "\n ")) + return(invisible(keys)) } if (show_progress) { message(stringr::str_glue("Downloading Data Coverage Products")) } - download_files(files, force = force, show_progress = show_progress) + fetch_data( + keys, + path = path, + force = force, + show_progress = show_progress, + report_existing = TRUE + ) return(invisible(normalizePath(run_path))) } @@ -459,161 +442,3 @@ ebirdst_version <- function() { release_year = 2025 ) } - - -# internal ---- - -get_download_file_list <- function( - species_code, - path, - dataset = c("status", "trends") -) { - stopifnot( - is.character(species_code), - length(species_code) == 1, - !is.na(species_code) - ) - dataset <- match.arg(dataset) - - # version of the data products that this package version corresponds to - version_year <- ebirdst_version()[[paste0(dataset, "_version_year")]] - # example data or a full data package - is_example <- (species_code == "yebsap-example") - - # path to data package - run_path <- file.path(path, version_year, species_code) - - if (is_example) { - api_url <- paste0( - "https://raw.githubusercontent.com/", - "ebird/ebirdst_example-data/main/", - "example-data/" - ) - # file list - fl <- system.file( - "extdata", - paste0("example-data_file-list_", dataset, ".txt"), - package = "ebirdst" - ) - files <- readLines(fl) - } else { - # api url and key - key <- get_ebirdst_access_key() - api_url <- "https://st-download.ebird.org/v1" - - # get file list for this species - list_obj_url <- stringr::str_glue( - "{api_url}/list-obj/{version_year}/", - "{species_code}?key={key}" - ) - files <- tryCatch( - suppressWarnings({ - jsonlite::read_json(list_obj_url, simplifyVector = TRUE) - }), - error = function(e) NULL - ) - if (is.null(files)) { - # try http instead in case of ssl issues on vpn - api_url <- "http://st-download.ebird.org/v1" - # get file list for this species - list_obj_url <- stringr::str_glue( - "{api_url}/list-obj/{version_year}/", - "{species_code}?key={key}" - ) - files <- tryCatch( - suppressWarnings({ - jsonlite::read_json(list_obj_url, simplifyVector = TRUE) - }), - error = function(e) NULL - ) - if (is.null(files)) { - stop( - "Cannot access Status and Trends data URL. Ensure that you have ", - "a working internet connection and a valid API key for the ", - "Status and Trends data. Note that the API keys expire after ", - "6 month, so may need to update your key. ", - "Visit https://ebird.org/st/request" - ) - } - } - - # remove web_download folder - web_down <- stringr::str_detect(dirname(files), pattern = "web_download") - files <- files[!web_down] - - # remove additional species cause by bug in API - # e.g. leafly will also return leafly2 - only_target <- stringr::str_detect( - files, - pattern = paste0("/", species_code, "/") - ) - files <- files[only_target] - } - - if (length(files) == 0) { - stop("No data found for species ", species_code) - } - - # prepare download paths - files <- data.frame(file = files) - if (is_example) { - files$src_path <- paste0(api_url, files$file) - } else { - files$src_path <- stringr::str_glue( - "{api_url}/fetch?objKey={files$file}", - "&key={key}" - ) - } - files$dest_path <- file.path(path, files$file) - files$exists <- file.exists(files$dest_path) - - return(files) -} - -download_files <- function(files, force, show_progress) { - # create necessary directories - dirs <- unique(dirname(files$dest_path)) - for (d in dirs) { - dir.create(d, showWarnings = FALSE, recursive = TRUE) - } - - # check if already exists - if (all(files$exists)) { - if (!isTRUE(force)) { - message("Data already exists, use force = TRUE to re-download.") - return(invisible(0L)) - } - } else if (any(files$exists)) { - if (!isTRUE(force)) { - message(paste( - "Some files already exist, only downloading new files.", - " Use force = TRUE to re-download all files." - )) - files <- files[!files$exists, ] - } - } - - # download - n_files <- nrow(files) - old_timeout <- getOption("timeout") - options(timeout = max(3000, old_timeout)) - for (i in seq_len(n_files)) { - if (show_progress) { - message(stringr::str_glue( - " Downloading file {i} of {n_files}: ", - "{basename(files$file[i])}" - )) - } - dl_response <- utils::download.file( - files$src_path[i], - files$dest_path[i], - quiet = TRUE, - mode = "wb" - ) - if (dl_response != 0) { - stop("Error downloading file: ", files$file[i]) - } - } - options(timeout = old_timeout) - return(invisible(n_files)) -} diff --git a/R/ebirdst-defunct.R b/R/ebirdst-defunct.R deleted file mode 100644 index 7670375..0000000 --- a/R/ebirdst-defunct.R +++ /dev/null @@ -1,138 +0,0 @@ -## ebirdst defunct functions -#' @title Defunct functions in package \pkg{ebirdst}. -#' @description The functions listed below are defunct and no longer supported. -#' Calling them will result in an error. -#' -#' When possible alternative functions are suggested. -#' -#' Many of them supported stixles which were infrequently used and were -#' dropped from \pkg{ebirdst} with the 2022 data release. -#' @param ... All arguments are now ignored. -#' @name ebirdst-defunct -#' @keywords internal -NULL - -#' @rdname ebirdst-defunct -#' @export -ebirdst_download <- function( - species, - path = ebirdst_data_dir(), - tifs_only = TRUE, - force = FALSE, - show_progress = TRUE, - pattern = NULL, - dry_run = FALSE -) { - .Defunct("ebirdst_download_status", package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -ebirdst_extent <- function(x, t, ...) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -ebirdst_habitat <- function( - path, - ext, - data = NULL, - stationary_associations = FALSE -) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -ebirdst_ppms <- function(path, ext, es_cutoff, pat_cutoff) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -ebirdst_ppms_ts <- function( - ath, - ext, - summarize_by = c("weeks", "months"), - ... -) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -ebirdst_subset <- function(x, crs) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -load_pds <- function( - path, - ext, - model = c("occurrence", "count"), - return_sf = FALSE -) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -load_pis <- function( - path, - ext, - model = c("occurrence", "count"), - return_sf = FALSE -) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -load_predictions <- function(path, return_sf = FALSE) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -parse_raster_dates <- function(x) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -load_stixels <- function(path, ext, return_sf = FALSE) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -project_extent <- function(x, crs) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -plot_pds <- function(path, ext, summarize_by = c("weeks", "months"), ...) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -plot_pis <- function( - pis, - ext, - by_cover_class = TRUE, - n_top_pred = 15, - pretty_names = TRUE, - plot = TRUE -) { - .Defunct(package = "ebirdst") -} - -#' @rdname ebirdst-defunct -#' @export -stixelize <- function(x) { - .Defunct(package = "ebirdst") -} diff --git a/R/ebirdst-deprecated.R b/R/ebirdst-deprecated.R deleted file mode 100644 index c010bac..0000000 --- a/R/ebirdst-deprecated.R +++ /dev/null @@ -1,52 +0,0 @@ -#' @title Deprecated functions in package \pkg{ebirdst}. -#' @description The functions listed below are deprecated and support for them -#' will eventually be dropped. -#' Help pages for deprecated functions are -#' available at \code{help("-deprecated")}. -#' @name ebirdst-deprecated -#' @keywords internal -NULL - - -#' eBird Status and Trends color palettes for mapping -#' -#' This deprecated function has been replaced by \code{\link{ebirdst_palettes}}. -#' Both functions generate color palettes used for the eBird Status and Trends -#' relative abundance maps. -#' -#' @param n integer; the number of colors to be in the palette. -#' @param season character; the season to generate colors for or "weekly" to -#' get the color palette used in the weekly abundance animations. -#' -#' @return A character vector of hex color codes. -#' @usage abundance_palette(n, -#' season = c("weekly", "breeding", -#' "nonbreeding", -#' "migration", -#' "prebreeding_migration", -#' "postbreeding_migration", -#' "year_round")) -#' @name abundance_palette-deprecated -#' @seealso \code{\link{ebirdst_palettes}} \code{\link{ebirdst-deprecated}} -#' @keywords internal -NULL - -#' @rdname ebirdst-deprecated -#' @section \code{abundance_palette}: -#' For \code{abundance_palette}, use \code{\link{ebirdst_palettes}} -#' @export -abundance_palette <- function( - n, - season = c( - "weekly", - "breeding", - "nonbreeding", - "migration", - "prebreeding_migration", - "postbreeding_migration", - "year_round" - ) -) { - .Deprecated(new = "ebirdst_palettes", package = "ebirdst") - ebirdst_palettes(n = n, type = season) -} diff --git a/R/ebirdst-palettes.R b/R/ebirdst-palettes.R index 9f88b40..c5f2ec9 100644 --- a/R/ebirdst-palettes.R +++ b/R/ebirdst-palettes.R @@ -28,7 +28,7 @@ ebirdst_palettes <- function( "trends" ) ) { - stopifnot(is.numeric(n), length(n) == 1, n >= 1) + stopifnot(is_count(n), n >= 1) type <- match.arg(type) # set base color by season @@ -54,8 +54,6 @@ ebirdst_palettes <- function( base_col <- "#73af48" } else if (type == "year_round") { base_col <- "#6f4070" - } else { - stop("Invalid season.") } # seasonal palettes diff --git a/R/fetch.R b/R/fetch.R new file mode 100644 index 0000000..c2e296c --- /dev/null +++ b/R/fetch.R @@ -0,0 +1,527 @@ +# this file contains the internal machinery shared by the ebirdst_download_*() +# functions in download.R and the on-demand downloads performed by the +# load_*() functions in load.R. the local path for a downloaded file is always +# its object key (e.g. "2023/woothr/config.json") appended to the data +# directory, and the API can fetch a single object directly by key, so +# fetch_data() is the one function anything in the package needs to call to +# make sure a set of files exist locally + +# internal ---- + +# session-cached API base url; some VPNs block https to the download API, so +# a fallback to http is cached here once a request over http is known to have +# succeeded, to avoid re-probing on every request. the access key is passed in +# the query string, so the downgrade is only ever cached on success and only +# for a connection-level failure (see try_url()) +ebirdst_env <- new.env(parent = emptyenv()) +ebirdst_env$api_base_url <- "https://st-download.ebird.org/v1" + +api_base_url <- function() { + return(ebirdst_env$api_base_url) +} + +http_url <- function(url) { + return(sub("^https://", "http://", url)) +} + +use_http_fallback <- function() { + ebirdst_env$api_base_url <- http_url(ebirdst_env$api_base_url) + return(invisible(ebirdst_env$api_base_url)) +} + + +# the access key is passed to the API in the query string of the request url, and +# both download.file() and read_json() name that url in the conditions they +# raise. those messages get pasted into bug reports and emails, so the key has to +# be stripped out of anything the package passes on to the user. the query +# parameter is matched rather than the key itself so that this works even when no +# key is set locally, e.g. for the example data; the key is then also matched +# literally in case it ever appears somewhere the query string pattern doesn't +redact_access_key <- function(x) { + redacted <- stringr::str_replace_all( + x, + "([?&])key=[^&'\"\\s]*", + "\\1key=" + ) + + # Sys.getenv() is used directly because get_ebirdst_access_key() errors when + # no key is set, and redacting must never itself be a point of failure + access_key <- Sys.getenv("EBIRDST_KEY") + if (nzchar(access_key)) { + redacted <- stringr::str_replace_all( + redacted, + stringr::fixed(access_key), + "" + ) + } + + return(redacted) +} + + +# attempt to access a url, returning the value of `expr` (NULL on failure) +# alongside a flag indicating whether the failure was an http status error. +# an http status error means the server was reached and responded, so the +# object simply isn't available; any other failure (dns, tls, proxy, timeout) +# is a connection-level problem and is the only case where retrying over http +# could help. this distinction matters because the access key travels in the +# query string, so http must never be probed for a request that already got a +# response over https +try_url <- function(expr) { + messages <- character() + value <- withCallingHandlers( + tryCatch( + expr, + error = function(e) { + messages <<- c(messages, conditionMessage(e)) + return(NULL) + } + ), + warning = function(w) { + messages <<- c(messages, conditionMessage(w)) + invokeRestart("muffleWarning") + } + ) + + # note that a connection-level failure reports "status was ''" + # without the "HTTP " prefix, so this matches responses only + http_status <- any(stringr::str_detect(messages, "HTTP status")) + + # the underlying message is the only clue as to why a request failed, so it's + # worth reporting, but only ever redacted + reason <- redact_access_key(paste(unique(messages), collapse = "; ")) + + return(list(value = value, http_status = http_status, reason = reason)) +} + + +# object keys are appended to the data directory to give the local path of a +# downloaded file, and most of them come from the API listing rather than from +# the user, so check that none of them could write outside the data directory +# before using one as a path +check_object_keys <- function(keys) { + stopifnot(is.character(keys), length(keys) >= 1, !anyNA(keys)) + + segments <- strsplit(keys, "[/\\\\]") + traversal <- vapply(segments, function(x) any(x == ".."), logical(1)) + absolute <- stringr::str_detect(keys, "^([/\\\\]|[A-Za-z]:)") + invalid <- keys[traversal | absolute | keys == ""] + if (length(invalid) > 0) { + stop( + "The following data files have invalid names:\n ", + paste(invalid, collapse = "\n ") + ) + } + + return(invisible(keys)) +} + + +# downloads are written to a temporary file with this suffix alongside their +# destination and only moved into place once complete, so the suffix is defined +# here rather than inline in download_files(): ebirdst_data_inventory() needs it +# to recognize and ignore a partial download left behind by a session that was +# killed mid-transfer +partial_suffix <- ".part" + +partial_download_path <- function(path) { + return(paste0(path, partial_suffix)) +} + +is_partial_download <- function(path) { + return(stringr::str_ends(path, stringr::fixed(partial_suffix))) +} + + +# resolve a species name/code to its eBird species code; mirrors the +# validation in get_species_path() but doesn't require path to already exist +resolve_species <- function(species) { + species_code <- get_species(species) + if (anyNA(species_code)) { + stop( + paste(species[is.na(species_code)], collapse = ", "), + " does not correspond to a valid Status and Trends species." + ) + } + return(species_code) +} + + +# create the data directory if it doesn't already exist +ensure_data_dir <- function(path) { + if (!dir.exists(path)) { + created <- dir.create(path, recursive = TRUE, showWarnings = FALSE) + if (!isTRUE(created)) { + stop("Unable to create data directory: ", path) + } + } + return(invisible(path)) +} + + +# build object keys within the status or trends data package for a species; +# vectorizes over the last argument, e.g. status_key("woothr", "weekly", files) +status_key <- function(species_code, ...) { + version_year <- ebirdst_version()[["status_version_year"]] + return(paste(version_year, species_code, ..., sep = "/")) +} + +trends_key <- function(species_code, ...) { + version_year <- ebirdst_version()[["trends_version_year"]] + return(paste(version_year, species_code, ..., sep = "/")) +} + + +# request the object listing for a species from a given API base url; returns +# the result of try_url(), so the caller can tell a missing listing apart from +# an unreachable server +read_object_list <- function(version_year, species_code, base_url) { + key <- get_ebirdst_access_key() + list_obj_url <- stringr::str_glue( + "{base_url}/list-obj/{version_year}/", + "{species_code}?key={key}" + ) + return(try_url(jsonlite::read_json(list_obj_url, simplifyVector = TRUE))) +} + + +# list all object keys available for a species, for callers that don't +# already know the exact key(s) they want: flag/pattern-based selection in +# ebirdst_download_status()/ebirdst_download_trends(), and PI availability in +# list_available_pis() +list_object_keys <- function(species_code, dataset = c("status", "trends")) { + stopifnot( + is.character(species_code), + length(species_code) == 1, + !is.na(species_code) + ) + dataset <- match.arg(dataset) + + version_year <- ebirdst_version()[[paste0(dataset, "_version_year")]] + is_example <- (species_code == "yebsap-example") + + if (is_example) { + fl <- system.file( + "extdata", + paste0("example-data_file-list_", dataset, ".txt"), + package = "ebirdst" + ) + keys <- readLines(fl) + } else { + attempt <- read_object_list(version_year, species_code, api_base_url()) + keys <- attempt$value + + # some vpns block https to the download api, so retry over http, but only + # if https failed to connect at all rather than returning a response + retry_http <- is.null(keys) && + !attempt$http_status && + startsWith(api_base_url(), "https://") + if (retry_http) { + attempt <- read_object_list( + version_year, + species_code, + http_url(api_base_url()) + ) + keys <- attempt$value + # only cache the downgrade now that it's known to work + if (!is.null(keys)) { + use_http_fallback() + } + } + + if (is.null(keys)) { + reason <- if (nzchar(attempt$reason)) { + paste0("\nThe following error occurred:\n ", attempt$reason) + } else { + "" + } + stop( + "Cannot access Status and Trends data URL. Ensure that you have ", + "a working internet connection and a valid API key for the ", + "Status and Trends data. Note that the API keys expire after ", + "6 months, so you may need to update your key. ", + "Visit https://ebird.org/st/request", + reason + ) + } + + # remove web_download folder + web_down <- stringr::str_detect(dirname(keys), pattern = "web_download") + keys <- keys[!web_down] + + # remove additional species caused by bug in API, e.g. leafly will also + # return leafly2 + only_target <- stringr::str_detect( + keys, + pattern = paste0("/", species_code, "/") + ) + keys <- keys[only_target] + } + + if (length(keys) == 0) { + stop("No data found for species ", species_code) + } + + return(keys) +} + + +# select which object keys should be downloaded based on the download_* flags +# and an optional filename pattern; the selection logic used by +# ebirdst_download_status() +select_status_keys <- function( + keys, + download_abundance = TRUE, + download_occurrence = FALSE, + download_count = FALSE, + download_ranges = FALSE, + download_regional = FALSE, + download_pis = FALSE, + download_ppms = FALSE, + download_all = FALSE, + pattern = NULL +) { + # always download config file + dl <- stringr::str_detect(keys, pattern = "config.json$") + if (download_abundance || download_all) { + # add abundance + dl <- stringr::str_detect(keys, "\\_abundance\\_") | dl + # add proportion of population + dl <- stringr::str_detect(keys, "\\_proportion-population\\_") | dl + } + if (download_occurrence || download_all) { + # add occurrence + dl <- stringr::str_detect(keys, "\\_occurrence\\_") | dl + } + if (download_count || download_all) { + # add count + dl <- stringr::str_detect(keys, "\\_count\\_") | dl + } + if (download_ranges || download_all) { + # add ranges + dl <- stringr::str_detect(keys, "/ranges/") | dl + } + if (download_regional || download_all) { + # add regional summary stats + dl <- stringr::str_ends(keys, "regional_stats.csv") | dl + } + if (download_pis || download_all) { + # add pis + dl <- stringr::str_detect(keys, "/pis/") | dl + } + if (download_ppms || download_all) { + # add ppms + dl <- stringr::str_detect(keys, "/ppms/") | dl + } + keys <- keys[dl] + + # apply pattern + if (!is.null(pattern)) { + stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern)) + pat_match <- stringr::str_detect(basename(keys), pattern = pattern) + if (!any(pat_match)) { + stop("No files matched pattern") + } + + # always download config file + is_config <- stringr::str_detect(basename(keys), pattern = "config.json$") + keys <- keys[pat_match | is_config] + } + + return(keys) +} + + +# build the source download url for a set of object keys +object_key_url <- function(keys) { + is_example <- stringr::str_detect(keys, "yebsap-example") + urls <- character(length(keys)) + + if (any(is_example)) { + example_url <- paste0( + "https://raw.githubusercontent.com/", + "ebird/ebirdst_example-data/main/", + "example-data/" + ) + urls[is_example] <- paste0(example_url, keys[is_example]) + } + if (!all(is_example)) { + key <- get_ebirdst_access_key() + urls[!is_example] <- stringr::str_glue( + "{api_base_url()}/fetch?objKey={keys[!is_example]}", + "&key={key}" + ) + } + + return(urls) +} + + +# ensure the local files for a set of object keys exist, downloading any that +# are missing (or all of them, if force = TRUE); returns the normalized local +# paths. every download in the package funnels through here. `hint` is +# appended to the error raised if a requested key can't be found, and +# `report_existing` controls whether "already downloaded" messages are shown +# (used by the ebirdst_download_*() functions, but not by on-demand loads, +# which should stay silent when the requested data is already cached) +fetch_data <- function( + keys, + path, + force = FALSE, + show_progress = interactive(), + hint = NULL, + report_existing = FALSE +) { + check_object_keys(keys) + ensure_data_dir(path) + dest_paths <- file.path(path, keys) + exists <- file.exists(dest_paths) + + if (!isTRUE(force) && all(exists)) { + if (report_existing) { + message("Data already exists, use force = TRUE to re-download.") + } + return(invisible(normalizePath(dest_paths))) + } + if (!isTRUE(force) && any(exists) && report_existing) { + message( + "Some files already exist, only downloading new files. ", + "Use force = TRUE to re-download all files." + ) + } + + to_fetch <- if (isTRUE(force)) keys else keys[!exists] + fetch_dest <- file.path(path, to_fetch) + + # create necessary directories + dirs <- unique(dirname(fetch_dest)) + for (d in dirs) { + dir.create(d, showWarnings = FALSE, recursive = TRUE) + } + + result <- download_files( + object_key_url(to_fetch), + fetch_dest, + to_fetch, + show_progress = show_progress + ) + + # a download that failed for any reason other than the data not existing, e.g. + # a dropped connection, isn't something the caller can fix by requesting + # different data, so it gets its own error rather than the hint below. any + # local copy of these files is left as it was + failed <- !result$success & !result$not_found + if (any(failed)) { + detail <- ifelse( + is.na(result$reason[failed]) | result$reason[failed] == "", + to_fetch[failed], + paste0(to_fetch[failed], ": ", result$reason[failed]) + ) + stop( + "The following files failed to download:\n ", + paste(detail, collapse = "\n "), + "\nThis is usually a temporary problem, check your internet connection ", + "and try again." + ) + } + + missing <- keys[!file.exists(dest_paths)] + if (length(missing) > 0) { + msg <- paste0( + "The requested data could not be found:\n ", + paste(missing, collapse = "\n ") + ) + if (!is.null(hint)) { + stop(msg, "\n", hint) + } + stop(msg) + } + + return(invisible(normalizePath(dest_paths))) +} + + +# download files from src urls to local destination paths, returning the outcome +# for each file: `success`, `not_found` for the files the server responded to +# with an http status error, meaning the data simply isn't there as opposed to +# the download failing for some other reason, and `reason`, the redacted message +# from the failed attempt (NA where the download succeeded). fetch_data() needs +# these to report a useful error. `keys` is used only to report progress +# +# each file is downloaded to a temporary file alongside its destination and only +# moved into place once the transfer has completed, because download.file() +# leaves a partial file behind when a transfer is cut short part way, and +# deletes any existing destination file when it fails. the temporary file is a +# sibling of the destination rather than in tempdir() so the rename stays within +# one filesystem, and every temporary file is removed on any exit from this +# function, including an error or interrupt +# +# if https can't be reached at all, retry once over http in case it's being +# blocked (e.g. by a VPN), caching the fallback for the rest of the session only +# once it's known to work +download_files <- function(src, dest, keys, show_progress) { + n_files <- length(src) + old_timeout <- getOption("timeout") + options(timeout = max(3000, old_timeout)) + on.exit(options(timeout = old_timeout), add = TRUE) + + tmp <- partial_download_path(dest) + on.exit(unlink(tmp), add = TRUE) + + success <- rep(FALSE, n_files) + not_found <- rep(FALSE, n_files) + reason <- rep(NA_character_, n_files) + + for (i in seq_len(n_files)) { + if (show_progress) { + message(stringr::str_glue( + " Downloading file {i} of {n_files}: ", + "{basename(keys[i])}" + )) + } + attempt <- try_url( + utils::download.file(src[i], tmp[i], quiet = TRUE, mode = "wb") + ) + ok <- identical(attempt$value, 0L) + + # an http status, or a partial file, means the server responded, so only a + # failure that left nothing at all behind is a connection-level problem + # worth retrying over http + retry_http <- !ok && + !attempt$http_status && + !file.exists(tmp[i]) && + stringr::str_starts(src[i], "https://st-download") + if (retry_http) { + attempt <- try_url( + utils::download.file( + http_url(src[i]), + tmp[i], + quiet = TRUE, + mode = "wb" + ) + ) + ok <- identical(attempt$value, 0L) + # only cache the downgrade, and apply it to the files still to come, + # once it's known to work + if (ok) { + use_http_fallback() + is_api <- stringr::str_starts(src, "https://st-download") + src[is_api] <- http_url(src[is_api]) + } + } + + if (ok) { + success[i] <- file.rename(tmp[i], dest[i]) + } else { + not_found[i] <- attempt$http_status + reason[i] <- attempt$reason + unlink(tmp[i]) + } + } + + return(invisible(list( + success = success, + not_found = not_found, + reason = reason + ))) +} diff --git a/R/load.R b/R/load.R index 1b93299..325274c 100644 --- a/R/load.R +++ b/R/load.R @@ -110,28 +110,9 @@ load_raster <- function( period <- match.arg(period) resolution <- match.arg(resolution) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - species_code <- get_species(species) - species_path <- get_species_path( - species, - path = path, - dataset = "status", - check_downloaded = FALSE - ) + check_gtiff_support() - # check that the geotiff driver is installed - drv <- terra::gdal(drivers = TRUE) - drv <- drv$name[stringr::str_detect(drv$can, "read")] - if (!"GTiff" %in% drv) { - stop( - "GDAL does not have GeoTIFF support. GeoTIFF support is required to ", - "load Status and Trends raster data." - ) - } + species_code <- resolve_species(species) # load config file, downloading it on demand if necessary p <- load_config( @@ -156,7 +137,7 @@ load_raster <- function( ) } - # construct file name and path + # construct file name and key if (period == "weekly") { # assess which metric is being requested if (is.null(metric)) { @@ -180,14 +161,14 @@ load_raster <- function( "{species_code}_{product}_{metric}", "_{resolution}_{v}.tif" ) - file <- file.path(species_path, "weekly", file) + key <- status_key(species_code, "weekly", file) } else { # assess which metric is being requested if (is.null(metric)) { metric <- "mean" } if (!metric %in% c("mean", "max")) { - stop("Valid metrics for seasonal or full-year data are 'mean' or 'max.'") + stop("Valid metrics for seasonal or full-year data are 'mean' or 'max'.") } # construct filename @@ -195,38 +176,19 @@ load_raster <- function( "{species_code}_{product}_{period}_{metric}", "_{resolution}_{v}.tif" ) - file <- file.path(species_path, "seasonal", file) + key <- status_key(species_code, "seasonal", file) } # download the requested product on demand if it isn't already present - status_dl_flag <- switch( - product, - "abundance" = "download_abundance", - "proportion-population" = "download_abundance", - "count" = "download_count", - "occurrence" = "download_occurrence" - ) - fetch_if_missing( - target = file, + local_file <- fetch_data( + key, + path = path, force = force, - downloader = function() { - dl_args <- list( - species = species_code, - path = path, - pattern = stringr::str_escape(basename(file)), - force = force, - show_progress = show_progress - ) - dl_args[[status_dl_flag]] <- TRUE - do.call(ebirdst_download_status, dl_args) - } + show_progress = show_progress ) - if (!file.exists(file)) { - stop("The file for the requested product does not exist: \n ", file) - } # load and return raster stack - return(terra::rast(file)) + return(terra::rast(local_file)) } @@ -322,11 +284,6 @@ load_trends <- function( stopifnot(is_flag(fold_estimates)) stopifnot(is_flag(force), is_flag(show_progress)) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - v <- ebirdst_version()[["trends_version_year"]] # trends species and seaons @@ -343,15 +300,8 @@ load_trends <- function( ) } - # get paths to trends parquet files - trends_paths <- character() - for (i in seq_along(species_code)) { - p <- get_species_path( - species_code[i], - path = path, - dataset = "trends", - check_downloaded = FALSE - ) + # construct keys for trends parquet files + build_trends_path <- function(i) { if (fold_estimates) { f <- stringr::str_glue( "{species_code[i]}_{season[i]}_ebird-trends_", @@ -363,40 +313,33 @@ load_trends <- function( "{v}.parquet" ) } - trends_paths <- c(trends_paths, file.path(p, "trends", f)) + return(file.path(path, trends_key(species_code[i], "trends", f))) } + trends_paths <- vapply( + seq_along(species_code), + build_trends_path, + FUN.VALUE = character(1) + ) # download trends data on demand for any species not already present - fetch_if_missing( - target = trends_paths, - force = force, - downloader = function() { - to_download <- if (isTRUE(force)) { - species_code - } else { - species_code[!file.exists(trends_paths)] - } - ebirdst_download_trends( - to_download, - path = path, - force = force, - show_progress = show_progress - ) - } - ) - if (!all(file.exists(trends_paths))) { - stop( - "Trends data could not be found for the following species:\n ", - paste(species[!file.exists(trends_paths)], collapse = ", ") + ensure_data_dir(path) + if (isTRUE(force)) { + missing <- species_code + } else { + missing <- species_code[!file.exists(trends_paths)] + } + if (length(missing) > 0) { + ebirdst_download_trends( + missing, + path = path, + force = force, + show_progress = show_progress ) } # load data - trends <- NULL - for (pq in trends_paths) { - trends <- dplyr::bind_rows(trends, arrow::read_parquet(pq)) - } - return(trends) + trends <- lapply(trends_paths, arrow::read_parquet) + return(dplyr::bind_rows(trends)) } @@ -410,11 +353,11 @@ load_trends <- function( #' #' @param product character; data coverage raster product to load: spatial #' coverage or site selection probability. -#' @param weeks character; one or more weeks (expressed in `"MM-DD"` format) to -#' load the raster layers for. If this argument is not specified, all -#' downloaded weeks will be loaded. **Note that these rasters are quite large -#' so it's recommended to only load a small number of weeks of data at the -#' same time.** +#' @param weeks character; one or more of the 52 weeks (expressed in `"MM-DD"` +#' format) to load the raster layers for. Layers are always returned in +#' chronological order regardless of the order given here. **Note that these +#' rasters are quite large (roughly 50 MB per week) so it's recommended to +#' only load a small number of weeks of data at the same time.** #' @inheritParams ebirdst_download_status #' #' @details In addition to the species-specific data products, the eBird Status @@ -440,7 +383,7 @@ load_trends <- function( #' # load a single week of site selection probability data #' load_data_coverage("selection-probability", weeks = "01-04") #' -#' # load all weeks of spatial coverage data +#' # load multiple weeks of spatial coverage data #' load_data_coverage("spatial-coverage", weeks = c("01-04", "01-11")) #' } load_data_coverage <- function( @@ -450,49 +393,33 @@ load_data_coverage <- function( force = FALSE, show_progress = interactive() ) { - product <- match.arg(product) - stopifnot(!missing(weeks), is.character(weeks)) + stopifnot( + !missing(weeks), + is.character(weeks), + length(weeks) >= 1, + !anyNA(weeks) + ) stopifnot(is.character(path), length(path) == 1) stopifnot(is_flag(force), is_flag(show_progress)) + product <- match.arg(product) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - dc_path <- get_species_path( - "data_coverage", - path = path, - dataset = "status", - check_downloaded = FALSE - ) - - # check that the geotiff driver is installed - drv <- terra::gdal(drivers = TRUE) - drv <- drv$name[stringr::str_detect(drv$can, "read")] - if (!"GTiff" %in% drv) { - stop( - "GDAL does not have GeoTIFF support. GeoTIFF support is required to ", - "load Status and Trends raster data." - ) - } + check_gtiff_support() # generate vector of valid weeks valid_weeks <- as.Date(paste(2018, seq(4, 366, 7)), format = "%Y %j") valid_weeks <- format(valid_weeks, format = "%m-%d") - if (!is.null(weeks) && !all(weeks %in% valid_weeks)) { + if (!all(weeks %in% valid_weeks)) { stop( "The following weeks are invalid: ", - paste(weeks[!weeks %in% valid_weeks], collapse = ", "), + paste(unique(weeks[!weeks %in% valid_weeks]), collapse = ", "), "\n", "Valid weeks include: ", paste(valid_weeks, collapse = ", ") ) } - # subset to selected weeks - if (!is.null(weeks)) { - valid_weeks <- intersect(valid_weeks, weeks) - } + + # subset to selected weeks, keeping them in chronological order + valid_weeks <- intersect(valid_weeks, weeks) valid_weeks <- paste( ebirdst_version()[["status_version_year"]], valid_weeks, @@ -502,35 +429,17 @@ load_data_coverage <- function( # construct filenames product <- paste0(product, "_mean") files <- stringr::str_glue("{product}_{valid_weeks}.tif") - files <- file.path(dc_path, product, files) # download the requested weeks on demand if they aren't already present - fetch_if_missing( - target = files, + local_files <- fetch_data( + status_key("data_coverage", product, files), + path = path, force = force, - downloader = function() { - to_download <- if (isTRUE(force)) files else files[!file.exists(files)] - pattern <- paste( - stringr::str_escape(basename(to_download)), - collapse = "|" - ) - ebirdst_download_data_coverage( - path = path, - pattern = pattern, - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress ) - if (!all(file.exists(files))) { - stop( - "The files for the requested product could not be found:\n ", - paste(basename(files[!file.exists(files)]), collapse = "\n ") - ) - } # load and return raster stack - return(stats::setNames(terra::rast(files), valid_weeks)) + return(stats::setNames(terra::rast(local_files), valid_weeks)) } @@ -546,7 +455,7 @@ load_data_coverage <- function( #' @param smoothed logical; whether smoothed or unsmoothed ranges should be #' loaded. #' -#' @return An `sf` update containing the seasonal range boundaries, with each +#' @return An `sf` object containing the seasonal range boundaries, with each #' season provided as a different feature. #' @export #' @@ -569,22 +478,11 @@ load_ranges <- function( ) { stopifnot(is.character(species), length(species) == 1) stopifnot(is.character(path), length(path) == 1) - stopifnot(is.logical(smoothed), length(smoothed) == 1) + stopifnot(is_flag(smoothed)) stopifnot(is_flag(force), is_flag(show_progress)) resolution <- match.arg(resolution) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - species_code <- get_species(species) - species_path <- get_species_path( - species, - path = path, - dataset = "status", - check_downloaded = FALSE - ) + species_code <- resolve_species(species) # load config file, downloading it on demand if necessary p <- load_config( @@ -607,29 +505,17 @@ load_ranges <- function( "{species_code}_range_{label}", "_{resolution}_{v}.gpkg" ) - file <- file.path(species_path, "ranges", file) # download the ranges on demand if they aren't already present - fetch_if_missing( - target = file, + local_file <- fetch_data( + status_key(species_code, "ranges", file), + path = path, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_ranges = TRUE, - pattern = stringr::str_escape(basename(file)), - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress ) - if (!file.exists(file)) { - stop("The file for the requested product does not exist: \n ", file) - } # load polygons - p <- sf::read_sf(dsn = file, layer = "range") + p <- sf::read_sf(dsn = local_file, layer = "range") return(p) } @@ -689,38 +575,16 @@ load_regional_stats <- function( stopifnot(is.character(path), length(path) == 1) stopifnot(is_flag(force), is_flag(show_progress)) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - species_code <- get_species(species) - species_path <- get_species_path( - species, - path = path, - dataset = "status", - check_downloaded = FALSE - ) + species_code <- resolve_species(species) # download the regional stats on demand if they aren't already present - file <- file.path(species_path, "regional_stats.csv") - fetch_if_missing( - target = file, + file <- fetch_data( + status_key(species_code, "regional_stats.csv"), + path = path, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_regional = TRUE, - pattern = "regional_stats.csv", - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress ) - if (!file.exists(file)) { - stop("The regional summary stats file could not be found for this species.") - } + # load stats stats <- dplyr::as_tibble(utils::read.csv(file, na = "", row.names = NULL)) stats[["region_area_km2"]] <- NULL @@ -763,38 +627,21 @@ ebirdst_regional_stats <- function( stopifnot(is_flag(force)) stopifnot(is_flag(show_progress)) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - # the regional stats file is stored at the annual results level, named for # the status data version year version_year <- ebirdst_version()[["status_version_year"]] - obj_key <- file.path( + key <- file.path( version_year, sprintf("regional-stats_%s.parquet", version_year) ) - dest_path <- file.path(path, obj_key) # download the file on demand if it isn't already present - if (!file.exists(dest_path) || force) { - if (show_progress) { - message("Downloading regional stats for all species") - } - - # build the fetch url and download using the shared download machinery - key <- get_ebirdst_access_key() - api_url <- "https://st-download.ebird.org/v1" - files <- data.frame(file = obj_key) - files$src_path <- stringr::str_glue( - "{api_url}/fetch?objKey={obj_key}", - "&key={key}" - ) - files$dest_path <- dest_path - files$exists <- file.exists(dest_path) - download_files(files, force = force, show_progress = show_progress) - } + dest_path <- fetch_data( + key, + path = path, + force = force, + show_progress = show_progress + ) # load stats stats <- dplyr::as_tibble(arrow::read_parquet(dest_path)) @@ -831,39 +678,16 @@ load_config <- function( stopifnot(is.character(path), length(path) == 1) stopifnot(is_flag(force), is_flag(show_progress)) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } + species_code <- resolve_species(species) - species_code <- get_species(species) - species_path <- get_species_path( - species, + # download the config file on demand if it isn't already present + cfg_file <- fetch_data( + status_key(species_code, "config.json"), path = path, - dataset = "status", - check_downloaded = FALSE - ) - - # download the config file on demand if it isn't already present; passing - # download_abundance = FALSE with no other product selected downloads only - # config.json - cfg_file <- file.path(species_path, "config.json") - fetch_if_missing( - target = cfg_file, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_abundance = FALSE, - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress ) - if (!file.exists(cfg_file)) { - stop("The file 'config.json' does not exist in: ", species_path) - } + # load configuration file p <- jsonlite::read_json(cfg_file, simplifyVector = TRUE) names(p) <- tolower(names(p)) @@ -892,7 +716,7 @@ load_config <- function( #' - `fa_extent_projected`: the extent in projected (Equal Earth) coordinates #' - `weekly_bins`/`weekly_labels`: weekly abundance bins and labels for the #' full annual cycle -#' - `seasonal_bins`/`seasonal_labels: seasonal abundance bins and labels for +#' - `seasonal_bins`/`seasonal_labels`: seasonal abundance bins and labels for #' the full annual cycle #' #' @export @@ -916,7 +740,7 @@ load_fac_map_parameters <- function( stopifnot(is_flag(force), is_flag(show_progress)) # load config file, downloading it on demand if necessary - species_code <- get_species(species) + species_code <- resolve_species(species) p <- load_config( species = species_code, path = path, @@ -925,7 +749,7 @@ load_fac_map_parameters <- function( ) ext_order <- unlist(p$bbox_native)[c("xmin", "xmax", "ymin", "ymax")] - list( + return(list( custom_projection = p$projection$crs, fa_extent = terra::ext(p$projection$extent), res = p$projection$res, @@ -934,7 +758,7 @@ load_fac_map_parameters <- function( weekly_labels = p$bins[["3km"]]$labels, seasonal_bins = p$bins_seasonal[["3km"]]$breaks, seasonal_labels = p$bins_seasonal[["3km"]]$labels - ) + )) } @@ -946,12 +770,12 @@ load_fac_map_parameters <- function( #' a rank of 1 being the most important) relative to the full suite of #' environmental predictors. The ranks are summarized to a 27 km resolution #' raster grid for each predictor, where the cell values are the average across -#' all models in the ensemble contributing to that cell. These data are -#' available in raster format provided `download_pis = TRUE` was used when -#' calling [ebirdst_download_status()]. PI estimates are available separately -#' for both the occurrence and count sub-model and only the 30 most important -#' predictors are distributed. Use [list_available_pis()] to see which -#' predictors have PI data. +#' all models in the ensemble contributing to that cell. If the requested data +#' have not already been downloaded, they will be downloaded automatically on +#' first use. PI estimates are available separately for both the occurrence +#' and count sub-model and only the 30 most important predictors are +#' distributed. Use [list_available_pis()] to see which predictors have PI +#' data. #' #' @inheritParams load_raster #' @param predictor character; the predictor that the PI data should be loaded @@ -975,10 +799,8 @@ load_fac_map_parameters <- function( #' #' @examples #' \dontrun{ -#' # download example data if hasn't already been downloaded -#' ebirdst_download_status("yebsap-example", download_pis = TRUE) -#' #' # identify the top predictor +#' # data will be downloaded automatically if not already present #' top_preds <- list_available_pis("yebsap-example") #' print(top_preds[1, ]) #' @@ -998,55 +820,28 @@ load_pi <- function( stopifnot(is_flag(force), is_flag(show_progress)) response <- match.arg(response) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - species_code <- get_species(species) - species_path <- get_species_path( - species, - path = path, - dataset = "status", - check_downloaded = FALSE - ) + species_code <- resolve_species(species) # construct file name; load_config() downloads config on demand and provides # the data version year year <- load_config( - species = species, + species = species_code, path = path, force = force, show_progress = show_progress )[["srd_pred_year"]] p <- stringr::str_replace_all(predictor, "_", "-") tif <- stringr::str_glue("{species_code}_pi_{response}_{p}_27km_{year}.tif") - tif <- file.path(species_path, "pis", tif) # download the requested PI raster on demand if it isn't already present - fetch_if_missing( - target = tif, + local_tif <- fetch_data( + status_key(species_code, "pis", tif), + path = path, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_pis = TRUE, - pattern = stringr::str_escape(basename(tif)), - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress, + hint = "To list predictors that have PI data use list_available_pis()." ) - if (!file.exists(tif)) { - stop( - "GeoTIFF for ", - predictor, - " PI could not be found. To list predictors that have PI data use ", - "list_available_pis()." - ) - } - return(terra::rast(tif)) + return(terra::rast(local_tif)) } @@ -1063,47 +858,20 @@ list_available_pis <- function( stopifnot(is.character(path), length(path) == 1) stopifnot(is_flag(force), is_flag(show_progress)) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } + species_code <- resolve_species(species) - species_code <- get_species(species) - species_path <- get_species_path( - species, + # download the pi rank csv on demand if it isn't already present; this does + # not require downloading any of the pi rasters themselves + csv_file <- fetch_data( + status_key(species_code, "pis", "pi_rangewide.csv"), path = path, - check_downloaded = FALSE - ) - - # download the PI data on demand if not already present; the full set of PI - # files is needed to list the available predictors - csv_file <- file.path(species_path, "pis", "pi_rangewide.csv") - fetch_if_missing( - target = csv_file, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_abundance = FALSE, - download_pis = TRUE, - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress ) - if (!file.exists(csv_file)) { - stop("The PI data could not be found for this species.") - } - # load ranks ranks <- utils::read.csv(csv_file, row.names = NULL, na = "") - # available pis - tifs <- list.files(file.path(species_path, "pis"), pattern = "*.tif") - tifs <- tifs[!stringr::str_detect(tifs, "n-folds")] - preds <- stringr::str_remove(tifs, "^[^_]+_pi_(occurrence|count)_") - preds <- stringr::str_extract(preds, "[-a-z0-9]+") - preds <- unique(stringr::str_replace_all(preds, "-", "_")) + # identify which of the ranked predictors have pi rasters available + preds <- available_pi_predictors(species_code, path = path) preds <- preds[preds %in% ranks$predictor] # return ranks @@ -1120,9 +888,9 @@ list_available_pis <- function( #' during model training and a suite of predictive performance metrics (PPMs) #' are calculated. The PPMs for each base model are summarized to a 27 km #' resolution raster grid, where the cell values are the average across all -#' models in the ensemble contributing to that cell. These data are available in -#' raster format provided `download_ppms = TRUE` was used when calling -#' [ebirdst_download_status()]. +#' models in the ensemble contributing to that cell. If the requested data have +#' not already been downloaded, they will be downloaded automatically on first +#' use. #' #' @inheritParams load_raster #' @param ppm character; the name of a single metric to load data for. See @@ -1194,10 +962,8 @@ list_available_pis <- function( #' #' @examples #' \dontrun{ -#' # download example data if hasn't already been downloaded -#' ebirdst_download_status("yebsap-example", download_ppms = TRUE) -#' #' # load area under the precision-recall curve PPM raster +#' # data will be downloaded automatically if not already present #' load_ppm("yebsap-example", ppm = "binary_pr_auc") #' } load_ppm <- function( @@ -1232,64 +998,92 @@ load_ppm <- function( stopifnot(is_flag(force), is_flag(show_progress)) ppm <- match.arg(ppm) - # create the data directory if needed so data can be downloaded on demand - if (!dir.exists(path)) { - dir.create(path, recursive = TRUE, showWarnings = FALSE) - } - - species_code <- get_species(species) - species_path <- get_species_path( - species, - path = path, - dataset = "status", - check_downloaded = FALSE - ) + species_code <- resolve_species(species) # construct file name; load_config() downloads config on demand and provides # the data version year year <- load_config( - species = species, + species = species_code, path = path, force = force, show_progress = show_progress )[["srd_pred_year"]] p <- stringr::str_replace_all(ppm, "_", "-") tif <- stringr::str_glue("{species_code}_ppm_{p}_mean_27km_{year}.tif") - tif <- file.path(species_path, "ppms", tif) # download on demand if the file isn't already present - fetch_if_missing( - target = tif, + local_tif <- fetch_data( + status_key(species_code, "ppms", tif), + path = path, force = force, - downloader = function() { - ebirdst_download_status( - species_code, - path = path, - download_ppms = TRUE, - pattern = stringr::str_escape(basename(tif)), - force = force, - show_progress = show_progress - ) - } + show_progress = show_progress, + hint = "GeoTIFF for this PPM could not be found for this species." ) - if (!file.exists(tif)) { - stop("GeoTIFF for ", ppm, " PPM could not be found for this species.") - } - return(terra::rast(tif)) + return(terra::rast(local_tif)) } # internal ---- -# download a data product on demand when its file(s) are not already present, -# so that load_*() functions fetch missing data transparently instead of -# erroring. `target` is one or more file paths, `downloader` is a zero-argument -# function that downloads the missing data. returns TRUE if a download was -# attempted -fetch_if_missing <- function(target, downloader, force = FALSE) { - if (!isTRUE(force) && all(file.exists(target))) { - return(invisible(FALSE)) +# check that the geotiff driver is installed; required to load any of the +# raster data products +check_gtiff_support <- function() { + drv <- terra::gdal(drivers = TRUE) + drv <- drv$name[stringr::str_detect(drv$can, "read")] + if (!"GTiff" %in% drv) { + stop( + "GDAL does not have GeoTIFF support. GeoTIFF support is required to ", + "load Status and Trends raster data." + ) } - downloader() return(invisible(TRUE)) } + + +# identify which predictors have pi rasters available for a species. the remote +# listing is the authoritative source because it covers every raster in the data +# package rather than just the ones already downloaded, so it's only bypassed +# when it can't be reached, e.g. offline or with an expired access key. in that +# case the files already on disk are all there is to go on and the answer may be +# incomplete, so the failure is reported rather than silently swallowed. +# filtering on "_pi_(occurrence|count)_" excludes the other tifs that live +# alongside the pi rasters in the pis/ directory, e.g. n-folds-modeled, +# start_day_of_year, end_day_of_year +available_pi_predictors <- function(species_code, path) { + pi_pattern <- "_pi_(occurrence|count)_" + + listing <- tryCatch( + list_object_keys(species_code, dataset = "status"), + error = function(e) e + ) + + if (inherits(listing, "error")) { + pis_path <- file.path(path, status_key(species_code, "pis")) + tifs <- list.files(pis_path, pattern = paste0(pi_pattern, ".*\\.tif$")) + + # with no listing and nothing downloaded there's no basis for an answer, so + # report the underlying problem instead of an empty result + if (length(tifs) == 0) { + stop( + "The predictors with PI data could not be determined because the list ", + "of available data could not be accessed:\n ", + conditionMessage(listing) + ) + } + warning( + "The list of available data could not be accessed, so only PI data that ", + "has already been downloaded is reported and the list may be ", + "incomplete. The following error occurred:\n ", + conditionMessage(listing), + call. = FALSE + ) + } else { + keys <- listing[stringr::str_detect(listing, "/pis/")] + tifs <- basename(keys[stringr::str_detect(basename(keys), pi_pattern)]) + } + + preds <- stringr::str_remove(tifs, paste0("^[^_]+", pi_pattern)) + preds <- stringr::str_extract(preds, "[-a-z0-9]+") + preds <- unique(stringr::str_replace_all(preds, "-", "_")) + return(preds) +} diff --git a/R/manage.R b/R/manage.R index 0b0fa7f..2fe5a9a 100644 --- a/R/manage.R +++ b/R/manage.R @@ -55,7 +55,11 @@ ebirdst_data_inventory <- function(path = ebirdst_data_dir()) { for (sp_dir in sp_dirs) { sp_code <- basename(sp_dir) + + # a partial download left behind by a session that was killed mid-transfer + # isn't data, so it shouldn't be counted or have its size reported all_files <- list.files(sp_dir, recursive = TRUE, full.names = TRUE) + all_files <- all_files[!is_partial_download(all_files)] # files in the trends/ subdirectory are trends data products; all others # are status data products @@ -66,6 +70,7 @@ ebirdst_data_inventory <- function(path = ebirdst_data_dir()) { recursive = TRUE, full.names = TRUE ) + trends_files <- trends_files[!is_partial_download(trends_files)] } else { trends_files <- character(0) } @@ -171,7 +176,7 @@ ebirdst_delete <- function( stopifnot(is.character(path), length(path) == 1) stopifnot(is_flag(force)) if (!is.null(species)) { - stopifnot(is.character(species), length(species) >= 1) + stopifnot(is.character(species), length(species) >= 1, !anyNA(species)) } if (!is.null(year)) { stopifnot(is_integer(year), length(year) >= 1, all(year > 0)) @@ -217,8 +222,9 @@ ebirdst_delete <- function( return(invisible(character(0))) } - # build unique target directories (one per species-year regardless of dataset, - # since both status and trends data reside in the same directory) + # build unique target directories (one per species-year regardless of + # dataset, since status and trends data for the same species/year would + # both reside in the same directory if their version years ever coincide) target_dirs <- unique(file.path(path, inv$version_year, inv$species_code)) # safety check: all targets must be within the base path @@ -267,6 +273,11 @@ ebirdst_delete <- function( } } + # only report the size of directories that were actually deleted, in case + # unlink() failed for some targets + inv_dirs <- file.path(path, inv$version_year, inv$species_code) + deleted_size_mb <- sum(inv$size_mb[inv_dirs %in% deleted_paths]) + # remove any year directories that are now empty affected_years <- unique(file.path(path, inv$version_year)) for (yr_dir in affected_years) { @@ -287,7 +298,7 @@ ebirdst_delete <- function( " director", if (length(deleted_paths) == 1) "y" else "ies", " (", - format_size(sum(inv$size_mb) * 1e6), + format_size(deleted_size_mb * 1e6), ")." ) return(invisible(deleted_paths)) @@ -348,12 +359,12 @@ print.ebirdst_inventory <- function(x, ...) { format_size <- function(bytes) { if (bytes >= 1e9) { - sprintf("%.1f GB", bytes / 1e9) + return(sprintf("%.1f GB", bytes / 1e9)) } else if (bytes >= 1e6) { - sprintf("%.1f MB", bytes / 1e6) + return(sprintf("%.1f MB", bytes / 1e6)) } else if (bytes >= 1e3) { - sprintf("%.1f KB", bytes / 1e3) + return(sprintf("%.1f KB", bytes / 1e3)) } else { - sprintf("%.0f B", bytes) + return(sprintf("%.0f B", bytes)) } } diff --git a/R/sample.R b/R/sample.R index 6d035d9..8c8b25d 100644 --- a/R/sample.R +++ b/R/sample.R @@ -356,7 +356,7 @@ grid_sample_stratified <- function( # project once now to avoid having to do it for every stratum if (is_lonlat) { - xy <- project_equal_area(locs, coords = coords[1:2]) + xy <- project_equal_area(locs, coords = coords[seq_len(2)]) # add time dimension if (length(coords) == 3) { xy[["t"]] <- locs[[coords[3]]] @@ -434,8 +434,7 @@ grid_sample_stratified <- function( } # subsample to decrease sample size to maximum - # TODO consider adding && nrow(sampled) > maximum_ss here - if (!is.null(maximum_ss)) { + if (!is.null(maximum_ss) && nrow(sampled) > maximum_ss) { sample_prop <- maximum_ss / nrow(sampled) if (case_control) { # case control sampling on: sample preserving detection probability @@ -754,7 +753,7 @@ safe_sample <- function(x, size, ...) { if (length(x) <= size || length(x) == 1) { return(x) } - sample(x, size = size, ...) + return(sample(x, size = size, ...)) } sample_stratify <- function(x, prop, sample_by) { @@ -773,7 +772,7 @@ sample_stratify <- function(x, prop, sample_by) { n = size, SIMPLIFY = FALSE ) - dplyr::bind_rows(sampled) + return(dplyr::bind_rows(sampled)) } # cap the number of observations contributed by each spatial grid cell at the diff --git a/R/trends.R b/R/trends.R index 71e3299..254cce7 100644 --- a/R/trends.R +++ b/R/trends.R @@ -17,7 +17,6 @@ #' #' @return A [SpatRaster][terra::SpatRaster] object. #' @export -#' #' @examples #' \dontrun{ #' # download example trends data if it hasn't already been downloaded @@ -152,9 +151,8 @@ rasterize_trends <- function( #' equal area CRS you intend to use when mapping the data otherwise the #' "circles" will appear skewed. #' -#' @returns Vectorized trends data as an [sf][sf::sf] object. +#' @return Vectorized trends data as an [sf][sf::sf] object. #' @export -#' #' @examples #' \dontrun{ #' # download example trends data if it hasn't already been downloaded @@ -220,7 +218,7 @@ vectorize_trends <- function( trends_pts <- dplyr::bind_rows(trends_pts) # buffer based on radius - sf::st_buffer(trends_pts, dist = trends_pts$radii) + return(sf::st_buffer(trends_pts, dist = trends_pts$radii)) } @@ -234,14 +232,13 @@ vectorize_trends <- function( #' cumulative trend resulting from `n_years` years of compounding annual #' trend. #' @export -#' #' @examples #' ppy_trend <- runif(100, min = -100, 100) #' cumulative_trend <- convert_ppy_to_cumulative(ppy_trend, n_years = 5) #' cbind(ppy_trend, cumulative_trend) convert_ppy_to_cumulative <- function(x, n_years) { stopifnot(is.numeric(x), is_count(n_years)) - 100 * ((1 + x / 100)^n_years - 1) + return(100 * ((1 + x / 100)^n_years - 1)) } @@ -258,7 +255,7 @@ trends_raster_template <- function() { "+proj=sinu +lon_0=0 +x_0=0 +y_0=0", "+R=6371007.181 +units=m +no_defs" )) - terra::rast(e, crs = crs, nrows = 626L, ncols = 1502L) + return(terra::rast(e, crs = crs, nrows = 626L, ncols = 1502L)) } categorize <- function(x, breaks, labels) { @@ -268,7 +265,7 @@ categorize <- function(x, breaks, labels) { is.numeric(labels) || is.character(labels), length(labels) == length(breaks) - 1 ) - y <- cut(x, breaks) + y <- cut(x, breaks, include.lowest = TRUE) lvl <- levels(y) - labels[match(y, lvl)] + return(labels[match(y, lvl)]) } diff --git a/R/utils.R b/R/utils.R index 8956c17..7ecda57 100644 --- a/R/utils.R +++ b/R/utils.R @@ -118,7 +118,15 @@ get_species <- function(x) { # internal ---- is_integer <- function(x) { - return(isTRUE(is.integer(x) || (is.numeric(x) && all(x == as.integer(x))))) + # the range check has to come before as.integer(), which warns when it + # introduces NAs for values outside the range of an integer + return(isTRUE( + is.numeric(x) && + !anyNA(x) && + all(is.finite(x)) && + all(abs(x) <= .Machine$integer.max) && + all(x == as.integer(x)) + )) } is_count <- function(x) { diff --git a/cran-comments.md b/cran-comments.md index 9e3b824..1502584 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,12 +1,13 @@ -# ebirdst 4.2023.0 +# ebirdst 4.2023.1 -- Transition to having all the `load_*()` functions download directly rather than having to call `ebirdst_download_status()` -- Converted vignettes to Quarto and moved them to website-only pkgdown articles; the package no longer ships built-in vignettes to CRAN (documentation lives at ) -- Add `ebirdst_regional_stats()` to load regional summary statistics for all species -- Add `ebirdst_data_inventory()` and `ebirdst_delete()` to manage files downloaded by `ebirdst` -- Move to air auto-formatting and jarl linting -- Efficiency improvements for `grid_sample()` -- `grid_sample_stratified()` gains a `cell_quantile_cap` argument to limit how many observations a single chronically over-sampled site (e.g. a bird feeder) can contribute +- Removed all functions previously listed as deprecated or defunct; they have been unavailable or erroring since at least v3.2022.1 +- Backend approach to file download has been refactored to an on-demand first approach +- `list_available_pis()` no longer downloads every predictor importance raster to determine availability, only `pi_rangewide.csv` +- Files are now downloaded to a temporary file and only moved into place once the transfer completes, so an interrupted download can no longer leave a partial file behind +- The http fallback for VPNs that block https now also applies to file downloads, not just file listings, and is only attempted when https fails to reach the server at all +- The access key, which is passed to the API in the query string of the request URL, is now redacted from download error messages so users reporting a problem don't inadvertently share it +- Errors for data that can't be found on-demand now include function-specific guidance, e.g. pointing to `list_available_pis()` +- `vectorize_trends()` now assigns the smallest circle radius to locations with zero relative abundance, which previously got a missing radius ## Test environments @@ -20,7 +21,7 @@ 0 errors | 0 warnings | 1 notes -- NOTE: Version contains large components (4.2023.0). We've aligned our version numbers with the version numbers for the API that this package interacts with. The eBird Status and Trends data products are given a version corresponding to a year, with the current version being 2022, so we've included that year in our version number to indicate that this package only works with the 2023 version of the data. +- NOTE: Version contains large components (4.2023.1). We've aligned our version numbers with the version numbers for the API that this package interacts with. The eBird Status and Trends data products are given a version corresponding to a year, with the current version being 2023, so we've included that year in our version number to indicate that this package only works with the 2023 version of the data. ## revdepcheck results diff --git a/docs/404.html b/docs/404.html index ea3321f..00c49b4 100644 --- a/docs/404.html +++ b/docs/404.html @@ -20,7 +20,7 @@ ebirdst - 4.2023.0 + 4.2023.1 - - - - - -
-
-
- -
-

This deprecated function has been replaced by ebirdst_palettes. -Both functions generate color palettes used for the eBird Status and Trends -relative abundance maps.

-
- -
-

Usage

-
abundance_palette(n,
-                        season = c("weekly", "breeding",
-                                   "nonbreeding",
-                                   "migration",
-                                   "prebreeding_migration",
-                                   "postbreeding_migration",
-                                   "year_round"))
-
- -
-

Arguments

- - -
n
-

integer; the number of colors to be in the palette.

- - -
season
-

character; the season to generate colors for or "weekly" to -get the color palette used in the weekly abundance animations.

- -
-
-

Value

-

A character vector of hex color codes.

-
- - -
- - -
- - - - - - - diff --git a/docs/reference/abundance_palette-deprecated.md b/docs/reference/abundance_palette-deprecated.md deleted file mode 100644 index ed81d23..0000000 --- a/docs/reference/abundance_palette-deprecated.md +++ /dev/null @@ -1,38 +0,0 @@ -# eBird Status and Trends color palettes for mapping - -This deprecated function has been replaced by -[`ebirdst_palettes`](https://ebird.github.io/ebirdst/reference/ebirdst_palettes.md). -Both functions generate color palettes used for the eBird Status and -Trends relative abundance maps. - -## Usage - -``` r -abundance_palette(n, - season = c("weekly", "breeding", - "nonbreeding", - "migration", - "prebreeding_migration", - "postbreeding_migration", - "year_round")) -``` - -## Arguments - -- n: - - integer; the number of colors to be in the palette. - -- season: - - character; the season to generate colors for or "weekly" to get the - color palette used in the weekly abundance animations. - -## Value - -A character vector of hex color codes. - -## See also - -[`ebirdst_palettes`](https://ebird.github.io/ebirdst/reference/ebirdst_palettes.md) -[`ebirdst-deprecated`](https://ebird.github.io/ebirdst/reference/ebirdst-deprecated.md) diff --git a/docs/reference/abundance_palette.html b/docs/reference/abundance_palette.html deleted file mode 100644 index 694368b..0000000 --- a/docs/reference/abundance_palette.html +++ /dev/null @@ -1,8 +0,0 @@ - - - - - - - - diff --git a/docs/reference/assign_to_grid.html b/docs/reference/assign_to_grid.html index bcc27a9..84f5dc7 100644 --- a/docs/reference/assign_to_grid.html +++ b/docs/reference/assign_to_grid.html @@ -9,7 +9,7 @@ ebirdst - 4.2023.0 + 4.2023.1 - - - - - -
-
-
- -
-

The functions listed below are defunct and no longer supported. -Calling them will result in an error.

-

When possible alternative functions are suggested.

-

Many of them supported stixles which were infrequently used and were -dropped from ebirdst with the 2022 data release.

-
- -
-

Usage

-
ebirdst_download(
-  species,
-  path = ebirdst_data_dir(),
-  tifs_only = TRUE,
-  force = FALSE,
-  show_progress = TRUE,
-  pattern = NULL,
-  dry_run = FALSE
-)
-
-ebirdst_extent(x, t, ...)
-
-ebirdst_habitat(path, ext, data = NULL, stationary_associations = FALSE)
-
-ebirdst_ppms(path, ext, es_cutoff, pat_cutoff)
-
-ebirdst_ppms_ts(ath, ext, summarize_by = c("weeks", "months"), ...)
-
-ebirdst_subset(x, crs)
-
-load_pds(path, ext, model = c("occurrence", "count"), return_sf = FALSE)
-
-load_pis(path, ext, model = c("occurrence", "count"), return_sf = FALSE)
-
-load_predictions(path, return_sf = FALSE)
-
-parse_raster_dates(x)
-
-load_stixels(path, ext, return_sf = FALSE)
-
-project_extent(x, crs)
-
-plot_pds(path, ext, summarize_by = c("weeks", "months"), ...)
-
-plot_pis(
-  pis,
-  ext,
-  by_cover_class = TRUE,
-  n_top_pred = 15,
-  pretty_names = TRUE,
-  plot = TRUE
-)
-
-stixelize(x)
-
- -
-

Arguments

- - -
...
-

All arguments are now ignored.

- -
- -
- - -
- - - - - - - diff --git a/docs/reference/ebirdst-defunct.md b/docs/reference/ebirdst-defunct.md deleted file mode 100644 index 94974c8..0000000 --- a/docs/reference/ebirdst-defunct.md +++ /dev/null @@ -1,64 +0,0 @@ -# Defunct functions in package ebirdst. - -The functions listed below are defunct and no longer supported. Calling -them will result in an error. - -When possible alternative functions are suggested. - -Many of them supported stixles which were infrequently used and were -dropped from ebirdst with the 2022 data release. - -## Usage - -``` r -ebirdst_download( - species, - path = ebirdst_data_dir(), - tifs_only = TRUE, - force = FALSE, - show_progress = TRUE, - pattern = NULL, - dry_run = FALSE -) - -ebirdst_extent(x, t, ...) - -ebirdst_habitat(path, ext, data = NULL, stationary_associations = FALSE) - -ebirdst_ppms(path, ext, es_cutoff, pat_cutoff) - -ebirdst_ppms_ts(ath, ext, summarize_by = c("weeks", "months"), ...) - -ebirdst_subset(x, crs) - -load_pds(path, ext, model = c("occurrence", "count"), return_sf = FALSE) - -load_pis(path, ext, model = c("occurrence", "count"), return_sf = FALSE) - -load_predictions(path, return_sf = FALSE) - -parse_raster_dates(x) - -load_stixels(path, ext, return_sf = FALSE) - -project_extent(x, crs) - -plot_pds(path, ext, summarize_by = c("weeks", "months"), ...) - -plot_pis( - pis, - ext, - by_cover_class = TRUE, - n_top_pred = 15, - pretty_names = TRUE, - plot = TRUE -) - -stixelize(x) -``` - -## Arguments - -- ...: - - All arguments are now ignored. diff --git a/docs/reference/ebirdst-deprecated.html b/docs/reference/ebirdst-deprecated.html deleted file mode 100644 index 986816a..0000000 --- a/docs/reference/ebirdst-deprecated.html +++ /dev/null @@ -1,91 +0,0 @@ - -Deprecated functions in package ebirdst. — ebirdst-deprecated • ebirdst - Skip to contents - - -
-
-
- -
-

The functions listed below are deprecated and support for them -will eventually be dropped. -Help pages for deprecated functions are -available at help("<function>-deprecated").

-
- -
-

Usage

-
abundance_palette(
-  n,
-  season = c("weekly", "breeding", "nonbreeding", "migration", "prebreeding_migration",
-    "postbreeding_migration", "year_round")
-)
-
- -
-

abundance_palette

- - -

For abundance_palette, use ebirdst_palettes

-
- -
- - -
- - - - - - - diff --git a/docs/reference/ebirdst-deprecated.md b/docs/reference/ebirdst-deprecated.md deleted file mode 100644 index 2324211..0000000 --- a/docs/reference/ebirdst-deprecated.md +++ /dev/null @@ -1,20 +0,0 @@ -# Deprecated functions in package ebirdst. - -The functions listed below are deprecated and support for them will -eventually be dropped. Help pages for deprecated functions are available -at `help("-deprecated")`. - -## Usage - -``` r -abundance_palette( - n, - season = c("weekly", "breeding", "nonbreeding", "migration", "prebreeding_migration", - "postbreeding_migration", "year_round") -) -``` - -## `abundance_palette` - -For `abundance_palette`, use -[`ebirdst_palettes`](https://ebird.github.io/ebirdst/reference/ebirdst_palettes.md) diff --git a/docs/reference/ebirdst-package.html b/docs/reference/ebirdst-package.html index 6e73dae..ca07caa 100644 --- a/docs/reference/ebirdst-package.html +++ b/docs/reference/ebirdst-package.html @@ -7,7 +7,7 @@ ebirdst - 4.2023.0 + 4.2023.1