diff --git a/.Rbuildignore b/.Rbuildignore index 2f2b71cf..ce848260 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -12,3 +12,5 @@ ^misc$ ^\.vscode$ ^[.]?air[.]toml$ +^\.positai$ +^\.claude$ diff --git a/.gitignore b/.gitignore index 158dae6d..cec39909 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,13 @@ docs misc cache rosm.cache -*.zip \ No newline at end of file +*.zip +testdir +.positai +vignettes/articles/modis +vignettes/articles/TerrainTiles +vignettes/articles/worldclim +vignettes/articles/daymet +modis +scanfi +daymet \ No newline at end of file diff --git a/CODE_DESIGN.md b/CODE_DESIGN.md index 786dd8e4..42b5411a 100644 --- a/CODE_DESIGN.md +++ b/CODE_DESIGN.md @@ -1,51 +1,59 @@ # naturecounts design principles ## Non-cloud data + - Put data required to precompile vignettes in the `misc` folder - This isn't uploaded to GitHub ## Locations + - API urls - are stored in `meta_info`, a tibble created in `data-raw/data_creation.R` - This is where you can change from main to sandbox versions - - https://naturecounts.ca/api vs. https://sandbox.naturecounts.ca/api - - To apply this you must **re-run** `data-raw/data_creation.R` and then - **re-load** the functions/package + - vs. + - To apply this you must **re-run** `data-raw/data_creation.R` and then **re-load** the functions/package ## Fields returned by the API #### Desired behaviour + Required and extra fields returned by the API are expected and treated, respectively, as follows: -Function | API Entry Point | Required fields | Extra fields ------------------- |-------------------------- | -------------------------- | ------------ -`nc_count()` | `data/list_collections` | `collection`, `nrecords` | Ignored -`nc_count()` | `data/list_permissions` | `collection`, `akn_level` | Ignored -`nc_count()` | `metadata/collections` | `collection`, `akn_level` | Ignored -`nc_permissions()` | `data/list_permissions` | `collection`, `akn_level` | Ignored -`srv_auth()` | `data/authenticate` | `token` | Ignored -`nc_data_dl()` | `data/release_request_id` | None (close request only) | Ignored -`nc_data_dl()` | `data/get_data` | Any | Added -`meta_XXX()` | `metadata/XXX` | Any | Added +| Function | API Entry Point | Required fields | Extra fields | +|----|----|----|----| +| `nc_count()` | `data/list_collections` | `collection`, `nrecords` | Ignored | +| `nc_count()` | `data/list_permissions` | `collection`, `akn_level` | Ignored | +| `nc_count()` | `metadata/collections` | `collection`, `akn_level` | Ignored | +| `nc_permissions()` | `data/list_permissions` | `collection`, `akn_level` | Ignored | +| `srv_auth()` | `data/authenticate` | `token` | Ignored | +| `nc_data_dl()` | `data/release_request_id` | None (close request only) | Ignored | +| `nc_data_dl()` | `data/get_data` | Any | Added | +| `meta_XXX()` | `metadata/XXX` | Any | Added | #### What will break the package -- Missing "Required fields" -- Missing/renamed "container" - Some API entry points return data in a container, for example, - - - `data/get_data` -> `results` (holds main data) - - `data/list_collections` -> `results` (holds counts); `request_id` (holds request id) - - `data/list_requests` -> `requests` (holds details on individual requests) + +- Missing "Required fields" + +- Missing/renamed "container"\ + Some API entry points return data in a container, for example, + + - `data/get_data` -\> `results` (holds main data) + - `data/list_collections` -\> `results` (holds counts); `request_id` (holds request id) + - `data/list_requests` -\> `requests` (holds details on individual requests) If these "containers" change names, the package will break. #### Coding Principles -- In package, after accessing the API, explictly `select()` the fields/columns expected. This way extra fields won't break existing code + +- In package, after accessing the API, explictly `select()` the fields/columns expected. This way extra fields won't break existing code - Missing fields **will** break the code, but at least they will break the code early! - Do **not** do this for data downloads (i.e. `nc_single_dl()` under `nc_data_dl()`) or metadata downloads (i.e. `meta_XXX()`) - **Unless**, using a `meta_XXX()` download internally. Then always `select()` the fields required ## Testing + - Tests are run using the user "testuser" - Locally password can be stored in .Renviron as naturecounts_testuser = PASSWORD - For remote testing, password is supplied as encrypted values +- Tests for covariate download and extraction functions are run using the EarthData user with email `rmacklin@birdscanada.org` and username `rdjmacklin_bc`. If Rory Macklin can't be contacted to access credentials, a new user can be made with necessary changes to `ed_email` argument in tests for `landcover_download()` and `vegetation_download()` and to `ed_username` argument in tests for `daymet_download()` , `daymet_request()` and `daymet_check()`. + - Locally, password can be stored in .Renviron as EarthData_password = PASSWORD or supplied via `askpass::askpass()` built into functions. diff --git a/DESCRIPTION b/DESCRIPTION index 945ffc6c..cd638569 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: naturecounts Type: Package Title: Access and download data on plant and animal populations from NatureCounts -Version: 0.5.0 +Version: 0.5.0.9000 Authors@R: c( person("Steffi", "LaZerte", email = "steffi@steffi.ca", role = "aut"), person("Denis", "Lepage", email = "dlepage@birdscanada.org", role = c("aut", "cre"))) @@ -35,19 +35,31 @@ Imports: units (>= 0.8.1), wk (>= 0.7.1) Suggests: + appeears, + elevatr, + exactextractr, + geodata, ggspatial (>= 1.1.10), here, knitr, + landscapemetrics, + luna (>= 0.4-1), mapview, + measurements, patchwork, prettymapr (>= 0.2.5), rmarkdown, rnaturalearth, rnaturalearthhires, + readr, rosm, roxygen2, sf (>= 1.0-9), + spData, spelling, + stats, + tidyterra, + terra, testthat, vdiffr Language: en-US @@ -58,6 +70,6 @@ URL: https://github.com/BirdsCanada/naturecounts, https://birdscanada.github.io/naturecounts/ VignetteBuilder: knitr Config/testthat/edition: 3 -Remotes: - ropensci/rnaturalearthhires, - wranglezone/tibblify +Remotes: ropensci/rnaturalearthhires, + rspatial/luna, + wranglezone/tibblify diff --git a/NAMESPACE b/NAMESPACE index 769ad425..7e25a761 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,9 +4,19 @@ export("%>%") export(.data) export(cosewic_plot) export(cosewic_ranges) +export(data_buff) +export(data_fmt) +export(daymet_check) +export(daymet_download) +export(daymet_extract) +export(daymet_request) +export(elevation_download) +export(elevation_extract) export(format_dates) export(format_zero_fill) export(grid_canada) +export(landcover_download) +export(landcover_extract) export(map_canada) export(meta_bcr_codes) export(meta_bmde_fields) @@ -25,6 +35,7 @@ export(meta_statprov_codes) export(meta_subnational2_codes) export(meta_utm_squares) export(nc_count) +export(nc_covariates_merge) export(nc_data_dl) export(nc_metadata) export(nc_metadata_version) @@ -33,11 +44,17 @@ export(nc_query_table) export(nc_remove_cache) export(nc_requests) export(region_search) +export(scanfi_download) +export(scanfi_extract) export(search_region) export(search_species) export(search_species_code) export(species_code_search) export(species_search) +export(vegetation_download) +export(vegetation_extract) +export(worldclim_download) +export(worldclim_extract) importFrom(dbplyr,sql) importFrom(magrittr,"%>%") importFrom(magrittr,"%T>%") diff --git a/R/checks.R b/R/checks.R index b5b1561c..5fbe24ef 100644 --- a/R/checks.R +++ b/R/checks.R @@ -20,6 +20,148 @@ year_check <- function(y) { y } +month_check <- function(m) { + stp <- FALSE + + # Convert factor months to characters + if (inherits(m, "factor")) { + m <- as.character(m) + } + # Check if numeric values have been given as characters + if (stringr::str_detect(m, "^[:digit:]+$")) { + m <- as.numeric(m) + } + # Check numerics are between 1 and 12. + if (is.numeric(m)) { + if (m < 1 | m > 12) { + stp <- TRUE + } + # Check numerics are whole numbers + if (round(m) != m) stp <- TRUE + } else { + # If month name provided in either English or French, convert it to numeric. + months <- data.frame( + labels = c( + "January", + "Janvier", + "Jan", + "Janv", + "Jan.", + "Janv.", + "February", + "Fevrier", + "Feb", + "Fevr", + "Feb.", + "Fevr.", + "March", + "Mars", + "Mar", + "Mar.", + "April", + "Avril", + "Apr", + "Avr", + "Apr.", + "Avr.", + "May", + "Mai", + "May.", + "Mai.", + "June", + "Juin", + "Jun", + "Jun.", + "Juin.", + "July", + "Juillet", + "Jul", + "Juill", + "Jul.", + "Juill.", + "August", + "Aout", + "Aug", + "Aug.", + "Aout.", + "September", + "Septembre", + "Sept", + "Sept.", + "October", + "Octobre", + "Oct", + "Oct.", + "November", + "Novembre", + "Nov", + "Nov.", + "December", + "Decembre", + "Dec", + "Dec." + ), + numerics = c( + rep(1, times = 6), + rep(2, times = 9), + rep(3, times = 4), + rep(4, times = 6), + rep(5, times = 4), + rep(6, times = 5), + rep(7, times = 6), + rep(8, times = 7), + rep(c(9, 10, 11), each = 4), + rep(12, times = 7) + ) + ) + if (tolower(m) %in% tolower(months$labels)) { + m <- months$numeric[tolower(months$labels) == tolower(m)] + } else { + # Stop if a non-month label character has been provided. + stp <- TRUE + } + # Stop if missing values are present. + if (is.na(m)) stp <- TRUE + } + if (stp) { + stop( + "Month must be either a number (1 = January, ..., 12 = December), ", + "or a month name ('January'/'Jan'/'Jan.').", + call. = FALSE + ) + } + return(m) +} + +# Function to check days of month. + +dom_check <- function(d) { + stp <- FALSE + + if (stringr::str_detect(d, "^[:digit:]+$")) { + d <- as.numeric(d) + } + if (is.numeric(d)) { + if (d < 1 | d > 31) { + stp <- TRUE + } + if (round(d) != d) stp <- TRUE + } else { + d <- suppressWarnings(lubridate::ymd_hms(d, truncated = 4)) %>% + lubridate::day() + if (is.na(d)) stp <- TRUE + } + if (stp) { + stop( + "Day of month must be a number between 1 and 31. ", + "If referring to an ordinal date (day of year), reformat with data_fmt()", + " and the 'date_ordinal' argument.", + call. = FALSE + ) + } + d +} + doy_check <- function(s) { stp <- FALSE @@ -408,3 +550,78 @@ sf_check <- function(df_sf, name) { ) } } + +covariate_fmt_check <- function(data) { + # Check packages + have_pkg_check(c("sf", "terra")) + + # Check if input is a simple features object. + if (inherits(data, "sf")) { + # Store data type. + data_type <- "sf" + + # Store data geometry. + data_geometry <- as.character(sf::st_geometry_type( + data, + by_geometry = FALSE + )) + + # Handle objects containing mixtures of multiple geometry types. + if (data_geometry == "GEOMETRY") { + stop( + "[Data Formatting] mixed sf geometries detected. Please provide a set of", + " only POINT geometries or only POLYGON geometries.", + call. = FALSE + ) + } + + # Reject objects that are not point or polygon objects. + if (!(data_geometry %in% c("POINT", "POLYGON"))) { + stop( + "[Data Formatting] sf object provided, but not a set of POINT or", + " POLYGON geometries.", + call. = FALSE + ) + } + + # Return stored information. + return(list(type = data_type, geometry = data_geometry)) + + # Check if input is a terra SpatVector. + } else if (inherits(data, "SpatVector")) { + # Store data type. + data_type <- "terra" + + # Store data geometry. + data_geometry <- terra::geomtype(data) + + # Reject objects that are not point or polygon objects. + if (!(data_geometry %in% c("points", "polygons"))) { + stop( + "[Data Formatting] terra object provided, but not a set of points or", + " polygons.", + call. = FALSE + ) + } + + # Return stored information. + return(list(type = data_type, geometry = data_geometry)) + + # Check if data is a dataframe. + } else if (is.data.frame(data)) { + # Store data type. + data_type <- "data.frame" + + # Return stored information. + return(list(type = data_type)) + + # Reject all other data types. + } else { + stop( + "[Data Formatting] invalid data format. Please provide data as either a", + " dataframe, sf object with either `POINT` or `POLYGON` geometry, or", + " terra SpatVector object with `points` or `polygons` geometry.", + call. = FALSE + ) + } +} diff --git a/R/data_buff.R b/R/data_buff.R new file mode 100644 index 00000000..5e865792 --- /dev/null +++ b/R/data_buff.R @@ -0,0 +1,217 @@ +#' Buffer Data for Covariate Download and Extraction +#' +#' Buffers input data by a specifiable distance. +#' +#' If input data is an `sf` 'POINT' object or a `terra` 'points' object, points +#' are buffered to a circle with the radius specified in `buffer_distance` (500 +#' m by default). If input is an `sf` 'POLYGON' object or a `terra` 'polygons' +#' object, the polygon is buffered on all sides by the distance specified in +#' `buffer_distance` (500 m by default). +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param buffer Logical. Should the provided data be buffered? `TRUE` by +#' default. +#' @param buffer_distance Numeric. Distance that the provided points or +#' polygons should be buffered by. 500 by default. +#' @param buffer_units Character. Units of provided distance. Options are "m" +#' (metres), "km" (kilometers), "ft" (feet), "yd" (yards), "mi" (miles), or +#' "naut_mi" (nautical miles). Metres ("m") by default. +#' +#' @returns Either `sf` 'POLYGON' or `terra` 'polygons' (depending on format of +#' input data) with original coordinate reference system and columns +#' preserved, and all geometries buffered by requested distance. +#' +#' @examples +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Buffer by 1 km +#' output <- data_buff(bcch, +#' buffer = TRUE, +#' buffer_distance = 1, +#' buffer_units = "km" +#' ) +#' +#' @seealso [data_fmt()] for a convenient way to convert `data.frame` data to a +#' compatible `sf` or `terra` object. +#' +#' [sf::st_buffer()] which this function wraps. +#' +#' @export + +data_buff <- function( + data, + buffer = TRUE, # Should the data be buffered? + buffer_distance = 500, # Distance to buffer by. + buffer_units = "m" # Units of provided distance. +) { + # Ensure 'buffer' argument is logical. + if (!is.logical(buffer)) { + stop( + "[Data Buffering] argument 'buffer' should be a boolean (i.e. TRUE or", + " FALSE).", + call. = FALSE + ) + } + + # Unless buffering requested, do nothing. + if (buffer == TRUE) { + # Check packages + have_pkg_check(c("terra", "sf", "measurements")) + + # Check data is in the desired format + tryCatch(input_fmt <- covariate_fmt_check(data), error = function(e) { + if ( + conditionMessage(e) == + paste0( + "[Data Formatting] invalid data", + " format. Please provide data as either a dataframe, sf object", + " with either `POINT` or `POLYGON` geometry, or terra SpatVector", + " object with `points` or `polygons` geometry." + ) + ) { + stop( + "[Data Formatting] invalid data format. Please provide", + " data as a sf object with `POINT` or", + " `POLYGON` geometry, or terra SpatVector object with", + " `points` or `polygons` geometry.", + call. = FALSE + ) + } else { + stop(conditionMessage(e)) + } + }) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[Data Buffering] buffering requires an sf or terra object as input in", + " this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Ensure radius is coercable to a numeric value. + buffer_distance <- suppressWarnings(as.numeric(buffer_distance)) + + if (is.na(buffer_distance)) { + stop( + "[Data Buffering] 'buffer_distance' could not be converted to", + " numeric. Please provide desired buffer distance as a numeric input.", + call. = FALSE + ) + } + + # If unit provided is not compatible with measurements::conv_unit(), return + # error. + if (!(buffer_units %in% c("m", "km", "ft", "yd", "mi", "naut_mi"))) { + stop( + "[Data Buffering] buffer units not recognized: please set buffer_units", + " to one of 'm' [metres], 'km' [kilometers], 'ft' [feet], 'yd' [yards],", + " 'mi' [miles], or 'naut_mi' [nautical miles].", + call. = FALSE + ) + } + + message( + "[Data Buffering] buffering sites by ", + buffer_distance, + buffer_units, + " radius", + ifelse(buffer_distance == 500 & buffer_units == "m", " (default)", ""), + "." + ) + + # Buffer sf objects by requested amount. + if (input_fmt$type == "sf") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # If not already in CRS used herein, transform. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + data <- sf::st_transform(data, "ESRI:102001") + } + + # If sf object contains polygon, warn that polygons will be buffered on + # all sides. This might help users catch mistakes when pre-buffered data + # is provided and they don't want it additionally buffered. + if (input_fmt$geometry == "POLYGON") { + warning( + "[Data Buffering] sf POLYGON geometry provided. Existing polygons", + " will be buffered by an additional ", + buffer_distance, + buffer_units, + ".", + call. = FALSE + ) + } + + # Buffer. Use measurements::conv_unit() to handle units other than metres. + data <- sf::st_buffer( + data, + measurements::conv_unit( + x = buffer_distance, + from = buffer_units, + to = "m" + ) + ) + + # Back-transform to original CRS if it wasn't the CRS used herein. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + data <- sf::st_transform(data, orig_crs) + } + } + + # Buffer terra objects by requested amount. + if (input_fmt$type == "terra") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # If not already in CRS used herein, transform. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + data <- terra::project(data, "ESRI:102001") + } + + # If terra object contains polygon, warn that polygons will be buffered on + # all sides. This might help users catch mistakes when pre-buffered data + # is provided and they don't want it additionally buffered. + if (input_fmt$geometry == "polygons") { + warning( + "[Data Buffering] terra polygons provided. Existing polygons will", + " be buffered by an additional ", + buffer_distance, + buffer_units, + ".", + call. = FALSE + ) + } + + # Buffer. Use measurements::conv_unit() to handle units other than metres. + data <- terra::buffer( + data, + measurements::conv_unit( + x = buffer_distance, + from = buffer_units, + to = "m" + ) + ) + + # Back-transform to original CRS if it wasn't the CRS used herein. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + data <- terra::project(data, orig_crs) + } + } + } + + # Return provided data if no buffering requested, or buffered data if + # buffering requested. + return(data) +} diff --git a/R/data_fmt.R b/R/data_fmt.R new file mode 100644 index 00000000..a7e56e9c --- /dev/null +++ b/R/data_fmt.R @@ -0,0 +1,937 @@ +#' Format Data for Covariate Download and Extraction +#' +#' This function accepts a variety of input data and conforms it to a +#' standardized format for use in the various covariate download and extraction +#' functions available in the naturecounts R package. Users are not required to +#' use this function before using covariate download and extraction functions, +#' but may avoid some finnicky work by doing so. +#' +#' @param data Data frame, `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons' object containing observations associated with coordinate and +#' date data. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. +#' @param coord_lon Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `longitude`. +#' @param coord_lat Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `latitude`. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day of month data if not contained within the BMDE column +#' `survey_day`. +#' @param date_lubridate Character. Optional argument to provide the name of a +#' column containing date data in `lubridate` formats. +#' @param date_ordinal Character. Optional argument to provide the name of a +#' column containing date data in ordinal format. +#' @param crs Character. Optional argument to provide the coordinate reference +#' system of the provided data. Only required when providing a data frame +#' containing data not using the typical GPS latitude/longitude +#' [WGS84](https://epsg.io/4326) (`EPSG:4326`) coordinate reference system, or +#' `sf`/ `terra` objects without coordinate reference systems embedded. +#' +#' @returns If `data.frame`, `sf` "POINT", or `terra` "points" data provided, +#' `sf` "POINT" object. If `sf` "POLYGON" or `terra` "polygons" data provided, +#' `sf` "POLYGON" object. Returned object contains a row for each unique +#' site-date combination in the provided data, and is provided in the [NAD 1983 +#' Albers Canada](https://epsg.io/102001) (`EPSG:102001`) coordinate reference system with the +#' following columns. +#' - SurveyAreaIdentifier - character. Site names, or if missing in original +#' data, filled site names for use in later functions. +#' - latitude - numeric. Y-coordinate in NAD 1983 Albers Canada +#' (`EPSG:102001`) coordinate reference system. +#' - longitude - numeric. X-coordinate in NAD 1983 Albers Canada +#' (`EPSG:102001`) coordinate reference system. +#' - survey_year - numeric. Observation year. +#' - survey_month - numeric. Observation month. +#' - survey_day - numeric. Observation day (of month). +#' - geometry - `sf` geometry column. +#' +#' @examples +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Format +#' output <- data_fmt(bcch) +#' +#' @seealso [sf::st_as_sf()] and [terra::vect()] which this function wraps. +#' +#' [data_buff()] to buffer data points by a specified distance to measure +#' covariates at desired spatial scales. +#' +#' @export + +data_fmt <- function( + data, + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. + coord_lon = NULL, # as in cosewic_ranges + coord_lat = NULL, # as in cosewic_ranges + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. + date_lubridate = NULL, # optional argument to provide column name containing + # 'lubridate' date objects. + date_ordinal = NULL, # optional argument to provide column name containing + # ordinal dates. + crs = NULL # optional argument to provide a Coordinate Reference System for + # provided data. +) { + message("[Data Formatting] beginning formatting.") + + # Check packages + + have_pkg_check(c( + "sf", + "terra", + "tidyterra" + )) + + # Check data type - we need either a dataframe, sf points object, sf polygon, + # or terra SpatVector. + + input_fmt <- covariate_fmt_check(data) + + # Deal with alternate CRS's + + # Check that 'crs' argument has been provided. + if (!is.null(crs)) { + # Check if input is an sf object. + if (input_fmt$type == "sf") { + # Check if provided sf object has a CRS. If missing, set to provided CRS. + # Warn. + if (is.na(sf::st_crs(data))) { + warning( + "[Data Formatting] the CRS of the provided sf object is missing, it", + " will be set to the alternate CRS specified in the 'crs' argument.", + call. = FALSE + ) + + suppressWarnings(sf::st_crs(data) <- crs) + + # If sf object still is missing CRS, suggests that provided CRS is + # invalid. Return error. + if (is.na(sf::st_crs(data))) { + stop( + "[Data Formatting] the provided CRS is invalid. CRS must be a", + " valid proj4string character, a valid epsg integer value, or a list", + " containing named elements proj4string (character) and/or epsg", + " (integer).", + call. = FALSE + ) + } + } else { + # If sf object has a CRS and the 'crs' argument has been provided, use + # the CRS included in the sf object. Warn. + warning( + "[Data Formatting] the sf object provided has a specified CRS and a", + " CRS has been provided using the 'crs' argument. The CRS of the sf", + " object will be used.", + call. = FALSE + ) + + crs <- sf::st_crs(data) + } + } + + # Check if input is a terra SpatVector. + if (input_fmt$type == "terra") { + # Check if provided terra object has a CRS. If missing, set to provided + # CRS. Warn. + if (terra::crs(data) == "") { + warning( + "[Data Formatting] the CRS of the provided terra object is missing,", + " it will be set to the alternate CRS specified in the 'crs'", + " argument.", + call. = FALSE + ) + + # Convert terra warnings associated with invalid CRS inputs into errors. + tryCatch( + terra::crs(data) <- crs, + warning = function(w) { + if ( + "[crs<-] Cannot set SRS to vector: empty srs" %in% + conditionMessage(w) | + paste0( + "PROJ: proj_create_from_database: crs not found:", + " EPSG:234634 (GDAL error 1)" + ) %in% + conditionMessage(w) + ) { + stop( + "[Data Formatting] the provided CRS is invalid. CRS", + " must be a character string in WKT (e.g. 'EPSG:4326') or", + " PROJ-string format (e.g. '+proj=utm +zone=12').", + call. = FALSE + ) + } else { + warning(conditionMessage(w), call. = FALSE) + } + }, + error = function(e) { + if ( + conditionMessage(e) == + paste0( + "[crs] I do not know what", + " to do with this argument", + " (expected a character", + " string)" + ) + ) { + stop( + "[Data Formatting] the provided CRS is invalid. CRS", + " must be a character string in WKT (e.g. 'EPSG:4326') or", + " PROJ-string format (e.g. '+proj=utm +zone=12').", + call. = FALSE + ) + } else { + stop(conditionMessage(e), call. = FALSE) + } + } + ) + } else { + # If terra object has a CRS and the 'crs' argument has been provided, + # use the CRS included in the terra object. Warn. + warning( + "[Data Formatting] the terra object provided has a specified CRS and", + " a CRS has been provided using the 'crs' argument. The CRS of the", + " terra object will be used.", + call. = FALSE + ) + + crs <- terra::crs(data) + } + } + + # If provided data is a data.frame, make sure we have the names of columns + # pointing us to associated coordinate data. If not, return error. + if ( + input_fmt$type == "data.frame" & (is.null(coord_lon) | is.null(coord_lat)) + ) { + stop( + "[Data Formatting] alternate CRS provided, but without specified", + " column for one or more coordinate. Use the 'coord_lon' argument to", + " give the name of column containing the X-coordinate, and the", + " 'coord_lat' argument to give the name of the column containing the", + " Y-coordinate.", + call. = FALSE + ) + } + } + + # If no 'crs' argument is provided, and provided sf object lacks a CRS, + # return error. + if (is.null(crs) & input_fmt$type == "sf") { + if (is.na(sf::st_crs(data))) { + stop( + "[Data Formatting] provided sf object lacks a CRS. Please specify", + " using the 'crs' argument or provide an sf object with a CRS.", + call. = FALSE + ) + } + } + + # If no 'crs' argument is provided, and provided terra object lacks a CRS, + # return error. + if (is.null(crs) & input_fmt$type == "terra") { + if (terra::crs(data) == "") { + stop( + "[Data Formatting] provided terra object lacks a CRS. Please specify", + " using the 'crs' argument or provide a terra object with a CRS.", + call. = FALSE + ) + } + } + + # If no 'crs' argument is provided, and provided data is a dataframe, assume + # it is the default NatureCounts format which uses lat/lon and use EPSG:4326. + # Warn. + if (is.null(crs) & input_fmt$type == "data.frame") { + warning( + "[Data Formatting] as the 'crs' argument is not specified, data CRS is", + " assumed to be EPSG:4326.", + call. = FALSE + ) + + crs <- 4326 + } + + # If spatial object is provided and the 'coord_lon'/'coord_lat' arguments + # have been provided, use the coordinate data included in the spatial object. + # Warn. + if ( + input_fmt$type %in% + c("sf", "terra") & + (!is.null(coord_lon) | !is.null(coord_lat)) + ) { + warning( + "[Data Formatting] sf or terra object provided as well as a lat/lon", + " column name. lat/lon will be derived from the spatial data within the", + " sf/terra object and specified lat/lon column will be ignored.", + call. = FALSE + ) + + coord_lon <- NULL + coord_lat <- NULL + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c( + site_name, + coord_lon, + coord_lat, + date_year, + date_month, + date_day, + date_lubridate, + date_ordinal + ) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. + if (!(all(specified_cols %in% data_cols))) { + stop( + "[Data Formatting] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that", + " diverges from NatureCounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (input_fmt$type == "data.frame") { + if (!is.null(coord_lon)) { + # Edge case: there is a col called longitude that isn't coord_lon. + # Remove. + if ("longitude" %in% names(data) & !(coord_lon == "longitude")) { + data <- dplyr::select(data, -"longitude") + } + + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "longitude" = !!coord_lon) + } + + data$longitude <- as.numeric(data$longitude) + + if (!is.null(coord_lat)) { + # Edge case: there is a col called latitude that isn't coord_lat. Remove. + if ("latitude" %in% names(data) & !(coord_lat == "latitude")) { + data <- dplyr::select(data, -"latitude") + } + + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "latitude" = !!coord_lat) + } + + data$latitude <- as.numeric(data$latitude) + } + + if (!is.null(date_year)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + # Use year_check() to validate year data. 'if' wrapper needed to handle cases + # where no year column was provided, and a lubridate column was provided + # instead. + if ("survey_year" %in% names(data)) { + year_corr <- c() + + for (i in 1:length(data$survey_year)) { + year_corr[i] <- year_check(data$survey_year[i]) + } + + data$survey_year <- year_corr + } + + if (!is.null(date_month)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + # Use month_check() to validate month data. 'if' wrapper needed to handle + # cases where no month column was provided, and a lubridate or ordinal date + # column was provided instead. + if ("survey_month" %in% names(data)) { + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + data$survey_month <- month_corr + } + + if (!is.null(date_day)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_day" = !!date_day) + } + + # Use dom_check() to validate day data. 'if' wrapper needed to handle cases + # where no month column was provided, and a lubridate or ordinal date column + # was provided instead. + if ("survey_day" %in% names(data)) { + for (i in data$survey_day) { + dom_check(i) + } + } + + # If a date in lubridate or ordinal format is provided, make year, month and + # day columns. + if (!is.null(date_lubridate)) { + # Standardize date column name + data <- dplyr::rename(data, "date" = !!date_lubridate) + + # Check that provided lubridate data is a date object. If not, return error. + if (!lubridate::is.Date(data$date)) { + stop( + "[Data Formatting] column ", + date_lubridate, + " expected to be in `Date` format, but is not.", + call. = FALSE + ) + } + + # Check that provided lubridate data is an instant rather than a duration + # object. If not, return error. + if (!lubridate::is.instant(data$date)) { + stop( + "[Data Formatting] column ", + date_lubridate, + " expected to be a single instant in time, but is not.", + call. = FALSE + ) + } + + # Check that all dates are either the current date or in the past. If not, + # return error. + if (!all(data$date <= as.Date(Sys.Date()))) { + stop( + "[Data Formatting] some dates are in the future! Covariate data only", + " available for data in the past.", + call. = FALSE + ) + } + + # If lubridate column provided alongside other specified date column + # options, use data from lubridate columns. Warn. + if ( + !is.null(date_year) | + !is.null(date_month) | + !is.null(date_day) | + !is.null(date_ordinal) + ) { + date_cols <- c( + date_lubridate, + date_year, + date_month, + date_day, + date_ordinal + ) + date_cols <- date_cols[!is.null(date_cols)] + + warning( + paste0( + "[Data Formatting] multiple date column options provided including ", + stringr::str_flatten_comma(date_cols), + ". The data in ", + date_lubridate, + " will be used." + ), + call. = FALSE + ) + } + + # Extract year/month/day columns from lubridate date. + data$survey_year <- lubridate::year(data$date) + + data$survey_month <- lubridate::month(data$date) + + data$survey_day <- lubridate::day(data$date) + + # In case ordinal data has also been provided, set to NULL so dates aren't + # recalculated using ordinal data. + date_year <- NULL + + date_ordinal <- NULL + } + + # If a date in ordinal format is provided (and a date in lubridate format is + # not provided, see above), make year, month and day columns. + if (!is.null(date_ordinal)) { + # Standardize ordinal date column name + data <- dplyr::rename(data, "doy" = !!date_ordinal) + + # Check that year data has been provided alongside ordinal day data as this + # is needed to convert to calendar date. If not, return error. + if (!("survey_year" %in% names(data))) { + stop( + "[Data Formatting] if providing an ordinal date, year data must", + " accompany it. Please provide a column with associated year data", + " using the `date_year` argument.", + call. = FALSE + ) + } + + # Use doy_check() to validate ordinal date data. + for (i in data$doy) { + doy_check(i) + } + + # If month or day data has also been provided, warn that ordinal date data + # will supersede it. + if (!is.null(date_month) | !is.null(date_day)) { + warning( + "[Data Formatting] dates derived from ordinal dates will supersede", + " provided month and/or day data.", + call. = FALSE + ) + } + + # If ordinal date is numeric, add it to the first day of the associated + # year to get the calendar date. + if (is.numeric(data$doy)) { + data$date <- as.Date(paste0(data$survey_year, "-01-01")) + data$doy - 1 + } + + # If ordinal date has been provided as a date object (likely due to + # misunderstanding of the meaning of ordinal date) convert it to ordinal + # date and add it to the first day of the associated calendar year. + if (lubridate::is.Date(data$doy)) { + data$date <- as.Date(paste0(data$survey_year, "-01-01")) + + lubridate::yday(data$doy) - + 1 + } + + # Extract month and day data from ordinal-derived date column + data$survey_month <- lubridate::month(data$date) + + data$survey_day <- lubridate::day(data$date) + } + + # Ensure date columns are numeric. + data$survey_year <- as.numeric(data$survey_year) + + data$survey_month <- as.numeric(data$survey_month) + + data$survey_day <- as.numeric(data$survey_day) + + # If data is a dataframe, ensure that there are no rows missing coordinate + # data as this would prevent conversion into an sf object. Warn. + if (input_fmt$type == "data.frame") { + if (NA %in% unique(data$latitude) | NA %in% unique(data$longitude)) { + warning( + "[Data Formatting] some rows missing coordinate data will be dropped.", + call. = FALSE + ) + + data <- dplyr::filter( + data, + !(is.na(.data$latitude) | is.na(.data$longitude)) + ) + } + } + + # Handle missing SurveyAreaIdentifiers and ensure coordinates are present in + # the data for later use in nc_covariates_merge(). + if (TRUE %in% is.na(data$SurveyAreaIdentifier)) { + # For dataframe objects create an object containing all X/Y coordinates + # that do not have an associated SurveyAreaIdentifier. + if (input_fmt$type == "data.frame") { + missing_sitecode <- data %>% + dplyr::select("SurveyAreaIdentifier", "latitude", "longitude") %>% + dplyr::filter(is.na(.data$SurveyAreaIdentifier)) %>% + dplyr::distinct() + } + + # For sf objects, create an object containing all X/Y coordinates (derived + # from geometries) that do not have an associated SurveyAreaIdentifier. + # Also append coordinates to original data object for later joining. + if (input_fmt$type == "sf") { + missing_sitecode <- data %>% + dplyr::select("SurveyAreaIdentifier", "geometry") + + # For polygons, use the centroid as the X/Y coordinates. + if (input_fmt$geometry == "POLYGON") { + missing_sitecode <- suppressWarnings(sf::st_centroid(missing_sitecode)) + } + + # Extract coordinates and bind to data. Drop geometry and get all + # unique coordinate combinations with missing SurveyAreaIdentifiers. + missing_sitecode <- cbind( + missing_sitecode, + sf::st_coordinates(missing_sitecode) + ) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") %>% + sf::st_drop_geometry() %>% + dplyr::filter(is.na(.data$SurveyAreaIdentifier)) %>% + dplyr::distinct() + + # Edge case: there is a col called X. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("X" %in% names(data)) { + data <- dplyr::select(data, -"X") + } + + # Edge case: there is a col called Y. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("Y" %in% names(data)) { + data <- dplyr::select(data, -"Y") + } + + # Edge case: there is a col called longitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("longitude" %in% names(data)) { + data <- dplyr::select(data, -"longitude") + } + + # Edge case: there is a col called latitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("latitude" %in% names(data)) { + data <- dplyr::select(data, -"latitude") + } + + # Append coordinates (from centroids if polygons) to provided data object. + if (input_fmt$geometry == "POLYGON") { + data <- cbind( + data, + sf::st_coordinates(suppressWarnings(sf::st_centroid(data))) + ) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } else { + data <- cbind(data, sf::st_coordinates(data)) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } + } + + # For terra objects, create an object containing all X/Y coordinates + # (derived from geometries) that do not have an associated + # SurveyAreaIdentifier. Also append coordinates to original data object for + # later joining. + if (input_fmt$type == "terra") { + missing_sitecode <- data %>% + tidyterra::select("SurveyAreaIdentifier") + + # For polygons, use the centroid as the X/Y coordinates. + if (input_fmt$geometry == "polygons") { + missing_sitecode <- terra::centroids(missing_sitecode) + } + + # Extract coordinates and bind to data. Drop geometry and get all + # unique coordinate combinations with missing SurveyAreaIdentifiers. + missing_sitecode <- cbind( + missing_sitecode, + terra::crds(missing_sitecode) + ) %>% + tidyterra::rename("longitude" = "x", "latitude" = "y") %>% + terra::as.data.frame() %>% + dplyr::filter(is.na(.data$SurveyAreaIdentifier)) %>% + dplyr::distinct() + + # Edge case: there is a col called x. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("x" %in% names(data)) { + data <- tidyterra::select(data, -"x") + } + + # Edge case: there is a col called y. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("y" %in% names(data)) { + data <- tidyterra::select(data, -"y") + } + + # Edge case: there is a col called longitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("longitude" %in% names(data)) { + data <- dplyr::select(data, -"longitude") + } + + # Edge case: there is a col called latitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("latitude" %in% names(data)) { + data <- dplyr::select(data, -"latitude") + } + + # Append coordinates (from centroids if polygons) to provided data object. + if (input_fmt$geometry == "polygons") { + data <- cbind(data, terra::crds(terra::centroids(data))) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") + } else { + data <- cbind(data, terra::crds(data)) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") + } + } + + # Create a dummy SurveyAreaIdentifier for all unique coordinate combinations + # which are missing an associated SurveyAreaIdentifier. + for (i in 1:nrow(missing_sitecode)) { + missing_sitecode$SurveyAreaIdentifier[i] <- paste0("FilledSurveyArea", i) + } + + # Use coordinates to join dummy SurveyAreaIdentifiers to original data. + for (i in missing_sitecode$latitude) { + for (j in missing_sitecode$longitude[missing_sitecode$latitude == i]) { + data$SurveyAreaIdentifier[ + data$latitude == i & data$longitude == j + ] <- missing_sitecode$SurveyAreaIdentifier[ + missing_sitecode$latitude == i & missing_sitecode$longitude == j + ] + } + } + } else { + # In case all SurveyAreaIdentifiers are present, append coordinates to + # spatial data objects for later use in nc_covariates_merge(). + if (input_fmt$type == "sf") { + # Edge case: there is a col called X. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("X" %in% names(data)) { + data <- dplyr::select(data, -"X") + } + + # Edge case: there is a col called Y. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("Y" %in% names(data)) { + data <- dplyr::select(data, -"Y") + } + + # Edge case: there is a col called longitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("longitude" %in% names(data)) { + data <- dplyr::select(data, -"longitude") + } + + # Edge case: there is a col called latitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("latitude" %in% names(data)) { + data <- dplyr::select(data, -"latitude") + } + + # Append coordinates (from centroids if polygons) to provided data object. + if (input_fmt$geometry == "POLYGON") { + data <- cbind( + data, + sf::st_coordinates(suppressWarnings(sf::st_centroid(data))) + ) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } else { + data <- cbind(data, sf::st_coordinates(data)) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } + } + + if (input_fmt$type == "terra") { + # Edge case: there is a col called x. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("x" %in% names(data)) { + data <- tidyterra::select(data, -"x") + } + + # Edge case: there is a col called y. This does not lead to the removal + # of this column in final data when merged using nc_covariates_merge(). + if ("y" %in% names(data)) { + data <- tidyterra::select(data, -"y") + } + + # Edge case: there is a col called longitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("longitude" %in% names(data)) { + data <- tidyterra::select(data, -"longitude") + } + + # Edge case: there is a col called latitude. This does not lead to the + # removal of this column in final data when merged using + # nc_covariates_merge(). + if ("latitude" %in% names(data)) { + data <- tidyterra::select(data, -"latitude") + } + + # Append coordinates (from centroids if polygons) to provided data object. + if (input_fmt$geometry == "polygons") { + data <- cbind(data, terra::crds(terra::centroids(data))) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") + } else { + data <- cbind(data, terra::crds(data)) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") + } + } + } + + if (!is.null(date_ordinal)) { + names(data)[names(data) == "doy"] <- date_ordinal + } + + if (!is.null(date_lubridate)) { + names(data)[names(data) == "date"] <- date_lubridate + } + + # Create base list of columns to preserve. + keep_cols <- c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day" + ) + + # If ordinal date provided, preserve it for later use in + # nc_covariates_merge(). + if (!is.null(date_ordinal)) { + keep_cols <- c(keep_cols[1:4], date_ordinal, keep_cols[5:6]) + } + + # If lubridate date provided, preserve it for later use in + # nc_covariates_merge(). + if (!is.null(date_lubridate)) { + keep_cols <- c(keep_cols[1:3], date_lubridate, keep_cols[4:6]) + } + + # For dataframe objects, convert to spatial features object. + if (input_fmt$type == "data.frame") { + # Get all distinct combinations of kept columns, convert to sf object. + suppressWarnings( + data <- dplyr::select(data, tidyselect::all_of(keep_cols)) %>% + dplyr::distinct() %>% + sf::st_as_sf( + coords = c("longitude", "latitude"), + crs = crs, + remove = FALSE + ) + ) + + # If created spatial object CRS is missing, provided CRS was invalid. + # Return error. + if (is.na(sf::st_crs(data))) { + stop( + "[Data Formatting] the provided CRS is invalid. CRS must be a valid", + " proj4string character, a valid epsg integer value, or a list", + " containing named elements proj4string (character) and/or epsg", + " (integer).", + call. = FALSE + ) + } + + # Convert to CRS with metres as a base unit to facilitate buffering. + data <- sf::st_transform(data, "ESRI:102001") + } + + # For sf objects, keep all distinct combinations of kept columns. + if (input_fmt$type == "sf") { + # Ensure geometry column is retained. + keep_cols <- c(keep_cols, "geometry") + + # Convert to CRS with metres as a base unit to facilitate buffering. + data <- dplyr::select(data, tidyselect::all_of(keep_cols)) %>% + dplyr::distinct() %>% + sf::st_transform("ESRI:102001") + } + + # For terra objects, keep all distinct combinations of kept columns and + # convert to CRS with metres as a base unit to facilitate buffering. + if (input_fmt$type == "terra") { + data <- tidyterra::select(data, tidyselect::all_of(keep_cols)) %>% + tidyterra::distinct() %>% + terra::project("ESRI:102001") + } + + # Store specified column names and crs as attributes so that they don't need + # to be specified any time associated functions are called. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + attr(data, "site_name") <- site_name + } + + if (!is.null(coord_lon)) { + names(data)[names(data) == "longitude"] <- coord_lon + attr(data, "coord_lon") <- coord_lon + } + + if (!is.null(coord_lat)) { + names(data)[names(data) == "latitude"] <- coord_lat + attr(data, "coord_lat") <- coord_lat + } + + if (!is.null(date_year)) { + names(data)[names(data) == "survey_year"] <- date_year + attr(data, "date_year") <- date_year + } + + if (!is.null(date_month)) { + names(data)[names(data) == "survey_month"] <- date_month + attr(data, "date_month") <- date_month + } + + if (!is.null(date_day)) { + names(data)[names(data) == "survey_day"] <- date_day + attr(data, "date_day") <- date_day + } + + if (!is.null(date_ordinal)) { + attr(data, "date_ordinal") <- date_ordinal + } + + if (!is.null(date_lubridate)) { + attr(data, "date_lubridate") <- date_lubridate + } + + if (!is.null(crs)) { + attr(data, "crs") <- crs + } + + # Return formatted data. + return(data) +} diff --git a/R/daymet_check.R b/R/daymet_check.R new file mode 100644 index 00000000..d093ed69 --- /dev/null +++ b/R/daymet_check.R @@ -0,0 +1,221 @@ +#' Check the status of Daymet Data Requests +#' +#' Returns status information on requests submitted through [daymet_request()]. +#' Requests are submitted to the NASA AppEEARS service, requiring an EarthData +#' account to be made. This can be done at the following link: [register for an +#' EarthData account](https://urs.earthdata.nasa.gov/users/new). +#' +#' Status checks are facilitated by a call to [appeears::rs_list_task()]. +#' +#' @inheritParams daymet_request +#' @param daymet_reqs `data.frame`. A `data.frame` with columns 1) +#' `request_name` containing AppEEARS request names, 2) `request_id` +#' containing AppEEARS request IDs, and optionally 3) `date` containing the +#' date for which the associated request is downloading data for, or a +#' filepath to a `.rds` file containing such data. The direct output of +#' [daymet_request()] can be supplied here. +#' +#' @returns A `data.frame` containing request status information. +#' +#' @examplesIf interactive() +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Grab data from a single year +#' bcch <- bcch[bcch$survey_year == 2011,] +#' +#' # Enter EarthData username +#' ed_username <- "your EarthData username" +#' +#' # Submit Daymet requests +#' requests <- daymet_request(data = bcch, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' +#' # Check status +#' status_check <- daymet_check(daymet_reqs = requests, +#' ed_username = ed_username) +#' +#' +#' @seealso [daymet_request()] which can be used to submit requests for Dayment +#' data. +#' +#' [daymet_download()] to execute downloads once requests have been +#' submitted and are complete. +#' +#' [daymet_extract()] which can be used to extract data +#' from downloaded Daymet files. +#' +#' @export + +daymet_check <- function( + daymet_reqs, + ed_username, + verbose = TRUE +) { + have_pkg_check(c( + "appeears" + )) + + # Check that an EarthData account username has been provided. If not, return + # error. + if (missing(ed_username)) { + stop( + "[Daymet Request Checking] Daymet data requested but Earthdata system login", + " information not supplied. NOTE: checking Daymet data requires your", + " EarthData username, not email. Please register at", + " https://urs.earthdata.nasa.gov/users/new and supply using", + " the `ed_username` parameter.", + call. = FALSE + ) + } + + # Check whether user password is stored in .Renviron + ed_password <- Sys.getenv("EarthData_password") + + # If not available in .Renviron, check whether an EarthData password exists + # in the environment (is specified earlier in the nc_covariates() workflow), + # and if not, request using askpass::askpass(). + if (ed_password == "") { + if (is.null(parent.frame()$ed_password)) { + ed_password <- askpass::askpass( + prompt = paste0( + "Please enter password for ", + "EarthData user '", + ed_username, + "'." + ) + ) + + if (is.null(ed_password)) { + stop( + "[Daymet Request Checking] EarthData password could not be found", + ". Please add line 'EarthData_password = yourpassword' to your", + " .Renviron file. This can be accessed using usethis::edit_r_environ().", + call. = FALSE + ) + } + } else { + ed_password <- parent.frame()$ed_password + } + } + + # Check whether daymet_reqs is a filepath to a .RDS file. + if (inherits(daymet_reqs, "character")) { + if (all(file.exists(daymet_reqs))) { + daymet_reqs <- readRDS(daymet_reqs) + } else { + stop( + "[Daymet Request Checking] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + } + + if (!inherits(daymet_reqs, "data.frame")) { + stop( + "[Daymet Request Checking] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + + if (!(all(c("request_name", "request_id") %in% names(daymet_reqs)))) { + stop( + "[Daymet Request Checking] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + + # Set EarthData username and password in user Keyring. + options(keyring_backend = "file") + + if (verbose == FALSE) { + suppressMessages(appeears::rs_set_key( + user = ed_username, + password = ed_password + )) + } else { + appeears::rs_set_key(user = ed_username, password = ed_password) + } + + # Autheniticate with AppEEARS. + token <- appeears::rs_login(user = ed_username) + + # Pull AppEEARS task list + task_list <- appeears::rs_list_task(user = ed_username) + + # Check that daymet_reqs contains valid request IDs within the user's AppEEARS + # task ids + if ( + FALSE %in% + (daymet_reqs$request_id %in% + task_list$task_id[ + lubridate::as_datetime(task_list$expires_on) > + lubridate::as_datetime(Sys.time()) + ]) + ) { + stop( + "[Daymet Request Checking] request(s) ", + stringr::str_flatten_comma(daymet_reqs$request_name[ + daymet_reqs$request_id %in% + task_list$task_id[ + lubridate::as_datetime(task_list$expires_on) > + lubridate::as_datetime(Sys.time()) + ] == + FALSE + ]), + " provided in daymet_reqs are not", + " registered under EarthData user ", + ed_username, + ". Are they more than a month old (i.e., expired), or entered incorrectly?", + call. = FALSE + ) + } + + # Filter to those named in daymet_reqs + task_list <- task_list[task_list$task_name %in% daymet_reqs$request_name, ] + + # Grab key columns and make pretty + output <- task_list[, c("task_name", "task_id", "status", "expires_on")] + + output$date <- substr( + output$task_name, + start = nchar(output$task_name) - 9, + stop = nchar(output$task_name) + ) + + output <- output[, c("task_name", "task_id", "date", "status", "expires_on")] + + output <- dplyr::arrange(output, .data$date) + + output <- dplyr::rename( + output, + "request_name" = "task_name", + "request_id" = "task_id" + ) + + # End AppEEARS session. + if (verbose == FALSE) { + suppressMessages(appeears::rs_logout(token)) + } else { + appeears::rs_logout(token) + } + + return(output) +} diff --git a/R/daymet_download.R b/R/daymet_download.R new file mode 100644 index 00000000..ee8d7156 --- /dev/null +++ b/R/daymet_download.R @@ -0,0 +1,360 @@ +#' Download Data from Daymet. +#' +#' Downloads all available variables from the [Daymet](https://daymet.ornl.gov/) +#' from request data either fetched via [daymet_request()] or supplied by the +#' user. All variables are available at a daily resolution since 1980 in +#' North America and Hawaii, and since 1950 in Puerto +#' Rico, and at a ~ 1 km spatial resolution. This data is retreived via the NASA +#' AppEEARS service, requiring an EarthData account to be made. This can be +#' done at the following link: [register for an EarthData +#' account](https://urs.earthdata.nasa.gov/users/new). Users should be aware +#' that since these data are at a daily resolution a large number of files will +#' be downloaded for datasets with many dates. +#' +#' One (or multiple) Daymet variable(s) can be downloaded by specifying the following +#' values to the `covariates` argument in [daymet_request()]: +#' - Day length (s/day): `daymet_dayl` +#' - Precipitation (mm/day): `daymet_prcp` +#' - Shortwave radiation (W/m^2): `dayment_srad` +#' - Snow water equivalent (kg/m^2): `daymet_swe` +#' - Maximum air temperature (°C): `daymet_tmax` +#' - Minimum air temperature (°C): `daymet_tmin` +#' - Water vapor pressure (Pa): `daymet_vp` +#' +#' Downloads are facilitated by a call to [appeears::rs_transfer()]. +#' +#' @param daymet_reqs `data.frame`. A `data.frame` with columns 1) +#' `request_name` containing AppEEARS request names, 2) `request_id` +#' containing AppEEARS request IDs, and optionally 3) `date` containing the +#' date for which the associated request is downloading data for, or a +#' filepath to a `.rds` file containing such data. The direct output of +#' [daymet_request()] can be supplied here. +#' @param ed_username Character. The username associated with your EarthData account. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `scanfi/` in the working +#' directory. +#' @param verbose Logical. Should messages be displayed? +#' +#' @returns A `data.frame` with three columns: 1) `request_name` containing +#' AppEEARS request names, 2) `request_id` containing AppEEARS request IDs, +#' and 3) `date` containing the date for which the associated request is +#' downloading data for. +#' +#' @examplesIf interactive() +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Grab data from a single year +#' bcch <- bcch[bcch$survey_year == 2011,] +#' +#' # Enter EarthData username +#' ed_username <- "your EarthData username" +#' +#' # Submit Daymet requests +#' requests <- daymet_request(data = bcch, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' # Once email is received confirming that request has been processed, execute +#' # download! +#' downloaded <- daymet_download(daymet_reqs = requests, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' +#' +#' @seealso [daymet_request()] which can be used to submit requests for Dayment +#' data. +#' +#' [daymet_check()] to check the status of existing requests. +#' +#' [daymet_extract()] which can be used to extract data from downloaded +#' Daymet files. +#' +#' @export + +# Function to download data from Daymet. Wrapper for appeears::request_rs(). +daymet_download <- function( + daymet_reqs, + ed_username, # users' EarthData account username NOT EMAIL. + dl_path = NULL, # optional argument to provide path to download data to. By + # default, data is downloaded to a subfolder 'worldclim/' in the working + # directory. + verbose = TRUE +) { + # Check packages + have_pkg_check(c( + "sf", + "terra", + "appeears" + )) + + # Check that an EarthData account username has been provided. If not, return + # error. + if (missing(ed_username)) { + stop( + "[Daymet Download] Daymet data requested but Earthdata system login", + " information not supplied. NOTE: downloading Daymet data requires your", + " EarthData username, not email. Please register at", + " https://urs.earthdata.nasa.gov/users/new and supply using", + " the `ed_username` parameter.", + call. = FALSE + ) + } + + # Check whether user password is stored in .Renviron + ed_password <- Sys.getenv("EarthData_password") + + # If not available in .Renviron, check whether an EarthData password exists + # in the environment (is specified earlier in the nc_covariates() workflow), + # and if not, request using askpass::askpass(). + if (ed_password == "") { + if (is.null(parent.frame()$ed_password)) { + ed_password <- askpass::askpass( + prompt = paste0( + "Please enter password for ", + "EarthData user '", + ed_username, + "'." + ) + ) + + if (is.null(ed_password)) { + stop( + "[Daymet Download] EarthData password could not be found", + ". Please add line 'EarthData_password = yourpassword' to your", + " .Renviron file. This can be accessed using usethis::edit_r_environ().", + call. = FALSE + ) + } + } else { + ed_password <- parent.frame()$ed_password + } + } + + # Set EarthData username and password in user Keyring. + options(keyring_backend = "file") + + if (verbose == FALSE) { + suppressMessages(appeears::rs_set_key( + user = ed_username, + password = ed_password + )) + } else { + appeears::rs_set_key(user = ed_username, password = ed_password) + } + + # Autheniticate with AppEEARS. + token <- appeears::rs_login(user = ed_username) + + # Check whether daymet_reqs is a filepath to a .RDS file. + if (inherits(daymet_reqs, "character")) { + if (all(file.exists(daymet_reqs))) { + daymet_reqs <- readRDS(daymet_reqs) + } else { + stop( + "[Daymet Download] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + } + + if (!inherits(daymet_reqs, "data.frame")) { + stop( + "[Daymet Download] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + + if (!(all(c("request_name", "request_id") %in% names(daymet_reqs)))) { + stop( + "[Daymet Download] daymet_reqs in an unexpected format. Please", + " provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + + # Check that daymet_reqs contains valid request IDs within the user's AppEEARS + # task ids + task_list <- appeears::rs_list_task(user = ed_username) + + if ( + FALSE %in% + (daymet_reqs$request_id %in% + task_list$task_id[ + lubridate::as_datetime(task_list$expires_on) > + lubridate::as_datetime(Sys.time()) + ]) + ) { + stop( + "[Daymet Download] request ID(s) ", + stringr::str_flatten_comma(daymet_reqs$request_name[ + daymet_reqs$request_id %in% + task_list$task_id[ + lubridate::as_datetime(task_list$expires_on) > + lubridate::as_datetime(Sys.time()) + ] == + FALSE + ]), + " provided in daymet_reqs are not", + " registered under EarthData user ", + ed_username, + ". Are they more than a month old (i.e., expired), or entered incorrectly?", + call. = FALSE + ) + } + + # Check status of requests + incomplete_tasks <- c() + + for (i in 1:nrow(daymet_reqs)) { + status <- task_list$status[task_list$task_id == daymet_reqs$request_id[i]] + + if (status %in% c("pending", "queued", "processing")) { + incomplete_tasks <- c(incomplete_tasks, daymet_reqs$request_name[i]) + } + } + + if (length(incomplete_tasks) > 0) { + # End AppEEARS session. + if (verbose == FALSE) { + suppressMessages(appeears::rs_logout(token)) + } else { + appeears::rs_logout(token) + } + + stop( + "[Daymet Download] some supplied Daymet requests are incomplete.", + " Please wait for confirmation at the email address associated with", + " your EarthData account '", + ed_username, + "' or use daymet_check() to confirm that requests with the following", + " request IDs are complete: ", + stringr::str_flatten_comma(incomplete_tasks), + ".", + call. = FALSE + ) + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./daymet")) { + dir.create("./daymet", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/daymet"))) { + dir.create(paste0(dl_path, "/daymet"), recursive = TRUE) + } + + # Loop through each year and download respective request if not already + # downloaded. + for (i in 1:nrow(daymet_reqs)) { + if ( + !dir.exists(ifelse( + is.null(dl_path), + paste0("./daymet/", daymet_reqs$request_name[i]), + paste0(dl_path, "/daymet/", daymet_reqs$request_name[i]) + )) + ) { + dir.create(ifelse( + is.null(dl_path), + paste0("./daymet/", daymet_reqs$request_name[i]), + paste0(dl_path, "/daymet/", daymet_reqs$request_name[i]) + )) + + if (verbose) { + message(paste0( + "[Daymet Download] downloading Daymet data from request ", + i + )) + } + + appeears::rs_transfer( + task_id = daymet_reqs$request_id[i], + user = ed_username, + path = ifelse( + is.null(dl_path), + paste0("./daymet/", daymet_reqs$request_name[i]), + paste0(dl_path, "/daymet/", daymet_reqs$request_name[i]) + ), + verbose = verbose + ) + + if (verbose) { + message(paste0( + "[Daymet Download] Daymet data for request", + i, + " downloaded." + )) + } + } + } + + # End AppEEARS session. + if (verbose == FALSE) { + suppressMessages(appeears::rs_logout(token)) + } else { + appeears::rs_logout(token) + } + + daymet_reqs$success <- NA + + for (i in daymet_reqs$request_name) { + path <- ifelse( + is.null(dl_path), + paste0("./daymet/", i), + paste0(dl_path, "/daymet/", i) + ) + + if (file.exists(paste0(path, "/Daymet-004-Statistics.csv"))) { + daymet_stats <- readr::read_csv( + paste0(path, "/Daymet-004-Statistics.csv"), + show_col_types = FALSE + ) + + tifs_exist <- c() + + for (j in unique(daymet_stats$Dataset)) { + for (k in unique(daymet_stats$Date[daymet_stats$Dataset == j])) { + filename <- gsub( + pattern = "DAYMET_", + replacement = "DAYMET.", + daymet_stats$`File Name`[ + daymet_stats$Date == k & + daymet_stats$Dataset == j + ] + ) + + if (file.exists(paste0(path, "/", filename, ".tif"))) { + tifs_exist <- c(tifs_exist, TRUE) + } else { + tifs_exist <- c(tifs_exist, FALSE) + } + } + } + + if (all(tifs_exist)) { + daymet_reqs$success[daymet_reqs$request_name == i] <- TRUE + } else { + daymet_reqs$success[daymet_reqs$request_name == i] <- FALSE + } + } else { + daymet_reqs$success[daymet_reqs$request_name == i] <- FALSE + } + } + + # Return request ID object. + return(daymet_reqs) +} diff --git a/R/daymet_extract.R b/R/daymet_extract.R new file mode 100644 index 00000000..1354096e --- /dev/null +++ b/R/daymet_extract.R @@ -0,0 +1,714 @@ +#' Extract Data from Daymet. +#' +#' Extracts all available variables from [Daymet](https://daymet.ornl.gov/) and +#' matches them to input observation data. All variables are available at a daily +#' resolution since 1980 in North America and Hawaii, and since 1950 in Puerto +#' Rico, and at a ~ 1 km spatial resolution. This data can be requested from the +#' NASA AppEEARS service using [daymet_request()] and downloaded using +#' [daymet_download()]. +#' +#' One (or multiple) Daymet variable(s) can be extracted by specifying the following +#' values to the `covariates` argument. The appropriate variables must be available +#' in the AppEEARS request supplied to `daymet_reqs`. Requests can be submitted +#' via [daymet_request()] and downloaded via [daymet_download()]: +#' - Day length (s/day): `daymet_dayl` +#' - Precipitation (mm/day): `daymet_prcp` +#' - Shortwave radiation (W/m^2): `dayment_srad` +#' - Snow water equivalent (kg/m^2): `daymet_swe` +#' - Maximum air temperature (°C): `daymet_tmax` +#' - Minimum air temperature (°C): `daymet_tmin` +#' - Water vapor pressure (Pa): `daymet_vp` +#' +#' @param data A `data.frame`, `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons' object containing columns with the year, month, and day an +#' observation was made either named the BMDE defaults `survey_year`, `survey_month` +#' , and `survey_day` respectively or another name specified in arguments +#' `date_year`, `date_month`, and/or `date_day`. +#' @param daymet_reqs `data.frame`. A `data.frame` with columns 1) +#' `request_name` containing AppEEARS request names, 2) `request_id` +#' containing AppEEARS request IDs, and optionally 3) `date` containing the +#' date for which the associated request is downloading data for, or a +#' filepath to a `.rds` file containing such data. The direct output of +#' [daymet_request()] can be supplied here. +#' @param covariates Character, vector if multiple Daymet data types desired. By +#' default, extracts Daymet precipitation data. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()] or [daymet_download()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()] or [daymet_download()]. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()] or [daymet_download()]. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day-of-month (i.e., a number from 1 to 31) data if not +#' contained within the BMDE column `survey_day`. Can be left `NULL` and still +#' function properly if originally specified in a call to [data_fmt()] or +#' [daymet_download()]. +#' @param dl_path Character. Optional argument to provide path to downloaded data. +#' By default, data is downloaded to a subfolder `daymet/` in the working directory. +#' @param verbose Logical. Should messages be displayed? +#' @param retain Logical. Should Daymet data files be kept after extraction? If +#' `FALSE`, files will be deleted. +#' +#' @returns For sf 'POINT' or terra 'points' input data, original data with +#' column(s) appended containing the Daymet data value(s) at each point. +#' +#' For sf 'POLYGON' or terra 'polygons' input data, original data with column(s) +#' appended containing the mean Daymet data value(s) within each polygon. +#' +#' @examplesIf interactive() +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Grab data from a single year +#' bcch <- bcch[bcch$survey_year == 2011,] +#' +#' # Enter EarthData username +#' ed_username <- "your EarthData username" +#' +#' # Submit Daymet requests +#' requests <- daymet_download(data = bcch, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' +#' # Once email is received confirming that request has been processed, execute +#' # download! +#' downloaded <- daymet_download(daymet_reqs = requests, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' +#' # Once download is complete, extract! +#' extracted <- daymet_extract(data = bcch, +#' daymet_reqs = requests, +#' covariates = "daymet_prcp") +#' +#' +#' @seealso [daymet_request()] which can be used to submit requests for Dayment +#' data. +#' +#' [daymet_download()] to execute downloads once requests have been +#' submitted and are complete. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @export + +daymet_extract <- function( + data, + daymet_reqs, # Named list. Each list element should be named after + # a year for which data was requested, and should contain the corresponding + # request ID. + covariates = "daymet_prcp", # Options listed in nc_covariate_table(). + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + dl_path = NULL, # optional argument to provide path to download data to. By + # default, data is downloaded to a subfolder 'daymet/' in the working + # directory. + verbose = TRUE, + retain = TRUE +) { + # Check packages + have_pkg_check(c( + "sf", + "readr", + "terra" + )) + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[Daymet Extraction] extraction requires an sf or terra object as input", + " in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Check that DAYMET request information is supplied. + if (missing(daymet_reqs)) { + stop( + "[Daymet Extraction] no Daymet request details are provided to extract from.", + " Please provide either a data.frame with a column for the AppEEARS", + " request name called request_name and a column for the AppEEARS", + " request ID called request_id, or a filepath to a .rds file", + " created by daymet_request() containing such data.", + call. = FALSE + ) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + if (is.null(date_month) & !is.null(attr(data, "date_month"))) { + date_month <- attr(data, "date_month") + } + + if (is.null(date_day) & !is.null(attr(data, "date_day"))) { + date_day <- attr(data, "date_day") + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + if (length(attr_names[attr_names %in% names(attributes(data))]) > 0) { + attrs <- attributes(data)[attr_names[ + attr_names %in% names(attributes(data)) + ]] + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year, date_month, date_day) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols) | + !("survey_month" %in% data_cols) | + !("survey_day" %in% data_cols)) + ) { + stop( + "[Daymet Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that", + " diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + if (!is.null(date_month) & !("survey_month" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + # Validate month data using month_check() + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + data$survey_month <- month_corr + + data$survey_month <- as.numeric(data$survey_month) + + if (!is.null(date_day) & !("survey_day" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_day" = !!date_day) + } + + # Validate day data using dom_check() + for (i in data$survey_day) { + dom_check(i) + } + + data$survey_day <- as.numeric(data$survey_day) + + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "sf") { + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + } + + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "terra") { + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE) { + have_pkg_check("exactextractr") + } + + # Create index using requested covariates. + daymet_vars <- gsub( + pattern = "daymet_", + replacement = "", + grep("daymet_", covariates, value = TRUE) + ) + + appeears <- daymet_reqs + + # Open list to store information file that comes with downloaded Daymet data. + daymet_stats <- list() + + # Open vector to store date data. + all_dates <- c() + + # Loop through each year and check dates data is available for. This + # information is sourced from the DAYMET-004-Statistics.csv file that comes + # with downloads. If this file can't be found, return error. + for (i in appeears$request_name) { + if ( + file.exists(ifelse( + is.null(dl_path), + paste0( + "./daymet/", + i, + "/DAYMET-004-Statistics.csv" + ), + paste0( + dl_path, + "/daymet/", + i, + "/DAYMET-004-Statistics.csv" + ) + )) + ) { + daymet_stats[[i]] <- readr::read_csv( + ifelse( + is.null(dl_path), + paste0( + "./daymet/", + i, + "/DAYMET-004-Statistics.csv" + ), + paste0( + dl_path, + "/daymet/", + i, + "/DAYMET-004-Statistics.csv" + ) + ), + show_col_types = FALSE + ) + + all_dates <- c(all_dates, unique(daymet_stats[[i]]$Date)) + } else { + stop( + "[Daymet Extraction] cannot find ", + ifelse( + is.null(dl_path), + paste0( + "./daymet/", + i, + "/DAYMET-004-Statistics.csv" + ), + paste0( + dl_path, + "/daymet/", + i, + "/DAYMET-004-Statistics.csv" + ) + ), + ". Please provide this file along with all downloaded rasters in", + " folders for each request_name in daymet_reqs under a folder named", + "'daymet' in your working", + " directory (default) or under the path specified using the dl_path", + " argument.", + call. = FALSE + ) + } + } + + # Convert to date objects + all_dates <- as.Date(all_dates) + + # Create comparable date objects in original data. + data$date <- as.Date(paste0( + data$survey_year, + "-", + data$survey_month, + "-", + data$survey_day + )) + + # Note any dates that do not have available Daymet data. Warn. + missing_dates <- sort(data$date[!(data$date %in% all_dates)]) + + if (length(missing_dates) > 0) { + warning( + "[Daymet Extraction] data has not been provided for some dates. These", + " are: ", + stringr::str_flatten_comma(as.character(missing_dates)), + ". No value will be returned for these dates. Keep in mind that Daymet", + " data for the current year may not be available yet.", + call. = FALSE + ) + } + + # Fetch all dates with available data. + dates <- as.character(sort(unique(data$date[data$date %in% all_dates]))) + + # Open vector to store site names that are outside of spatial extent of + # provided Daymet files. + bad_sites <- c() + + # Loop through each requested Daymet variable and extract. + for (i in daymet_vars) { + # Loop through each date with data. + for (j in dates) { + j_date <- as.Date(j) + + # Grab all observations needing data from date j. + pts_to_fill <- dplyr::filter(data, .data$date == j_date) + + request_name <- grep( + pattern = j, + appeears$request_name, + value = TRUE + ) + + # Access corresponding file name from data in information file. + filename <- gsub( + pattern = "DAYMET_", + replacement = "DAYMET.", + daymet_stats[[request_name]]$`File Name`[ + daymet_stats[[request_name]]$Date == j_date & + daymet_stats[[request_name]]$Dataset == i + ] + ) + + # Read in data for date j. + daymet <- terra::rast(ifelse( + is.null(dl_path), + paste0( + "./daymet/", + request_name, + "/", + filename, + ".tif" + ), + paste0( + dl_path, + "/daymet/", + request_name, + "/", + filename, + ".tif" + ) + )) + + # Loop through each site and extract. + for (k in unique(pts_to_fill$SurveyAreaIdentifier)) { + tmp <- pts_to_fill %>% + dplyr::filter(.data$SurveyAreaIdentifier == k) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(sf::st_crs(daymet)) + + # Check if the site falls outside of or is only partially covered by + # the spatial extent of the provided Daymet rasters. If so, warn and + # store site name to avoid extracting data for it later. + if ( + !terra::is.related( + daymet, + terra::vect(tmp), + relation = "intersects" + ) + ) { + warning( + "[Daymet (", + i, + ") Extraction] site ", + k, + " falls outside of the spatial extent of the DAYMET rasters", + " provided. No value will be returned.", + call. = FALSE + ) + + bad_sites <- c(bad_sites, k) + } else if ( + terra::is.related( + daymet, + terra::vect(tmp), + relation = "intersects" + ) & + !terra::is.related( + daymet, + terra::vect(tmp), + relation = "contains" + ) + ) { + warning( + "[Daymet (", + i, + ") Extraction] site ", + k, + "'s buffered area is only partially contained by the spatial", + " extent of the DAYMET rasters provided. Returned ", + i, + " value will be derived from the available values.", + call. = FALSE + ) + + if (buffered == TRUE) { + data[ + data$SurveyAreaIdentifier == k & data$date == j_date, + i + ] <- exactextractr::exact_extract( + x = daymet, + y = tmp, + fun = "mean" + ) + } else { + data[ + data$SurveyAreaIdentifier == k & data$date == j_date, + i + ] <- terra::extract( + x = daymet, + y = tmp, + fun = "mean", + na.rm = TRUE + )[, 2] + } + } else { + # If no issues with coverage, proceed to extraction. If buffered, + # extract using exactextractr::exact_extract(). If not, extract + # using terra::extract(). + if (buffered == TRUE) { + data[ + data$SurveyAreaIdentifier == k & data$date == j_date, + i + ] <- exactextractr::exact_extract( + x = daymet, + y = tmp, + fun = "mean" + ) + } else { + data[ + data$SurveyAreaIdentifier == k & data$date == j_date, + i + ] <- terra::extract( + x = daymet, + y = tmp, + fun = "mean", + na.rm = TRUE + )[, 2] + } + } + } + + # Progress bar. + if (verbose) { + message(paste0( + "[Daymet ", + i, + " Extraction] Date ", + which(dates == j), + " of ", + length(dates), + " complete." + )) + } + } + + # Code to grab nearest raster value for sites outside of raster coverage. + # Not sure whether to keep this since we are warning users about these sites + # and saying nothing will be returned. Maybe keep as an option + # (nearest = TRUE)? + # + # if ( + # TRUE %in% + # is.na(data[ + # data$date %in% dates & !(data$SurveyAreaIdentifier %in% bad_sites), + # i + # ]) + # ) { + # warning(paste0( + # "[Daymet (", + # i, + # ") Extraction] some points are close to shore, and so fall outside of", + # " raster coverage. For these cells, the nearest cell value will be", + # " used. Repairing now." + # )) + # + # for (j in dates) { + # sites_to_fill <- unique(data$SurveyAreaIdentifier[ + # is.na(data[, i]) & data$date == j + # ]) + # + # if (nrow(sites_to_fill) > 0) { + # j_date <- as.Date(j) + # + # filename <- gsub( + # pattern = "DAYMET_", + # replacement = "DAYMET.", + # daymet_stats[[as.character(lubridate::year(j_date))]]$`File Name`[ + # daymet_stats[[as.character(lubridate::year(j_date))]]$Date == + # j_date & + # daymet_stats[[as.character(lubridate::year( + # j_date + # ))]]$Dataset == + # i + # ] + # ) + # + # daymet <- terra::rast(ifelse( + # is.null(dl_path), + # paste0( + # "./daymet/", + # appeears[[as.character(lubridate::year(j_date))]], + # "/", + # filename, + # ".tif" + # ), + # paste0( + # dl_path, + # "/daymet/", + # appeears[[as.character(lubridate::year(j_date))]], + # "/", + # filename, + # ".tif" + # ) + # )) + # + # for (k in sites_to_fill) { + # tmp <- data %>% + # dplyr::filter(SurveyAreaIdentifier == k) %>% + # dplyr::select(SurveyAreaIdentifier, geometry) %>% + # dplyr::distinct() %>% + # sf::st_buffer(2500) %>% + # sf::st_transform(terra::crs(daymet)) + # + # daymet_crop <- terra::crop(daymet, terra::vect(tmp)) %>% + # terra::as.points() + # + # near.pt <- terra::nearest(terra::vect(tmp), daymet_crop)$to_id + # + # data[ + # data$SurveyAreaIdentifier == k & data$date == j, + # i + # ] <- mean(terra::values(daymet_crop[near.pt])[, filename]) + # } + # } + # } + # } + } + + # Remove temporary date column from original data. + data <- dplyr::select(data, -"date") + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + if (!is.null(date_year)) { + names(data)[names(data) == "survey_year"] <- date_year + } + + if (!is.null(date_month)) { + names(data)[names(data) == "survey_month"] <- date_month + } + + if (!is.null(date_day)) { + names(data)[names(data) == "survey_day"] <- date_day + } + + # Remove Daymet files if requested. + if (retain == FALSE) { + if (verbose) { + message("[Daymet Extraction] task complete. Removing files.") + } + + file.remove(list.files( + ifelse(is.null(dl_path), "./daymet", paste0(dl_path, "/daymet")), + full.names = TRUE + )) + } + + # Return input data with appended Daymet columns. + return(data) +} diff --git a/R/daymet_request.R b/R/daymet_request.R new file mode 100644 index 00000000..dbc5d06b --- /dev/null +++ b/R/daymet_request.R @@ -0,0 +1,567 @@ +#' Submit Request for Daymet Data. +#' +#' Submits requests for all available variables from the +#' [Daymet](https://daymet.ornl.gov/) at the spatial extent of provided input +#' observation data. All variables are available at a daily +#' resolution since 1980 in North America and Hawaii, and since 1950 in Puerto +#' Rico, and at a ~ 1 km spatial resolution. Requests are submitted to the NASA +#' AppEEARS service, requiring an EarthData account to be made. This can be +#' done at the following link: [register for an EarthData +#' account](https://urs.earthdata.nasa.gov/users/new). +#' +#' One (or multiple) Daymet variable(s) can be requested by specifying the following +#' values to the `covariates` argument: +#' - Day length (s/day): `daymet_dayl` +#' - Precipitation (mm/day): `daymet_prcp` +#' - Shortwave radiation (W/m^2): `dayment_srad` +#' - Snow water equivalent (kg/m^2): `daymet_swe` +#' - Maximum air temperature (°C): `daymet_tmax` +#' - Minimum air temperature (°C): `daymet_tmin` +#' - Water vapor pressure (Pa): `daymet_vp` +#' +#' Due to API limitations, one request will be submitted for each day in `data`. +#' Unfortunately, AppEEARS automatically sends an email upon request receipt +#' and completion for each request, so for users with many observation dates, +#' we recommend considering setting rules in their email +#' client for handling these emails (address ). +#' +#' To preserve request information in the event the R session ends, users can +#' choose to set `save = TRUE` and have request information saved externally +#' in a `.rds` file. Users can then provide the path to this file to +#' [daymet_check()], [daymet_download()] or [daymet_extract()] or read it +#' back into the R environment using [base::readRDS()]. +#' +#' Once requests are submitted, users can use [daymet_check()] to check the +#' status of their requests. In the author's experience, requests take from +#' 1-24 hrs to process. Once requests are complete, downloads can be +#' executed with [daymet_download()]. +#' +#' Requests are facilitated by a call to [appeears::rs_request()]. +#' +#' @param data A `data.frame`, `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons' object containing columns with the year, month, and day an +#' observation was made either named the BMDE defaults `survey_year`, `survey_month` +#' , and `survey_day` respectively or another name specified in arguments +#' `date_year`, `date_month`, and/or `date_day`. +#' @param covariates Character, vector if multiple Daymet data types desired. By +#' default, downloads Daymet precipitation data. +#' @param ed_username Character. The username associated with your EarthData account. +#' @param request_name Character. Optional argument to provide informative name +#' for the AppEEARS request. This can make file management more intuitive for +#' the user. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day-of-month (i.e., a number from 1 to 31) data if not +#' contained within the BMDE column `survey_day`. Can be left `NULL` and still +#' function properly if originally specified in a call to [data_fmt()]. +#' `survey_year`. +#' @param dl_path Character. Optional argument to provide path to save request +#' information to. By default, data is downloaded to a subfolder `daymet/` in +#' the working directory. +#' @param save Logical. Should Daymet request ID information be saved externally +#' in a .rds file? +#' @param verbose Logical. Should messages be displayed? +#' +#' @returns A `data.frame` with three columns: 1) `request_name` containing +#' AppEEARS request names, 2) `request_id` containing AppEEARS request IDs, +#' and 3) `date` containing the date for which the associated request is +#' downloading data for. +#' +#' @examplesIf interactive() +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Grab data from a single year +#' bcch <- bcch[bcch$survey_year == 2011,] +#' +#' # Enter EarthData username +#' ed_username <- "your EarthData username" +#' +#' # Submit Daymet requests +#' requests <- daymet_request(data = bcch, +#' covariates = "daymet_prcp", +#' ed_username = ed_username) +#' +#' +#' @seealso [daymet_download()] to execute downloads once requests have been +#' submitted and are complete. +#' +#' [daymet_check()] to check the status of existing +#' requests. +#' +#' [daymet_extract()] which can be used to extract data +#' from downloaded Daymet files. +#' +#' @export + +# Function to request data from Daymet. Wrapper for appeears::request_rs(). +daymet_request <- function( + data, + covariates = "daymet_prcp", # Other options listed in nc_covariate_table(). + ed_username, # users' EarthData account username NOT EMAIL. + request_name = NULL, + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + dl_path = NULL, # optional argument to provide path to save request information + # to. By default, data is downloaded to a subfolder 'daymet/' in the working + # directory. + save = FALSE, + verbose = TRUE +) { + # Check packages + have_pkg_check(c( + "sf", + "terra", + "appeears" + )) + + # Check that an EarthData account username has been provided. If not, return + # error. + if (missing(ed_username)) { + stop( + "[Daymet Request] Daymet data requested but Earthdata system login", + " information not supplied. NOTE: downloading Daymet data requires your", + " EarthData username, not email. Please register at", + " https://urs.earthdata.nasa.gov/users/new and supply using", + " the `ed_username` parameter.", + call. = FALSE + ) + } + + # Check whether user password is stored in .Renviron + ed_password <- Sys.getenv("EarthData_password") + + # If not available in .Renviron, check whether an EarthData password exists + # in the environment (is specified earlier in the nc_covariates() workflow), + # and if not, request using askpass::askpass(). + if (ed_password == "") { + if (is.null(parent.frame()$ed_password)) { + ed_password <- askpass::askpass( + prompt = paste0( + "Please enter password for ", + "EarthData user '", + ed_username, + "'." + ) + ) + + if (is.null(ed_password)) { + stop( + "[Daymet Request] EarthData password could not be found", + ". Please add line 'EarthData_password = yourpassword' to your", + " .Renviron file. This can be accessed using usethis::edit_r_environ().", + call. = FALSE + ) + } + } else { + ed_password <- parent.frame()$ed_password + } + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[Daymet Request] downloading requires an sf or terra object as input", + " in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + if (is.null(date_month) & !is.null(attr(data, "date_month"))) { + date_month <- attr(data, "date_month") + } + + if (is.null(date_day) & !is.null(attr(data, "date_day"))) { + date_day <- attr(data, "date_day") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year, date_month, date_day) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols) | + !("survey_month" %in% data_cols) | + !("survey_day" %in% data_cols)) + ) { + stop( + "[Daymet Request] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + if (!is.null(date_month) & !("survey_month" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + # Use month_check() to validate month data. + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + data$survey_month <- month_corr + + data$survey_month <- as.numeric(data$survey_month) + + if (!is.null(date_day) & !("survey_day" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_day" = !!date_day) + } + + # Use dom_check() to validate day data. + for (i in data$survey_day) { + dom_check(i) + } + + data$survey_day <- as.numeric(data$survey_day) + + # Create area of interest polygon from provided sf object. + if (input_fmt$type == "sf") { + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_transform("ESRI:102001") %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } else { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } + } + + # Create area of interest polygon from provided terra object. + if (input_fmt$type == "terra") { + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::project("ESRI:102001") %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } else { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./daymet")) { + dir.create("./daymet", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/daymet"))) { + dir.create(paste0(dl_path, "/daymet"), recursive = TRUE) + } + + # Set EarthData username and password in user Keyring. + options(keyring_backend = "file") + + if (verbose == FALSE) { + suppressMessages(appeears::rs_set_key( + user = ed_username, + password = ed_password + )) + } else { + appeears::rs_set_key(user = ed_username, password = ed_password) + } + + # Autheniticate with AppEEARS. + token <- appeears::rs_login(user = ed_username) + + # Create index from each requested Daymet covariate. + daymet_vars <- gsub( + pattern = "daymet_", + replacement = "", + grep("daymet_", covariates, value = TRUE) + ) + + # Build a request for each surveyed year to be submitted to AppEEARS. This + # request will download data for every day in the input data. + + call_date <- gsub( + pattern = " ", + replacement = "_", + gsub( + pattern = "\\..*", + replacement = "", + gsub(pattern = ":", replacement = "", as.character(Sys.time())) + ) + ) + + dates <- sort(unique(paste0( + data$survey_year, + "-", + ifelse( + nchar(data$survey_month) == 1, + paste0(0, data$survey_month), + data$survey_month + ), + "-", + ifelse( + nchar(data$survey_day) == 1, + paste0(0, data$survey_day), + data$survey_day + ) + ))) + + tasks <- list() + + for (i in dates) { + tasks[[i]] <- data.frame( + task = ifelse( + is.null(request_name), + paste0("naturecounts_rq_", call_date, "_", i), + paste0(request_name, "_", call_date, "_", i) + ), + subtask = "subtask", + latitude = mean(sf::st_coordinates(data %>% sf::st_transform(4326))[, + "Y" + ]), + longitude = mean(sf::st_coordinates(data %>% sf::st_transform(4326))[, + "X" + ]), + start = i, + end = i, + product = "DAYMET.004", + layer = daymet_vars + ) + } + + # Final build and submission. + if (verbose) { + for (i in dates) { + task <- appeears::rs_build_task( + df = tasks[[i]], + roi = sf::st_as_sf(study_area), + format = "geotiff" + ) + + appeears::rs_request( + request = task, + user = ed_username, + transfer = FALSE, + verbose = verbose + ) + } + } else { + for (i in dates) { + task <- appeears::rs_build_task( + df = tasks[[i]], + roi = sf::st_as_sf(study_area), + format = "geotiff" + ) + + suppressMessages(appeears::rs_request( + request = task, + user = ed_username, + transfer = FALSE, + verbose = verbose + )) + } + } + + # Open vector to store request IDs. + task_ids <- c() + + # Grab request IDs. + tasklist <- appeears::rs_list_task(user = ed_username) + + for (i in dates) { + task_ids <- c( + task_ids, + tasklist$task_id[ + tasklist$task_name == + ifelse( + is.null(request_name), + paste0("naturecounts_rq_", call_date, "_", i), + paste0(request_name, "_", call_date, "_", i) + ) + ] + ) + } + + task_ids <- data.frame( + request_name = `if`( + is.null(request_name), + paste0("naturecounts_rq_", call_date, "_", dates), + paste0(request_name, "_", call_date, "_", dates) + ), + request_id = task_ids, + date = dates + ) + + # Save externally in case user ends R session. + if (save) { + path <- ifelse( + is.null(dl_path), + "./daymet/", + paste0( + dl_path, + "/daymet/" + ) + ) + + filename <- paste0( + path, + ifelse( + is.null(request_name), + paste0("daymet_reqs_", call_date, ".RDS"), + paste0(request_name, ".RDS") + ) + ) + + saveRDS( + task_ids, + file = filename + ) + } + + # End AppEEARS session. + if (verbose == FALSE) { + suppressMessages(appeears::rs_logout(token)) + } else { + appeears::rs_logout(token) + } + + # Send detailed message instructing user on next steps. + if (verbose) { + if (save) { + message( + "[Daymet Request] requests have been placed with AppEEARS for the data", + " you've requested. Look to your email for confirmation that these have", + " been completed. We have saved the request data in an external object", + " at ", + filename, + " and as the output of this daymet_request() call. Please", + " run daymet_download() to execute downloads once you have received", + " confirmation that these requests are approved at your EarthData email." + ) + } else { + message( + "[Daymet Request] requests have been placed with AppEEARS for the data", + " you've requested. Look to your email for confirmation that these have", + " been completed. We have saved the request data as the output of this", + " daymet_request() call. Please run daymet_download() to execute", + " downloads once you have received confirmation that these requests", + " are approved at your EarthData email." + ) + } + } + return(task_ids) +} diff --git a/R/elevation_download.R b/R/elevation_download.R new file mode 100644 index 00000000..bcbff1a5 --- /dev/null +++ b/R/elevation_download.R @@ -0,0 +1,194 @@ +#' Load Terrain Tiles Elevation Data +#' +#' Loads [Mapzen Terrain Tiles elevation data](https://github.com/tilezen/joerd/tree/master/docs), +#' delivered at varying spatial resolutions. This data is open access via [Amazon Web Services](https://registry.opendata.aws/terrain-tiles/), +#' and is a global composite of a variety of [data sources](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md). +#' Data is loaded into the R environment, and is not permanently downloaded onto +#' the user's operating system. +#' +#' Users should be conscious of the final spatial resolution of their elevation data, +#' as this varies by latitude and zoom level. This can be accessed using +#' [terra::res()]. +#' +#' Downloads are facilitated by a call to [elevatr::get_elev_raster()]. +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()]. +#' @param negative_to_na Logical. Should negative elevation values be turned into +#' `NA`? If `FALSE`, check the outputted rasters for unrealistically large negative +#' values as these may instead represent missing data. For coastal areas, negative +#' elevation values may represent bathymetry (i.e. sea depth). +#' @param z Numeric. Zoom level to fetch, determining the resulting spatial +#' resolution of downloaded elevation data. More information can be found +#' [here](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-the-ground-resolution). +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `TerrainTiles/` in the working +#' directory. +#' @param progress Logical. Should progress bars and download messages be displayed? +#' +#' @returns A `terra SpatRaster` in the projection of the data supplied to the `data` +#' argument, covering the bounding box of the supplied data. +#' +#' @examples +#' # Convert included, test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Load Terrain Tiles data +#' output <- elevation_download(data = bcch) +#' +#' @seealso [elevatr::get_elev_raster()] which this function wraps. +#' +#' [elevation_extract()] +#' which can be used to extract data from loaded elevation data files. +#' +#' @export + +# Function to download elevation data from Terrain Tiles. Wrapper for +# elevatr::get_elev_raster(). +elevation_download <- function( + data, + site_name = NULL, + negative_to_na = FALSE, + z = 7, + dl_path = NULL, + progress = TRUE +) { + # Check packages + have_pkg_check(c( + "sf", + "elevatr", + "terra" + )) + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[Elevation Download] downloading requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + # Check that all specified column names are present in the data. + specified_cols <- c(site_name) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + !("SurveyAreaIdentifier" %in% data_cols) + ) { + stop( + "[Elevation Download] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "sf") { + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + } + + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "terra") { + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./TerrainTiles")) { + dir.create("./TerrainTiles", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/TerrainTiles"))) { + dir.create(paste0(dl_path, "/TerrainTiles"), recursive = TRUE) + } + + message("[Elevation Download] downloading data.") + + # Call to API using elevatr::get_elev_raster() and store in SpatRaster. + if (progress == TRUE) { + elev <- elevatr::get_elev_raster( + locations = sf::st_transform(data, "ESRI:102001"), + z = z, + prj = sf::st_crs("ESRI:102001"), + src = "aws", + neg_to_na = negative_to_na, # Turn ocean tiles with negative elevation to NAs. + expand = 10000, # Arbitrarily high number selected (10km). + # Maybe unnecessary, could reduce download size. + verbose = TRUE, + tmp_dir = ifelse( + is.null(dl_path), + "./TerrainTiles", + paste0(dl_path, "/TerrainTiles") + ) + ) %>% + terra::rast() + } else { + suppressMessages( + elev <- elevatr::get_elev_raster( + locations = sf::st_transform(data, "ESRI:102001"), + z = z, + prj = sf::st_crs("ESRI:102001"), + src = "aws", + neg_to_na = negative_to_na, # Turn ocean tiles with negative elevation to NAs. + expand = 10000, # Arbitrarily high number selected (10km). + # Maybe unnecessary, could reduce download size. + verbose = FALSE, + tmp_dir = ifelse( + is.null(dl_path), + "./TerrainTiles", + paste0(dl_path, "/TerrainTiles") + ) + ) %>% + terra::rast() + ) + } + + # Return SpatRaster of downloaded elevation data. + return(elev) +} diff --git a/R/elevation_extract.R b/R/elevation_extract.R new file mode 100644 index 00000000..be12fd4c --- /dev/null +++ b/R/elevation_extract.R @@ -0,0 +1,312 @@ +#' Extract Terrain Tiles Elevation Data +#' +#' Extracts [Mapzen Terrain Tiles elevation data](https://github.com/tilezen/joerd/tree/master/docs) +#' from a `terra SpatRaster`, as delivered by [elevation_download()]. +#' +#' Users should be conscious of the final spatial resolution of their elevation data, +#' as this varies by latitude and zoom level specified in [elevation_download()]. +#' This can be accessed using [terra::res()]. +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param elevation_data `terra SpatRaster`. Terrain Tiles elevation data. We recommend using +#' [elevation_download()] to ensure that all data necessary to match your +#' input data are captured. Direct output of [elevation_download()] can be +#' supplied here. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()] or [elevation_download()]. +#' +#' @returns For sf 'POINT' or terra 'points' input data, original data with +#' numeric column `elevation` appended containing the elevation value (metres +#' above sea level) at each point. +#' +#' For sf 'POLYGON' or terra 'polygons' input data, original data with numeric +#' column `elevation` appended containing the mean elevation value (metres above +#' sea level) within each polygon. +#' +#' @examples +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Load Terrain Tiles data +#' elev <- elevation_download(data = bcch) +#' +#' # Extract Terrain Tiles data +#' output <- elevation_extract(data = bcch, elevation_data = elev) +#' +#' @seealso [elevation_download()] which can be used to download data from +#' the MapZen Terrain Tiles database. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @export + +# Function to extract elevation data from provided elevation SpatRaster. +elevation_extract <- function( + data, + elevation_data, # SpatRaster derived from elevatr::get_elev_raster(), + # downloadable via elevation_download(). + site_name = NULL # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). +) { + # Check packages + have_pkg_check(c( + "sf", + "terra" + )) + + # If no elevation raster is provided, return error. + if (missing(elevation_data)) { + stop( + "[Elevation Extraction] no elevation data provided to extract from. Please provide a terra SpatRaster containing the necessary elevation data. Elevation data can be downloaded using elevation_download().", + call. = FALSE + ) + } + + # If elevation_data is provided, but is not a SpatRaster return error. + if (!(inherits(elevation_data, "SpatRaster"))) { + stop( + "[Elevation Extraction] data provided to elevation_data argument is not a SpatRaster. Please provide a terra SpatRaster containing the necessary elevation data. Elevation data can be downloaded using elevation_download().", + call. = FALSE + ) + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[Elevation Extraction] extraction requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + attrs <- attributes(data)[attr_names[attr_names %in% names(attributes(data))]] + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + # Check that all specified column names are present in the data. + specified_cols <- c(site_name) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + !("SurveyAreaIdentifier" %in% data_cols) + ) { + stop( + "[Elevation Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "sf") { + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + } + + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "terra") { + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE) { + have_pkg_check("exactextractr") + } + + elev <- elevation_data + + message("[Elevation Extraction] extracting elevation data.") + + # Loop through each site and extract. + for (i in unique(data$SurveyAreaIdentifier)) { + # Create temporary object with only point/buffer for site i. + tmp <- data %>% + dplyr::filter(.data$SurveyAreaIdentifier == i) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() + + # Check if site i falls within the spatial extent of the provided elevation + # raster. If not, warn. If only partially, warn. + + #### BECAUSE OF THE EXTRA NANs WILL NEED TO REWORK THIS + if (!terra::is.related(elev, terra::vect(tmp), relation = "intersects")) { + warning( + "[Elevation Extraction] site ", + i, + " falls outside of the spatial extent of the elevation rasters", + " provided. No value will be returned.", + call. = FALSE + ) + } else if (buffered == TRUE) { + if (all(is.nan(terra::values(terra::crop(elev, tmp))))) { + warning( + "[Elevation Extraction] site ", + i, + " falls outside of the spatial extent of the elevation rasters", + " provided. No value will be returned.", + call. = FALSE + ) + } else if (TRUE %in% is.nan(terra::values(terra::crop(elev, tmp)))) { + warning( + "[Elevation Extraction] site ", + i, + "'s buffered area is only partially contained by the spatial extent of", + " the elevation rasters provided. Returned mean elevation value will", + " be derived from the available values.", + call. = FALSE + ) + + data[ + data$SurveyAreaIdentifier == i, + "elevation" + ] <- exactextractr::exact_extract( + x = elev, + y = tmp, + fun = "mean", + progress = FALSE + ) + } else { + data[ + data$SurveyAreaIdentifier == i, + "elevation" + ] <- exactextractr::exact_extract( + x = elev, + y = tmp, + fun = "mean", + progress = FALSE + ) + } + } else { + if (is.na(terra::extract(elev, tmp)[, 2])) { + warning( + "[Elevation Extraction] site ", + i, + " falls outside of the spatial extent of the elevation rasters", + " provided. No value will be returned.", + call. = FALSE + ) + } else { + # If no issues with coverage, proceed to extract. If buffered, extract + # using exactextractr::exact_extract(). If not, extract using + # terra::extract(). + data[data$SurveyAreaIdentifier == i, "elevation"] <- terra::extract( + x = elev, + y = tmp, + fun = "mean" + )[, names(elev)] + } + } + } + + # Code to grab nearest raster value for sites outside of raster coverage. + # Not sure whether to keep this since we are warning users about these sites + # and saying nothing will be returned. Maybe keep as an option + # (nearest = TRUE)? + # if (TRUE %in% is.na(data$elevation)) { + # warning( + # "[Elevation Extraction] some points are close to shore, and so fall into cells with negative elevation (below sea level). For these cells, the nearest positive elevation has been used.", + # call. = FALSE + # ) + # + # for (i in unique(data$SurveyAreaIdentifier[is.na(data$elevation)])) { + # tmp <- data %>% + # dplyr::filter(SurveyAreaIdentifier == i) %>% + # dplyr::select(SurveyAreaIdentifier, geometry) %>% + # dplyr::distinct() %>% + # sf::st_buffer(2500) + # + # if (terra::is.related(elev, terra::vect(tmp), relation = "intersects")) { + # elev_crop <- terra::crop(elev, vect(tmp)) %>% + # terra::as.points() + # + # data$elevation[ + # data$SurveyAreaIdentifier == i + # ] <- terra::values(elev_crop[ + # terra::nearest(terra::vect(tmp), elev_crop)$to_id + # ]) + # } + # } + # } + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + # Return input data with appended elevation columns. + return(data) +} diff --git a/R/landcover_download.R b/R/landcover_download.R new file mode 100644 index 00000000..58bc6665 --- /dev/null +++ b/R/landcover_download.R @@ -0,0 +1,625 @@ +#' Download MODIS Landcover Data +#' +#' Downloads [annual landcover data](https://doi.org/10.5067/MODIS/MCD12Q1.061) +#' derived from imagery from the MODIS Terra and Aqua satellites at +#' approximately 500 m spatial resolution. This data is retreived via the NASA +#' EarthData Archive, requiring an EarthData account to be made. This can be +#' done at the following link: [register for an EarthData +#' account](https://urs.earthdata.nasa.gov/users/new). +#' +#' All five classification schemes available through [landcover_extract()] are +#' downloaded by this function without need for extra specification. +#' +#' Downloads are facilitated by a call to [luna::getNASA()]. +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param ed_email Character. The email address associated with your EarthData +#' account. +#' @param ed_transfer Logical. Should data be downloaded from EarthData? +#' If `FALSE`, a vector containing the names of the files that would be +#' downloaded is returned. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `modis/` in the working +#' directory. +#' @param progress Logical. Should progress bars for downloads be displayed? +#' +#' @returns If `ed_transfer = TRUE`, character vector containing +#' file-paths to downloaded MODIS landcover files. If `ed_transfer = +#' FALSE`, character vector containing filenames of MODIS landcover files that +#' would be downloaded. +#' +#' @examplesIf interactive() +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Get file names that would be downloaded. +#' output <- landcover_download( +#' data = bcch, +#' ed_transfer = FALSE +#' ) +#' +#' # Enter EarthData email +#' ed_email <- "your EarthData email" +#' +#' # Download MODIS data +#' #output <- landcover_download( +#' # data = bcch, +#' # ed_email = ed_email +#' #) +#' +#' @seealso [luna::getNASA()] which this function wraps. +#' +#' [landcover_extract()] +#' which can be used to extract data from downloaded landcover data files. +#' +#' @export + +# Function for downloading MODIS MCD12Q1 data from NASA EarthData. Wrapper for +# luna::getNASA(). +landcover_download <- function( + data, + ed_email = NULL, # users' EarthData account email address. + ed_transfer = TRUE, # Should data be downloaded from EarthData? + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + dl_path = NULL, # optional argument to provide path to download data to. By + # default, data is downloaded to a subfolder 'modis/' in the working + # directory. + progress = TRUE # should download progress bars be displayed? +) { + # Check packages + have_pkg_check(c( + "sf", + "terra", + "luna" + )) + + # Check that ed_transfer is logical. + if (!is.logical(ed_transfer)) { + stop( + "[MODIS Landcover Download] ed_transfer must be TRUE or FALSE.", + call. = FALSE + ) + } + + # Check that an EarthData account email has been provided. If not, return + # error. + if (missing(ed_email) & ed_transfer == TRUE) { + stop( + "[MODIS Landcover Download] MODIS Landcover data requested but Earthdata", + " system login information not supplied. Please register at", + " https://urs.earthdata.nasa.gov/users/new and supply using `ed_email`", + " argument.", + call. = FALSE + ) + } + + # Check whether user password is stored in .Renviron + if (ed_transfer == TRUE) { + ed_password <- Sys.getenv("EarthData_password") + + # If not available in .Renviron, check whether an EarthData password exists + # in the environment (is specified earlier in the nc_covariates() workflow), + # and if not, request using askpass::askpass(). + if (ed_password == "") { + if (is.null(parent.frame()$ed_password)) { + ed_password <- askpass::askpass( + prompt = paste0( + "Please enter password for ", + "EarthData user '", + ed_email, + "'." + ) + ) + + if (is.null(ed_password)) { + stop( + "[MODIS Landcover Download] EarthData password could not be found", + ". Please add line 'EarthData_password = yourpassword' to your", + " .Renviron file. This can be accessed using usethis::edit_r_environ().", + call. = FALSE + ) + } + } else { + ed_password <- parent.frame()$ed_password + } + } + + # Attempt EarthData authentication three times to avoid errant API + # connect failures. + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + + if (inherits(auth, "try-error")) { + if (stringr::str_detect(auth, "aborted by an application callback")) { + stop(auth, call. = FALSE) + } else if ( + stringr::str_detect(auth, "could not reach Earthdata Login") | + stringr::str_detect(auth, "Timeout was reached") + ) { + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + if (inherits(auth, "try-error")) { + if (stringr::str_detect(auth, "aborted by an application callback")) { + stop(auth, call. = FALSE) + } else if ( + stringr::str_detect(auth, "could not reach Earthdata Login") | + stringr::str_detect(auth, "Timeout was reached") + ) { + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + if (inherits(auth, "try-error")) { + stop(auth, call. = FALSE) + } + } + } + } + } + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[MODIS Landcover Download] downloading requires an sf or terra object", + " as input in this workflow. Consider using `data_fmt` to conform data", + " first.", + call. = FALSE + ) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols)) + ) { + stop( + "[MODIS Landcover Download] some specified columns missing from the", + " data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that", + " diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier") %in% data_cols) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year") %in% data_cols) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + # Create area of interest polygon from provided sf object. + if (input_fmt$type == "sf") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_transform("ESRI:102001") %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } else { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } + } + + # Create area of interest polygon from provided terra object. + if (input_fmt$type == "terra") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::project("ESRI:102001") %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } else { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) # Maybe down the line write full process out + # in terra for terra data? + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./modis/MCD12Q1") & ed_transfer == TRUE) { + dir.create("./modis/MCD12Q1", recursive = TRUE) + } + + if ( + !is.null(dl_path) & + !dir.exists(paste0(dl_path, "/modis/MCD12Q1")) & + ed_transfer == TRUE + ) { + dir.create(paste0(dl_path, "/modis/MCD12Q1"), recursive = TRUE) + } + + if (ed_transfer == TRUE) { + message("[MODIS Landcover Download] downloading data.") + } else { + message("[MODIS Landcover Download] fetching data filenames.") + } + + # Call to API using luna::getNASA() + + if (ed_transfer == FALSE) { + modis_files <- c() + missing_year <- c() + + # Ensures that the closest year available for years before the start of + # dataset coverage (2001) is listed. + if (TRUE %in% (data$survey_year < 2001) & !(2001 %in% data$survey_year)) { + modis_files <- c( + modis_files, + luna::getNASA( + product = "MCD12Q1", + start = "2001-01-01", # Starting year + end = "2001-12-31", # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = FALSE, + verbose = progress + ) + ) + } + + # Now, gather files for all years 2001 and after. + for (i in sort(unique(data$survey_year))) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i, "-01-01"), # Starting year + end = paste0(i, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = FALSE, + verbose = progress + )) + + # Record years with no data associated. + if (is.null(tmp)) { + missing_year <- c(missing_year, i) + } else { + modis_files <- c(modis_files, tmp) + } + } + + # If nothing found for a year after 2001, indicates that year is current + # year or later. Fetch filename for year - 1. + if (FALSE %in% (missing_year < 2001)) { + for (i in missing_year[missing_year >= 2001]) { + if (!((i - 1) %in% data$survey_year)) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i - 1, "-01-01"), # Starting year + end = paste0(i - 1, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = FALSE, + verbose = progress + )) + # If nothing found for year - 1, try year - 2. + if (is.null(tmp)) { + if (!((i - 2) %in% data$survey_year)) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i - 2, "-01-01"), # Starting year + end = paste0(i - 2, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = FALSE, + verbose = progress + )) + + # Warn if year-2 doesn't return anything. + if (is.null(tmp)) { + warning( + "[MODIS Landcover Download] Year ", + i, + " is more than 2 ", + "years away from the next ", + "available MODIS data year. This usually indicates an ", + "incorrectly year too far in the future as MODIS data is ", + "rarely more than 2 years behind the current year.", + call. = FALSE + ) + } else { + modis_files <- c(modis_files, tmp) + } + } + } else { + modis_files <- c(modis_files, tmp) + } + } + } + } + + if (length(missing_year) > 0) { + if (TRUE %in% (missing_year < 2001)) { + if (FALSE %in% (missing_year < 2001)) { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for all years before 2001 as well as ", + stringr::str_flatten_comma(sort(missing_year[ + missing_year >= 2001 + ])), + ". landcover_extract() will extract landcover data from 2001 ", + "or the nearest year for these observations.", + call. = FALSE + ) + } else { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for all years before 2001. landcover_extract() ", + "will extract landcover data from 2001 for these observations.", + call. = FALSE + ) + } + } else { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for ", + stringr::str_flatten_comma(sort(missing_year)), + ". landcover_extract() will extract landcover data from ", + "the nearest available year for these observations.", + call. = FALSE + ) + } + } + modis_files <- sort(unique(modis_files)) + } else { + modis_files <- c() + missing_year <- c() + + # Ensures that the closest year available for years before the start of + # dataset coverage (2001) is downloaded. + if (TRUE %in% (data$survey_year < 2001)) { + modis_files <- + luna::getNASA( + product = "MCD12Q1", + start = "2001-01-01", # Starting year + end = "2001-12-31", # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = TRUE, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MCD12Q1", + paste0(dl_path, "/modis/MCD12Q1") + ), + auth = auth, + verbose = progress + ) + + # Record years with no data associated. + missing_year <- c( + missing_year, + unique(data$survey_year[data$survey_year < 2001]) + ) + } + + # Now, download for years 2001 and after. + if (TRUE %in% (data$survey_year >= 2001)) { + for (i in sort(unique(data$survey_year[data$survey_year >= 2001]))) { + # If 2001 data downloaded above, do nothing. Otherwise, download that + # year's data. + if (!(i == 2001 & length(modis_files > 0))) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i, "-01-01"), # Starting year + end = paste0(i, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = TRUE, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MCD12Q1", + paste0(dl_path, "/modis/MCD12Q1") + ), + auth = auth, + verbose = progress + )) + + # Record years with no data associated. + if (is.null(tmp)) { + missing_year <- c(missing_year, i) + } + + # If nothing found, indicates that year is current year or later. Download + # data for year - 1. If already downloaded, overwrite = FALSE will + # prevent downloading same file twice. + if (is.null(tmp)) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i - 1, "-01-01"), # Starting year + end = paste0(i - 1, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = TRUE, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MCD12Q1", + paste0(dl_path, "/modis/MCD12Q1") + ), + auth = auth, + verbose = progress + )) + + # Just in case, try year - 2 if MODIS data upload is really behind for + # some reason. + if (is.null(tmp)) { + tmp <- suppressWarnings(luna::getNASA( + product = "MCD12Q1", + start = paste0(i - 2, "-01-01"), # Starting year + end = paste0(i - 2, "-12-31"), # End year + aoi = terra::ext(terra::project(study_area, "epsg:4326")), + download = TRUE, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MCD12Q1", + paste0(dl_path, "/modis/MCD12Q1") + ), + auth = auth, + verbose = progress + )) + + # Warn if year-2 doesn't return anything. + if (is.null(tmp)) { + warning( + "[MODIS Landcover Download] Year ", + i, + " is more than 2 ", + "years away from the next ", + "available MODIS data year. This usually indicates an ", + "incorrectly entered year too far in the future as MODIS data is ", + "rarely more than 2 years behind the current year.", + call. = FALSE + ) + } else { + modis_files <- c(modis_files, tmp) + } + } else { + modis_files <- c(modis_files, tmp) + } + } else { + modis_files <- c(modis_files, tmp) + } + } + } + } + + if (length(missing_year) > 0) { + if (TRUE %in% (missing_year < 2001)) { + if (FALSE %in% (missing_year < 2001)) { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for all years before 2001 as well as ", + stringr::str_flatten_comma(sort(missing_year[ + missing_year >= 2001 + ])), + ". landcover_extract() will extract landcover data from 2001 ", + "or the nearest year for these observations.", + call. = FALSE + ) + } else { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for all years before 2001. landcover_extract() ", + "will extract landcover data from 2001 for these observations.", + call. = FALSE + ) + } + } else { + warning( + "[MODIS Landcover Download] MODIS landcover data ", + "unavailable for ", + stringr::str_flatten_comma(sort(missing_year)), + ". landcover_extract() will extract landcover data from ", + "the nearest available year for these observations.", + call. = FALSE + ) + } + } + } + + # Return character vector of filepaths to downloaded files. + return(modis_files) +} diff --git a/R/landcover_extract.R b/R/landcover_extract.R new file mode 100644 index 00000000..2887b16e --- /dev/null +++ b/R/landcover_extract.R @@ -0,0 +1,704 @@ +#' Extract MODIS Landcover Data +#' +#' Extracts [annual landcover data](https://doi.org/10.5067/MODIS/MCD12Q1.061) +#' derived from imagery from the MODIS Terra and Aqua satellites at +#' approximately 500 m spatial resolution. This data can be downloaded using +#' [landcover_download()]. +#' +#' Five landcover classification schemes are available through this function and +#' can be accessed by supplying the following arguments to the `covariates` +#' argument: +#' - `modis_lctype1` - IGBP global vegetation classification scheme +#' - `modis_lctype2` - University of Maryland (UMD) scheme +#' - `modis_lctype3` - MODIS-derived LAI/fPAR scheme +#' - `modis_lctype4` - MODIS-derived Net Primary Production (NPP) scheme +#' - `modis_lctype5` - Plant Functional Type (PFT) scheme +#' +#' Details on these classification schemes can be found in Chapter 5 of the +#' [MODIS User +#' Guide](https://lpdaac.usgs.gov/documents/101/MCD12_User_Guide_V6.pdf). By +#' default, the function extracts the University of Maryland scheme +#' (`modis_lctype1`), but we strongly recommend users consider the strengths and +#' weaknesses of each classification scheme in the context of their analysis and +#' choose their desired classification scheme appropriately. +#' +#' @inheritParams landcover_download +#' +#' @param covariates Character, vector if multiple landcover types desired. By +#' default, extracts the IGBP global vegetation classification scheme +#' (`modis_lctype1`). +#' @param landcover_files Character, vector if multiple files. File-path(s) to +#' downloaded MODIS landcover data file(s). We recommend using +#' [landcover_download()] to download MODIS files to ensure all files +#' necessary for your data are captured. Direct output of +#' [landcover_download()] can be supplied here. +#' @param site_name Character. Optional argument to provide name of the column +#' containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()] or [landcover_download()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left NULL and still function properly if originally +#' specified in a call to [data_fmt()] or [landcover_download()]. +#' @param retain Logical. Should MODIS data files be kept after extraction. If +#' `FALSE`, files will be deleted. +#' +#' @returns For `sf` 'POINT' or `terra` 'points' input data, original data with +#' a character column `lctype1` appended containing the name of the landcover +#' class that point falls within. +#' +#' For `sf` 'POLYGON' or `terra` 'polygons' input data, original data with +#' numeric columns containing the proportion of each polygon that is covered +#' by each landcover type. +#' +#' @examplesIf interactive() +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Enter EarthData email +#' ed_email <- readline(prompt = "Enter EarthData email: ") +#' +#' # Download MODIS data +#' modis_files <- landcover_download( +#' bcch, +#' ed_email = ed_email +#' ) +#' +#' # Extract landcover data +#' output <- landcover_extract( +#' data = bcch, +#' covariates = "modis_lctype1", +#' landcover_files = modis_files, +#' retain = FALSE +#' ) +#' +#' @seealso [landcover_download()] which can be used to download data from +#' the MODIS Landcover dataset. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @export + +# Function to extract land cover data from provided MODIS MCD12Q1 data files. +landcover_extract <- function( + data, + covariates = "modis_lctype1", # Other options listed in nc_covariate_table(). + landcover_files, # Character vector of filepaths to downloaded files. + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + retain = TRUE # Should data files be kept after extraction? +) { + # Check packages + have_pkg_check(c( + "sf", + "luna", + "terra", + "stats" + )) + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[MODIS Landcover Extraction] covariates either not listed or one or", + " more are invalid. Please provide covariate names as listed under", + " `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + # If no landcover files are provided, return error. + if (missing(landcover_files) | length(landcover_files) == 0) { + stop( + "[MODIS Landcover Extraction] no landcover files provided to extract from. Please provide a vector containing filepaths of all necessary MODIS files for your data. Data can be downloaded using landcover_download().", + call. = FALSE + ) + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[MODIS Landcover Extraction] extraction requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + if (length(attr_names[attr_names %in% names(attributes(data))]) > 0) { + attrs <- attributes(data)[attr_names[ + attr_names %in% names(attributes(data)) + ]] + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols)) + ) { + stop( + "[MODIS Landcover Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + # Check whether object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "sf") { + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + } + + if (input_fmt$type == "terra") { + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) # Maybe down the line write full process out in terra for terra data. + } + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE) { + have_pkg_check("landscapemetrics") + } + + # Parse dates stored in filenames of MODIS data files and append column to + # filenames. + modis_files <- luna::modisDate(landcover_files) + modis_files <- cbind( + modis_files, + as.data.frame(luna::modisExtent(modis_files$filename)) + ) + + modis_files$year <- as.numeric(modis_files$year) + + # Build object to use in matching sites to their respective MODIS data file. + modis_match <- data %>% + dplyr::select("SurveyAreaIdentifier", "survey_year", "geometry") %>% + sf::st_transform(terra::crs(terra::rast(modis_files$filename[1]))) + + # If buffered, extract coordinates from centroids. Append coordinates. + if (buffered == TRUE) { + suppressWarnings( + modis_match <- cbind( + modis_match, + sf::st_coordinates(sf::st_centroid(modis_match)) + ) + ) + } else { + modis_match <- cbind(modis_match, sf::st_coordinates(modis_match)) + } + + warning_years <- c() + nearest_years <- c() + # Loop through years to check that all are represented in the MODIS data. + # When requests are placed for data containing years not covered by MODIS, + # nothing in the downloading process alerts the user to this. Warn here, and + # use nearest year. + for (i in sort(unique(modis_match$survey_year))) { + if (!(i %in% modis_files$year)) { + warning_years <- c(warning_years, i) + nearest_years <- unique(c( + nearest_years, + unique(modis_files$year)[which( + abs(i - unique(modis_files$year)) == + min(abs(i - unique(modis_files$year))) + )] + )) + } + } + + if (length(warning_years) > 0) { + warning( + paste0( + "[MODIS Landcover Extraction]: MODIS data not available for ", + stringr::str_flatten_comma(warning_years), + " - using data from nearest year(s) (", + stringr::str_flatten_comma(nearest_years), + ")." + ), + call. = FALSE + ) + } + + # Open vector to store names of out of range sites. NOTE: this might not be + # that informative for datasets without dedicated site names. + out_of_range <- c() + + # Loop through each site-year combination and match to appropriate file. + for (i in unique(modis_match$SurveyAreaIdentifier)) { + for (j in unique(modis_match$survey_year[ + modis_match$SurveyAreaIdentifier == i + ])) { + # Create temporary spatial object containing only the buffer for site i. + tmp <- dplyr::filter( + modis_match, + .data$SurveyAreaIdentifier == i, + .data$survey_year == j + ) %>% + dplyr::distinct() + + # Check if the coordinates of that site fall within the coverage of the + # provided MODIS files. If not, warn and note site name. If not, proceed + # with file-matching. + if ( + all(tmp$X > modis_files$xmax) | + all(tmp$X < modis_files$xmin) | + all(tmp$Y > modis_files$ymax) | + all(tmp$Y < modis_files$ymin) + ) { + warning( + "[MODIS Landcover Extraction] site ", + i, + " falls outside of the spatial extent of the MODIS files provided.", + " No value will be assigned.", + call. = FALSE + ) + + out_of_range <- c(out_of_range, i) + } else { + # Match to appropriate file, using either the nearest year covered by + # MODIS if the data's year is outside MODIS coverage, or the data's + # year, and the site's coordinates. + suppressWarnings( + if (!(j %in% modis_files$year)) { + modis_match[ + modis_match$SurveyAreaIdentifier == i & + modis_match$survey_year == j, + "filename" + ] <- modis_files$filename[ + modis_files$year == + unique(modis_files$year)[which( + abs(j - unique(modis_files$year)) == + abs(min(j - unique(modis_files$year))) + )] & + modis_files$xmin < tmp$X & + modis_files$xmax > tmp$X & + modis_files$ymin < tmp$Y & + modis_files$ymax > tmp$Y + ] + } else { + modis_match[ + modis_match$SurveyAreaIdentifier == i & + modis_match$survey_year == j, + "filename" + ] <- modis_files$filename[ + modis_files$year == tmp$survey_year & + modis_files$xmin < tmp$X & + modis_files$xmax > tmp$X & + modis_files$ymin < tmp$Y & + modis_files$ymax > tmp$Y + ] + } + ) + } + } + + rm(tmp) + } + + # Create object with parseable names for MODIS classes. Transcribed from + # documentation at + # https://lpdaac.usgs.gov/documents/101/MCD12_User_Guide_V6.pdf where + # class definitions are also available. NOTE: might be worth transcribing + # these into an object within NatureCounts. + modis_classes <- list( + modis_lctype1 = data.frame( + class = c(1:17, 255), + name = c( + "evergreen_needleleaf_forests", + "evergreen_broadleaf_forests", + "decidious_needleleaf_forests", + "deciduous_broadleaf_forests", + "mixed_forests", + "closed_shrublands", + "open_shrublands", + "woody_savannas", + "savannas", + "grasslands", + "permanent_wetlands", + "croplands", + "urban_builtup_lands", + "cropland_natural_vegetation_mosaic", + "permanent_snow_ice", + "barren", + "water_bodies", + "unclassified" + ) + ), + modis_lctype2 = data.frame( + class = c(0:15, 255), + name = c( + "water_bodies", + "evergreen_needleleaf_forests", + "evergreen_broadleaf_forests", + "deciduous_needleleaf_forests", + "deciduous_broadleaf_forests", + "mixed_forests", + "closed_shrublands", + "open_shrublands", + "woody_savannas", + "savannas", + "grasslands", + "permanent_wetlands", + "croplands", + "urban_builtup_lands", + "cropland_natural_vegetation_mosaic", + "nonvegetated_lands", + "unclassified" + ) + ), + modis_lctype3 = data.frame( + class = c(0:10, 255), + name = c( + "water_bodies", + "grasslands", + "shrublands", + "broadleaf_croplands", + "savannas", + "evergreen_broadleaf_forests", + "deciduous_broadleaf_forests", + "evergreen_needleleaf_forests", + "deciduous_needleleaf_forests", + "nonvegetated_lands", + "urban_builtup_lands", + "unclassified" + ) + ), + modis_lctype4 = data.frame( + class = c(0:8, 255), + name = c( + "water_bodies", + "evergreen_needleleaf_vegetation", + "evergreen_broadleaf_vegetation", + "deciduous_needleleaf_vegetation", + "deciduous_broadleaf_vegetation", + "annual_broadleaf_vegetation", + "annual_grass_vegetation", + "nonvegetated_lands", + "urban_builtup_lands", + "unclassified" + ) + ), + modis_lctype5 = data.frame( + class = c(0:11, 255), + name = c( + "water_bodies", + "evergreen_needleleaf_trees", + "evergreen_broadleaf_trees", + "deciduous_needleleaf_trees", + "deciduous_broadleaf_trees", + "shrub", + "grass", + "cereal_croplands", + "broadleaf_croplands", + "urban_builtup_lands", + "permanent_snow_ice", + "barren", + "unclassified" + ) + ) + ) + + # Open loop going through each requested land cover classification and + # extracting. + for (i in grep("modis_lc", covariates, value = TRUE)) { + # Parse covariate name for layer name used by MODIS data files. + index <- gsub("modis_lct", "LC_T", i) + + message(paste0( + "[MODIS Landcover Extraction] calculating MODIS ", + gsub("_", " ", index), + "." + )) + + # Loop through each matched MODIS data file. + for (j in stats::na.omit(unique(modis_match$filename))) { + # Create object with all sites that matched to file j. + pts_to_fill <- data[ + data$SurveyAreaIdentifier %in% + modis_match$SurveyAreaIdentifier[modis_match$filename == j], + ] + + # Open the requested layer in file j. + modis <- terra::rast(j)[index] + + # Loop through each site matched to file j and extract. + for (k in unique(pts_to_fill$SurveyAreaIdentifier)) { + # If buffered, extract using landscapemetrics::calculate_lsm(). If not, + # extract using terra::extract(). + if (buffered == TRUE) { + # Create temporary object containing only the buffer for site k. + tmp <- data %>% + dplyr::filter(.data$SurveyAreaIdentifier == k) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(modis)) %>% + terra::vect() + + # Crop MODIS data file to site k's buffer. + modis_clip <- terra::crop(modis, tmp) + + # Use landscapemetrics::calculate_lsm() to calculate the proportion + # of each land cover type present in the cropped raster ("pland"). + modis_pland <- landscapemetrics::calculate_lsm( + modis_clip, + metric = "pland" + ) + + # Loop through each land cover type present in the cropped raster + # and append proportion at site k in the appropriate year to input + # data. Create parseable column names using names for each + # class listed above. + for (l in modis_pland$class) { + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + modis_match$survey_year[modis_match$filename == j], + paste0( + index, + "_", + modis_classes[[i]]$name[modis_classes[[i]]$class == l] + ) + ] <- modis_pland$value[modis_pland$class == l] + } + + # Check whether any land cover classes were never in the cropped + # raster. These are true zeros, but would be left out otherwise. + # Add these columns in with 0 values. + missing_cols <- paste0(index, "_", modis_classes[[i]]$name)[ + !(paste0(index, "_", modis_classes[[i]]$name) %in% names(data)) + ] + + for (l in missing_cols) { + data[, l] <- 0 + } + + # Replace NAs present in columns for land cover classes that were + # found at some sites but not others with the true zeros they + # represent. + for (l in paste0(index, "_", modis_classes[[i]]$name)) { + data[ + is.na(data[, l] %>% sf::st_drop_geometry()) & + !(data$SurveyAreaIdentifier %in% out_of_range), + l + ] <- 0 + } + + # Reorder columns to match class order provided in MODIS + # documentation. + data <- data[, c( + grep(index, names(data), value = TRUE, invert = TRUE), + paste0(index, "_", modis_classes[[i]]$name) + )] + } else { + # Create temporary object containing only the point for site k. + tmp <- data %>% + dplyr::filter(.data$SurveyAreaIdentifier == k) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(modis)) + + # Extract point value from MODIS raster. It appears to be possible + # that a point falls such that it extracts from two raster tiles, + # so handle that possibility below. + extr_table <- terra::extract(modis, tmp, fun = unique)[, + 2 + ] + + # Whether only a single value was extracted (class == "integer") or + # multiple values (else) prepare to pass to input data. + if (length(extr_table) == 1) { + extr_table <- extr_table %>% + as.data.frame() + + names(extr_table) <- "class" + + extr_table <- dplyr::left_join( + extr_table, + modis_classes[[i]], + by = "class" + ) + } else { + extr_table <- extr_table %>% + as.data.frame() + + names(extr_table) <- "class" + + extr_table <- dplyr::left_join( + extr_table, + modis_classes[[i]], + by = "class" + ) + } + + # Join extracted value to input data. If multiple values were + # extracted, join the first value in extr_table and warn the user + # about potential values so they can adjust manually. + tryCatch( + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + modis_match$survey_year[modis_match$filename == j], + paste0(index, "_Class") + ] <- modis_classes[[i]]$name[ + modis_classes[[i]]$class == + terra::extract(modis, tmp, fun = unique)[, 2] + ], + warning = function(w) { + if ( + conditionMessage(w) == + paste0( + "longer object length is not a multiple of shorter", + "object length" + ) + ) { + warning( + paste0( + "[MODIS Landcover Extraction] MODIS ", + index, + ": Site ", + k, + " in year(s) ", + stringr::str_flatten_comma(sort(unique(modis_match$survey_year[ + modis_match$filename == j + ]))), + " touches multiple cells. Extraction returned `", + suppressWarnings(modis_classes[[i]]$name[ + modis_classes[[i]]$class == + terra::extract(modis, tmp, fun = unique)[, 2] + ]), + "` but possible values were `", + stringr::str_flatten(extr_table$name, collapse = "`, `"), + "`. Please examine to choose desired output and replace if", + " necessary." + ), + call. = FALSE + ) + } else { + warning(conditionMessage(w)) + } + } + ) + } + } + } + + # Remove false zeroes for any sites that fall outside of data coverage. + if (buffered == TRUE) { + for (j in paste0(index, "_", modis_classes[[i]]$name)) { + data[data$SurveyAreaIdentifier %in% out_of_range, j] <- NA + } + } + } + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + if (!is.null(date_year)) { + names(data)[names(data) == "survey_year"] <- date_year + } + + # If requested, remove MODIS data files. + if (retain == FALSE) { + message(paste0( + "[MODIS Landcover Extraction] extraction complete. Removing files." + )) + + file.remove(modis_files$filename) + } + + # Return input data with appended land cover columns. + return(data) +} diff --git a/R/metadata_functions.R b/R/metadata_functions.R index eae69073..cffd0293 100644 --- a/R/metadata_functions.R +++ b/R/metadata_functions.R @@ -167,3 +167,136 @@ meta_bmde_fields <- function(version = "minimum") { } f } + +#' Metadata for data sources for the covariate download and extraction functions. +#' +#' @returns `data.frame` containing information on the resolution and source for +#' the covariate data available through `naturecounts`. + +nc_covariate_table <- function() { + cov.table <- data.frame( + covariate_name = c( + "modis_lctype1", + "modis_lctype2", + "modis_lctype3", + "modis_lctype4", + "modis_lctype5", + "modis_snow", + "modis_ndvi", + "modis_evi", + "elevation", + "worldclim_tavg", + "worldclim_tmax", + "worldclim_tmin", + "worldclim_prec", + "worldclim_srad", + "worldclim_wind", + "scanfi_age", + "scanfi_biomass", + "scanfi_closure", + "scanfi_height", + "scanfi_nfilc", + "scanfi_balsamfir", + "scanfi_blackspruce", + "scanfi_douglasfir", + "scanfi_jackpine", + "scanfi_lodgepolepine", + "scanfi_ponderosapine", + "scanfi_tamarack", + "scanfi_whiteredpine", + "scanfi_broadleaf", + "scanfi_otherconifer", + "daymet_dayl", + "daymet_prcp", + "dayment_srad", + "daymet_swe", + "daymet_tmax", + "daymet_tmin", + "daymet_vp" + ), + covariate_source = c( + "MODIS Land Cover - IGBP global vegetation classification scheme", + "MODIS Land Cover - University of Maryland (UMD) scheme", + "MODIS Land Cover - MODIS-derived LAI/fPAR scheme", + "MODIS Land Cover - MODIS-derived Net Primary Production scheme", + "MODIS Land Cover - Plant Functional Type (PFT) scheme", + "MODIS Snow Cover", + "MODIS Vegetation Indices - Normalized Difference Vegetation Index", + "MODIS Vegetation Indices - Enhanced Vegetation Index", + "AWS Terrain Tiles Elevation (m)", + "WorldClim - Monthly Average Temperature (degC), 1970-2000", + "WorldClim - Monthly Maximum Temperature (degC), 1970-2000", + "WorldClim - Monthly Minimum Temperature (degC), 1970-2000", + "WorldClim - Monthly Precipitation (mm), 1970-2000", + "WorldClim - Monthly Solar Radiation (kJ/m^2/day), 1970-2000", + "WorldClim - Monthly Average Wind Speed (m/s), 1970-2000", + "SCANFI - Age (years)", + "SCANFI - Biomass (tons/ha)", + "SCANFI - Crown closure (% covered by tree canopy)", + "SCANFI - Height (m)", + "SCANFI - NFI land cover class", + "SCANFI - Balsam Fir cover proportion of pixel", + "SCANFI - Black Spruce cover proportion of pixel", + "SCANFI - Douglas Fir cover proportion of pixel", + "SCANFI - Jack Pine cover proportion of pixel", + "SCANFI - Lodgepole Pine cover proportion of pixel", + "SCANFI - Ponderosa Pine cover proportion of pixel", + "SCANFI - Tamarack cover proportion of pixel", + "SCANFI - White and Red Pine cover proportion of pixel", + "SCANFI - Broadleaf tree species cover proportion of pixel", + "SCANFI - Other Conifer Species cover proportion of pixel", + "Daymet - Daylength (s/day)", + "Daymet - Precipitation (mm/day)", + "Daymet - Shortwave radiation (W/m^2)", + "Daymet - Snow water equivalent (kg/m^2)", + "Daymet - Maximum air temperature (degrees C)", + "Daymet - Minimum air temperature (degrees C)", + "Daymet - Water vapor pressure (Pa)" + ), + covariate_source_specific = c( + rep("MCD12Q1", times = 5), + "MOD10A1", + rep("MOD13A1", times = 2), + NA, + rep("WorldClim Ver. 2.1", times = 6), + rep("SCANFI Ver. 1.2", times = 15), + rep("DAYMET Ver. 004", times = 7) + ), + temporal_resolution = c( + rep("Annual", times = 5), + "Daily", + rep("16-Day", times = 2), + rep("Static", times = 7), + rep("5-year snapshot", times = 15), + rep("Daily", times = 7) + ), + spatial_resolution = c( + rep("500 m", times = 8), + "Variable", + rep("~1 km^2", times = 6), + rep("30 m", times = 15), + rep("1 km", times = 7) + ), + via = c( + rep("luna", times = 8), + "elevatr", + rep("geodata", times = 6), + rep("Direct Download", times = 15), + rep("appeears", times = 7) + ), + documentation = c( + rep("https://doi.org/10.5067/MODIS/MCD12Q1.061", times = 5), + "http://doi.org/10.5067/MODIS/MOD10A1.061", + rep("https://doi.org/10.5067/MODIS/MOD13A1.061", times = 2), + "https://github.com/USEPA/elevatr", + rep("https://worldclim.org/data/worldclim21.html", times = 6), + rep( + "https://open.canada.ca/data/en/dataset/07653869-f303-46c2-a04e-9ab479b73cbf", + times = 15 + ), + rep("https://doi.org/10.3334/ORNLDAAC/1840", times = 7) + ) + ) + + return(cov.table) +} diff --git a/R/nc_covariates_merge.R b/R/nc_covariates_merge.R new file mode 100644 index 00000000..208f0b63 --- /dev/null +++ b/R/nc_covariates_merge.R @@ -0,0 +1,639 @@ +#' Merge Extracted Covariate Data into Original Input Data +#' +#' Data formatted for covariate extraction using [data_fmt()] is transformed +#' to an `sf` object containing a row for each unique site-date combination, +#' with columns being appended to this by the various covariate extraction +#' functions within [naturecounts]. Users may wish, instead, to have their +#' covariate data appended to original data in a different format (e.g., a +#' row for each observation) and can use this function to merge the two data +#' types accurately. +#' +#' @param original_data `data.frame`, `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons'. Object containing data to match covariate data to. For +#' example, the original input data to a call to [data_fmt()]. +#' @param covariate_data `sf` 'POINT' or 'POLYGON' object. Object containing data +#' output by one of the covariate extraction functions within [naturecounts]: +#' [landcover_extract()], [vegetation_extract()], [elevation_extract()], +#' [worldclim_extract()], [scanfi_extract()], or [daymet_extract]. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. +#' @param coord_lon Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `longitude`. +#' @param coord_lat Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `latitude`. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day of month data if not contained within the BMDE column +#' `survey_day`. +#' @param date_lubridate Character. Optional argument to provide the name of a +#' column containing date data in `lubridate` formats. +#' @param date_ordinal Character. Optional argument to provide the name of a +#' column containing date data in ordinal format. +#' +#' @returns Data provided in `original_data` with covariate data columns from +#' `covariate_data` appended. +#' +#' @examplesIf interactive() +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Format +#' formatted <- data_fmt(bcch) +#' +#' # Download and extract some covariate data. +#' elev <- elevation_download(data = formatted, +#' progress = FALSE) +#' +#' extracted <- elevation_extract(data = formatted, +#' elevation_data = elev) +#' +#' # Merge with original data +#' merged <- nc_covariates_merge(original_data = bcch, +#' covariate_data = extracted) +#' +#' merged +#' +#' @export + +# Function to merge outputs of extraction functions to original data. +nc_covariates_merge <- function( + original_data, # Data input to data_fmt() or an extraction function. + covariate_data, # Output of an extraction function. + coord_lon = NULL, # as in cosewic_ranges + coord_lat = NULL, # as in cosewic_ranges + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_lubridate = NULL, # optional argument to provide column name containing + # 'lubridate' date objects. + date_ordinal = NULL # optional argument to provide column name containing + # ordinal dates. +) { + # Check packages. + have_pkg_check(c( + "sf", + "terra", + "tidyterra" + )) + + # Fetch format of original data. + input_fmt <- covariate_fmt_check(original_data) + + # Store relevant information depending on original data format. + if (input_fmt$type == "data.frame") { + original_fmt <- "data.frame" + } + + if (input_fmt$type == "sf") { + original_fmt <- "sf" + + original_cols <- names(original_data) + + original_geom <- input_fmt$geometry + + original_crs <- sf::st_crs(original_data) + } + + if (input_fmt$type == "terra") { + original_fmt <- "terra" + + original_cols <- names(original_data) + + original_geom <- input_fmt$geometry + + original_crs <- terra::crs(original_data) + } + + # Fetch format of covariate data. + output_fmt <- covariate_fmt_check(covariate_data) + + # Covariate data should be the output of an extraction function, which is + # expected to be an sf object. If not, return error. + if (!(output_fmt$type == "sf")) { + stop( + "[Data Merging] Provided covariate data not in expected format.", + " 'sf' object expected as output by NatureCounts covariate extraction", + " functions.", + call. = FALSE + ) + } + + # Check whether sf object is buffered or not to determine joining + # procedure down the line. + if (output_fmt$type == "sf") { + buffer <- ifelse(output_fmt$geometry == "POLYGON", TRUE, FALSE) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(coord_lon) & !is.null(attr(covariate_data, "coord_lon"))) { + coord_lon <- attr(covariate_data, "coord_lon") + } + + if (is.null(coord_lat) & !is.null(attr(covariate_data, "coord_lat"))) { + coord_lat <- attr(covariate_data, "coord_lat") + } + + if (is.null(site_name) & !is.null(attr(covariate_data, "site_name"))) { + site_name <- attr(covariate_data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(covariate_data, "date_year"))) { + date_year <- attr(covariate_data, "date_year") + } + + if (is.null(date_month) & !is.null(attr(covariate_data, "date_month"))) { + date_month <- attr(covariate_data, "date_month") + } + + if (is.null(date_day) & !is.null(attr(covariate_data, "date_day"))) { + date_day <- attr(covariate_data, "date_day") + } + + if (is.null(date_ordinal) & !is.null(attr(covariate_data, "date_ordinal"))) { + date_ordinal <- attr(covariate_data, "date_ordinal") + } + + if ( + is.null(date_lubridate) & !is.null(attr(covariate_data, "date_lubridate")) + ) { + date_lubridate <- attr(covariate_data, "date_lubridate") + } + + # Joining procedure for original data in data frame objects. + if (original_fmt == "data.frame") { + # Remove SurveyAreaIdentifier column as this is a less reliable joiner + # than coordinate data. + covariate_data[, ifelse( + is.null(site_name), + "SurveyAreaIdentifier", + site_name + )] <- NULL + + # Convert covariate data to data frame. + covariate_data <- sf::st_drop_geometry(covariate_data) + + # If lubridate or ordinal date data is present, use to join. If not, use + # individual date columns. If both lubridate and ordinal date data is + # present, use lubridate data to join. + if (is.null(date_ordinal) & is.null(date_lubridate)) { + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + ifelse(is.null(date_month), "survey_month", date_month), + ifelse(is.null(date_day), "survey_day", date_day) + ) + ) + } else { + if (!is.null(date_ordinal)) { + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } else { + covariate_data <- dplyr::select( + covariate_data, + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + date_ordinal + ) + ) + } + } + + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } + } + } + + # Joining procedure for original data in sf objects. + if (original_fmt == "sf") { + # Remove SurveyAreaIdentifier column as this is a less reliable joiner + # than coordinate data. + covariate_data[, ifelse( + is.null(site_name), + "SurveyAreaIdentifier", + site_name + )] <- NULL + + # Convert covariate data to data frame. + covariate_data <- sf::st_drop_geometry(covariate_data) + + # Edge case: there is a column in the original data called X that needs + # to be preserved. + if ("X" %in% names(original_data)) { + x_storage <- original_data$X + + original_data$X <- NULL + } + + # Edge case: there is a column in the original data called Y that needs + # to be preserved. + if ("Y" %in% names(original_data)) { + y_storage <- original_data$Y + + original_data$Y <- NULL + } + + # Edge case: there is a column in the original data called longitude that + # needs to be preserved. + if ("longitude" %in% names(original_data)) { + lon_storage <- original_data$longitude + + original_data$longitude <- NULL + } + + # Edge case: there is a column in the original data called latitude that + # needs to be preserved. + if ("latitude" %in% names(original_data)) { + lat_storage <- original_data$latitude + + original_data$latitude <- NULL + } + + # Create coordinate columns to join with. For polygon original data, use + # centroids. + if (original_geom == "POLYGON") { + original_data <- cbind( + original_data, + sf::st_coordinates(suppressWarnings(sf::st_centroid(original_data))) + ) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } else { + original_data <- cbind( + original_data, + sf::st_coordinates(original_data) + ) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") + } + + # Restore X and Y columns if they needed to be preserved. + if (exists("x_storage")) { + original_data$X <- x_storage + + rm(x_storage) + } + + if (exists("y_storage")) { + original_data$Y <- y_storage + + rm(y_storage) + } + + if (!is.null(coord_lon)) { + names(original_data)[names(original_data) == "longitude"] <- coord_lon + } + + if (!is.null(coord_lat)) { + names(original_data)[names(original_data) == "latitude"] <- coord_lat + } + + # If lubridate or ordinal date data is present, use to join. If not, use + # individual date columns. If both lubridate and ordinal date data is + # present, use lubridate data to join. + if (is.null(date_ordinal) & is.null(date_lubridate)) { + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + ifelse(is.null(date_month), "survey_month", date_month), + ifelse(is.null(date_day), "survey_day", date_day) + ) + ) + } else { + if (!is.null(date_ordinal)) { + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } else { + covariate_data <- dplyr::select( + covariate_data, + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + date_ordinal + ) + ) + } + } + + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- dplyr::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } + } + + # Remove coordinate columns used for joining. + matched_data[, ifelse(is.null(coord_lon), "longitude", coord_lon)] <- NULL + matched_data[, ifelse(is.null(coord_lat), "latitude", coord_lat)] <- NULL + + # Restore latitude/longitude columns if they needed to be preserved. + if (exists("lon_storage")) { + matched_data$longitude <- lon_storage + + rm(lon_storage) + } + + if (exists("lat_storage")) { + matched_data$latitude <- lat_storage + + rm(lat_storage) + } + + # Reorder columns to match original data. + matched_data <- matched_data[, c( + original_cols[!(original_cols == "geometry")], + names(matched_data)[!(names(matched_data) %in% original_cols)], + "geometry" + )] + } + + # Joining procedure for original data in data frame objects. + if (original_fmt == "terra") { + # Remove SurveyAreaIdentifier column as this is a less reliable joiner + # than coordinate data. + covariate_data[, ifelse( + is.null(site_name), + "SurveyAreaIdentifier", + site_name + )] <- NULL + + # Convert covariate data to data frame. + covariate_data <- sf::st_drop_geometry(covariate_data) + + # Edge case: there is a column in the original data called x that needs + # to be preserved. + if ("x" %in% names(original_data)) { + x_storage <- original_data$x + + original_data$x <- NULL + } + + # Edge case: there is a column in the original data called y that needs + # to be preserved. + if ("y" %in% names(original_data)) { + y_storage <- original_data$y + + original_data$y <- NULL + } + + # Edge case: there is a column in the original data called longitude that + # needs to be preserved. + if ("longitude" %in% names(original_data)) { + lon_storage <- original_data$longitude + + original_data$longitude <- NULL + } + + # Edge case: there is a column in the original data called latitude that + # needs to be preserved. + if ("latitude" %in% names(original_data)) { + lat_storage <- original_data$latitude + + original_data$latitude <- NULL + } + + # Create coordinate columns to join with. For polygon original data, use + # centroids. + if (input_fmt$geometry == "polygons") { + original_data <- cbind( + original_data, + terra::crds(terra::centroids(original_data)) + ) %>% + tidyterra::rename("longitude" = "x", "latitude" = "y") + } else { + original_data <- cbind(original_data, terra::crds(original_data)) %>% + tidyterra::rename("longitude" = "x", "latitude" = "y") + } + + # Restore X and Y columns if they needed to be preserved. + if (exists("x_storage")) { + original_data$x <- x_storage + + rm(x_storage) + } + + if (exists("y_storage")) { + original_data$y <- y_storage + + rm(y_storage) + } + + if (!is.null(coord_lon)) { + names(original_data)[names(original_data) == "longitude"] <- coord_lon + } + + if (!is.null(coord_lat)) { + names(original_data)[names(original_data) == "latitude"] <- coord_lat + } + + # If lubridate or ordinal date data is present, use to join. If not, use + # individual date columns. If both lubridate and ordinal date data is + # present, use lubridate data to join. + if (is.null(date_ordinal) & is.null(date_lubridate)) { + matched_data <- tidyterra::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + ifelse(is.null(date_month), "survey_month", date_month), + ifelse(is.null(date_day), "survey_day", date_day) + ) + ) + } else { + if (!is.null(date_ordinal)) { + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- tidyterra::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } else { + covariate_data <- dplyr::select( + covariate_data, + -"survey_month", + -"survey_day" + ) + + matched_data <- tidyterra::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + ifelse(is.null(date_year), "survey_year", date_year), + date_ordinal + ) + ) + } + } + + if (!is.null(date_lubridate)) { + covariate_data <- dplyr::select( + covariate_data, + -"survey_year", + -"survey_month", + -"survey_day" + ) + + matched_data <- tidyterra::left_join( + original_data, + covariate_data, + by = c( + ifelse(is.null(coord_lon), "longitude", coord_lon), + ifelse(is.null(coord_lat), "latitude", coord_lat), + date_lubridate + ) + ) + } + } + + # Remove coordinate columns used for joining. + matched_data[, ifelse(is.null(coord_lon), "longitude", coord_lon)] <- NULL + matched_data[, ifelse(is.null(coord_lat), "latitude", coord_lat)] <- NULL + + # Restore latitude/longitude columns if they needed to be preserved. + if (exists("lon_storage")) { + matched_data$longitude <- lon_storage + + rm(lon_storage) + } + + if (exists("lat_storage")) { + matched_data$latitude <- lat_storage + + rm(lat_storage) + } + + # Reorder columns to match original data. + matched_data <- matched_data[, c( + original_cols, + names(matched_data)[!(names(matched_data) %in% original_cols)] + )] + } + + # Remove lingering attribute. + if (!is.null(attr(matched_data, "site_name"))) { + attr(matched_data, "site_name") <- NULL + } + + # Return original data with appended covariate columns. + return(matched_data) +} diff --git a/R/scanfi_download.R b/R/scanfi_download.R new file mode 100644 index 00000000..17884bc9 --- /dev/null +++ b/R/scanfi_download.R @@ -0,0 +1,475 @@ +#' Download and Load Data from the Spatialized Canadian National Forest Inventory (SCANFI) +#' +#' Downloads and loads into the environment all available variables from the +#' [SCANFI v2 dataset](https://open.canada.ca/data/en/dataset/07653869-f303-46c2-a04e-9ab479b73cbf). +#' All variables are available in snapshots every 5 years between 1985 and 2025 at +#' a 30 m resolution. Users should be aware that these are very large files (usually +#' 1-5 Gb per snapshot per variable). +#' +#' One (or multiple) SCANFI variable(s) can be downloaded by specifying the following +#' values to the `covariates` argument: +#' - Forest age (years): `scanfi_age` +#' - Forest biomass (tons/ha): `scanfi_biomass` +#' - Crown closure (% of pixel covered by tree canopy): `scanfi_closure` +#' - Forest height (m): `scanfi_height` +#' - National Forest Inventory land cover (NFILC) class: `scanfi_nfilc` +#' - Balsam Fir cover (% of pixel): `scanfi_balsamfir` +#' - Black Spruce cover (% of pixel): `scanfi_blackspruce` +#' - Douglas Fir cover (% of pixel): `scanfi_douglasfir` +#' - Jack Pine cover (% of pixel): `scanfi_jackpine` +#' - Lodgepole Pine cover (% of pixel): `scanfi_lodgepolepine` +#' - Ponderosa Pine cover (% of pixel): `scanfi_ponderosapine` +#' - Tamarack cover (% of pixel): `scanfi_tamarack` +#' - White and Red Pine cover (% of pixel): `scanfi_whiteredpine` +#' - Broadleaf tree species cover (% of pixel): `scanfi_broadleaf` +#' - Other conifer species cover (% of pixel): `scanfi_otherconifer` +#' +#' Downloads are facilitated by a call to [utils::download.file()]. +#' +#' @param data A `data.frame`, `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons' object containing a column with observation years either named +#' the BMDE default `survey_year` or another name specified in argument `date_year`. +#' Not required if `use_date = FALSE`, but must be specified if `use_date = TRUE`. +#' @param covariates Character, vector if multiple SCANFI data types desired. By +#' default, downloads SCANFI forest height data. +#' @param use_date Logical. Should the function use year data provided in `data` +#' to choose which snapshot to download? If `FALSE`, `snapshot_year` can be used +#' to specify which snapshot(s) should be downloaded and used. +#' @param snapshot_year Numeric, vector if multiple snapshots desired. Snapshot +#' years to download. Options include: 1985, 1990, 1995, 2000, 2005, 2010, 2015, +#' 2020, and 2025. If specified, takes precedent over dates from `data` when +#' `use_date = TRUE`. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param timeout Numeric. Number of seconds before downloads timeout. This should +#' be in the 10s of thousands of seconds, depending on internet download speed. +#' Default value assumes largest SCANFI file is being requested, with download +#' speeds of 0.2 Mb/s. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `scanfi/` in the working +#' directory. +#' @param progress Logical. Should progress bars be displayed? +#' +#' @returns A named list containing `terra SpatRaster`s of all requested data. +#' Each list element represents the SCANFI snapshot year of the data, +#' with a named `terra SpatRaster` for each requested variable. +#' +#' @examples +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Download SCANFI data - uses the dates in the data to determine which +#' # snapshot years to download. +#' output <- scanfi_download(data = bcch, +#' covariates = "scanfi_ponderosapine", +#' progress = FALSE) +#' +#' # We can also manually specify the snapshot years to download with no input +#' # data required like this: +#' output <- scanfi_download(covariates = "scanfi_ponderosapine", +#' use_date = FALSE, +#' snapshot_year = c(2015, 2020), +#' progress = FALSE) +#' +#' +#' @seealso [scanfi_extract()] which can be used to extract data from loaded +#' SCANFI data files. +#' +#' +#' @references Guindon L., Correia D.L.P, Manka F. and Smiley B. 2026. SCANFI v2: Spatialized CAnadian National Forest Inventory data product v2. Natural Resources Canada, Canadian Forest Service, Laurentian Forestry Centre, Quebec, Canada. . +#' +#' @export +# Function to download data from the Spatialized Canadian National Forest +# Inventory using download.file(). + +scanfi_download <- function( + data = NULL, # Only necessary if use_date = TRUE - needed to fetch year data. + covariates = "scanfi_height", # Other options + # listed in nc_covariate_table(). + use_date = TRUE, # Should the most recent snapshot be downloaded (FALSE), or + # should all relevant snapshots be downloaded for extraction (TRUE). Can + # result in multiple large downloads. + snapshot_year = NULL, # If use_date = FALSE, the desired snapshot year to be + # used. If not specified, the most recent (2025) is used. + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + timeout = 32000, + dl_path = NULL, # optional argument to provide path + # to download data to. By default, data is + # downloaded to a subfolder 'scanfi/' in the + # working directory. + progress = TRUE +) { + # Check packages + have_pkg_check("terra") + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[SCANFI Download] covariates either not listed or one or more are", + " invalid. Please provide covariate names as listed under", + " `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + if (!missing(data)) { + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + } + + # Use user specified snapshot years over automatically selected years + if (!is.null(snapshot_year) & use_date == TRUE) { + use_date <- FALSE + + warning( + "[SCANFI Download] Specific snapshot years requested but use_date", + " set as TRUE, suggesting function should determine necessary", + " snapshots to download from years in data argument. Overriding", + " and proceeding to download snapshots requested in snapshot_year.", + call. = FALSE + ) + } + + if (use_date == TRUE) { + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(date_year) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + !("survey_year" %in% data_cols) + ) { + stop( + "[SCANFI Download] some specified columns missing from the", + " data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that", + " diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + # Get necessary years for download from data. + + available_years <- seq(from = 1985, to = 2025, by = 5) + + closest_year <- data.frame(data_year = sort(unique(data$survey_year))) + + outside_years <- c( + closest_year$data_year[closest_year$data_year < 1980], + closest_year$data_year[closest_year$data_year > 2030] + ) + + if (length(outside_years) > 0) { + warning( + "[SCANFI Download] Data contains years more than 5 years away", + " from nearest SCANFI snapshot (", + stringr::str_flatten_comma(outside_years), + "). No value will be returned for observations in these years.", + call. = FALSE + ) + } + + closest_year <- dplyr::filter( + closest_year, + !(.data$data_year %in% outside_years) + ) + + for (i in closest_year$data_year) { + closest_year$scanfi_year[ + closest_year$data_year == i + ] <- available_years[which( + abs(i - available_years) == min(abs(i - available_years)) + )] + } + + necessary_years <- unique(closest_year$scanfi_year) + } else { + necessary_years <- `if`(is.null(snapshot_year), 2025, snapshot_year) + + if (!all(necessary_years %in% seq(from = 1985, to = 2025, by = 5))) { + stop( + "[SCANFI Download] Invalid snapshot year(s) provided to", + " snapshot_year argument: ", + necessary_years[ + (necessary_years %in% seq(from = 1985, to = 2025, by = 5)) == FALSE + ], + ". Valid snapshot years are ", + stringr::str_flatten_comma(seq(from = 1985, to = 2025, by = 5)), + "." + ) + } + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./scanfi")) { + dir.create("./scanfi", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/scanfi"))) { + dir.create(paste0(dl_path, "/scanfi"), recursive = TRUE) + } + + # Create index for SCANFI variables from requested covariates. + scanfi_vars <- gsub( + pattern = "scanfi_", + replacement = "", + grep("scanfi_", covariates, value = TRUE) + ) + + # Create table of download links for each SCANFI variable. + filename <- list() + + for (i in as.character(necessary_years)) { + filename[[i]] <- data.frame(variable = scanfi_vars) %>% + dplyr::mutate( + filename = dplyr::case_when( + variable == "age" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_age_median_", + i, + "_v2_20260119.tif" + ), + variable == "biomass" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_att_biomass_", + i, + "_v2_20260119.tif" + ), + variable == "closure" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_att_closure_", + i, + "_v2_20260119.tif" + ), + variable == "height" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_att_height_", + i, + "_v2_20260119.tif" + ), + variable == "nfilc" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_att_nfiLandcover_", + i, + "_v2_20260119.tif" + ), + variable == "balsamfir" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_balsamFir_", + i, + "_v2_20260119.tif" + ), + variable == "blackspruce" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_blackSpruce_", + i, + "_v2_20260119.tif" + ), + variable == "douglasfir" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_douglasFir_", + i, + "_v2_20260119.tif" + ), + variable == "jackpine" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_jackPine_", + i, + "_v2_20260119.tif" + ), + variable == "lodgepolepine" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_lodgepolePine_", + i, + "_v2_20260119.tif" + ), + variable == "ponderosapine" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_ponderosaPine_", + i, + "_v2_20260119.tif" + ), + variable == "tamarack" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_tamarack_", + i, + "_v2_20260119.tif" + ), + variable == "whiteredpine" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_whiteRedPine_", + i, + "_v2_20260119.tif" + ), + variable == "broadleaf" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_broadleaf_", + i, + "_v2_20260119.tif" + ), + variable == "otherconifer" ~ paste0( + "https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/SCANFI_spsCC_otherConiferous_", + i, + "_v2_20260119.tif" + ) + ) + ) + } + + # Open list to store SCANFI rasters. + scanfi <- list() + + # Store user default timeout option + user_timeout <- getOption("timeout") + + # Set timeout as specified in arguments. + options("timeout" = timeout) + + # Loop through each requested SCANFI variable and download. + for (i in scanfi_vars) { + ### WILL NEED TO CHECK IF DATA IS IN ARCTIC RANGE AND WARN ABOUT NFI LAND + ### COVER MODELING PROCESS. + + for (j in as.character(necessary_years)) { + # If file doesn't already exist, download requested variable. + if ( + !file.exists(ifelse( + is.null(dl_path), + paste0( + "./scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ), + paste0( + dl_path, + "/scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ) + )) + ) { + message( + "[SCANFI Download] downloading SCANFI ", + i, + ". Files are large and may require a fair bit of download and processing time." + ) + + ### USING METHODS OTHER THAN CURL SEEMS TO CAUSE ISSUES WITH DOWNLOADED FILE - NEED TO CONSIDER CURL COMPATIBILITY WITH OTHER OS'S. + + # tryCatch needed to handle curl issues and redirect users to downloading + # manually and reading using scanfi_read(). + tryCatch( + utils::download.file( + url = filename[[j]]$filename[filename[[j]]$variable == i], + destfile = ifelse( + is.null(dl_path), + paste0( + "./scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ), + paste0( + dl_path, + "/scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ) + ), + mode = "wb", + quiet = !progress + ), + error = function(e) { + if (conditionMessage(e) == "'curl' call had nonzero exit status") { + stop( + "[SCANFI Download] 'curl' call had nonzero exist status. Please download files directly from https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v1/ and read in using scanfi_read().", + call. = FALSE + ) + } else { + stop(conditionMessage(e), call. = FALSE) + } + } + ) + + # Read in downloaded variable and store in list. + scanfi[[j]][[i]] <- terra::rast(ifelse( + is.null(dl_path), + paste0( + "./scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ), + paste0( + dl_path, + "/scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ) + )) + } else { + scanfi[[j]][[i]] <- terra::rast(ifelse( + is.null(dl_path), + paste0( + "./scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ), + paste0( + dl_path, + "/scanfi/", + dplyr::last(unlist(stringr::str_split( + filename[[j]]$filename[filename[[j]]$variable == i], + "/" + ))) + ) + )) + } + } + } + + # Reset user default timeout option. + options("timeout" = user_timeout) + + # Return list of scanfi rasters. + return(scanfi) +} diff --git a/R/scanfi_extract.R b/R/scanfi_extract.R new file mode 100644 index 00000000..e9851b71 --- /dev/null +++ b/R/scanfi_extract.R @@ -0,0 +1,796 @@ +#' Extract Data from the Spatialized Canadian National Forest Inventory (SCANFI) +#' +#' Extracts all available variables from the +#' [SCANFI v2 dataset](https://open.canada.ca/data/en/dataset/07653869-f303-46c2-a04e-9ab479b73cbf). +#' All variables are available in snapshots every 5 years between 1985 and 2025 at +#' a 30 m resolution. Necessary files can be downloaded and loaded with [scanfi_download()]. +#' +#' One (or multiple) SCANFI variable(s) can be extracted by specifying the following +#' values to the `covariates` argument: +#' - Forest age (years): `scanfi_age` +#' - Forest biomass (tons/ha): `scanfi_biomass` +#' - Crown closure (% of pixel covered by tree canopy): `scanfi_closure` +#' - Forest height (m): `scanfi_height` +#' - National Forest Inventory land cover (NFILC) class: `scanfi_nfilc` +#' - Balsam Fir cover (% of pixel): `scanfi_balsamfir` +#' - Black Spruce cover (% of pixel): `scanfi_blackspruce` +#' - Douglas Fir cover (% of pixel): `scanfi_douglasfir` +#' - Jack Pine cover (% of pixel): `scanfi_jackpine` +#' - Lodgepole Pine cover (% of pixel): `scanfi_lodgepolepine` +#' - Ponderosa Pine cover (% of pixel): `scanfi_ponderosapine` +#' - Tamarack cover (% of pixel): `scanfi_tamarack` +#' - White and Red Pine cover (% of pixel): `scanfi_whiteredpine` +#' - Broadleaf tree species cover (% of pixel): `scanfi_broadleaf` +#' - Other conifer species cover (% of pixel): `scanfi_otherconifer` +#' +#' @param data A sf` 'POINT' or 'POLYGON' object, or `terra` 'points' +#' or 'polygons' object containing a column with observation years either named +#' the BMDE default `survey_year` or another name specified in argument `date_year`. +#' @param scanfi_data Named `list` of `terra SpatRaster`s. First index names should +#' be the snapshot years contained data is from, and second index names should be +#' variable names as in [nc_covariate_table()], with the "scanfi_" removed. +#' We recommend using [scanfi_download()] to ensure that all data necessary to +#' match your input data are captured and that list formatting is correct. +#' Direct output of [scanfi_download()] can be supplied here. +#' @param covariates Character, vector if multiple SCANFI data types desired. By +#' default, downloads SCANFI forest height data. +#' @param interpolate Logical. Should years in between snapshots be assigned the +#' nearest snapshot's value? +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `scanfi/` in the working +#' directory. +#' @param retain Logical. Should SCANFI data files be kept after extraction? If +#' `FALSE`, files will be deleted. +#' +#' @returns For sf 'POINT' or terra 'points' input data, original data with +#' column(s) appended containing the SCANFI data value(s) at each point. +#' +#' For sf 'POLYGON' or terra 'polygons' input data, original data with column(s) +#' appended containing the mean SCANFI data value(s) within each polygon or, +#' if NFI Landcover requested, the proportion the polygon area covered by of +#' each land cover class. +#' +#' @examples +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Download SCANFI data - uses the dates in the data to determine which +#' # snapshot years to download. +#' scanfi <- scanfi_download(data = bcch, +#' covariates = "scanfi_ponderosapine", +#' progress = FALSE) +#' +#' # Create sf object to use in extraction. +#' bcch <- data_fmt(bcch) +#' +#' # Extract first only for the snapshot years. +#' output <- scanfi_extract(data = bcch, +#' scanfi_data = scanfi) +#' +#' # Extract with interpolation for interceding years. +#' output <- scanfi_extract(data = bcch, +#' scanfi_data = scanfi, +#' interpolate = TRUE) +#' +#' @seealso [scanfi_download()] which can be used to download data from SCANFI +#' data files and load them into the environment. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @references Guindon L., Correia D.L.P, Manka F. and Smiley B. 2026. SCANFI v2: Spatialized CAnadian National Forest Inventory data product v2. Natural Resources Canada, Canadian Forest Service, Laurentian Forestry Centre, Quebec, Canada. . +#' +#' @export + +scanfi_extract <- function( + data, + scanfi_data, # named list containing SpatRaster containing + # SCANFI data, downloadable via scanfi_download(). Names derived from + # SCANFI variables ("height", "biomass", etc.) + covariates = "scanfi_height", # Other options listed in nc_covariate_table(). + interpolate = FALSE, # should years between snapshots be filled with values + # from nearest snapshot. + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + dl_path = NULL, # Path to downloaded files. Only needed if retain = TRUE and + # custom dl_path is used. + retain = TRUE # Should data files be kept after extraction? +) { + # Check packages + have_pkg_check(c( + "sf", + "terra" + )) + + # If no SCANFI rasters are provided, return error. + if (missing(scanfi_data)) { + stop( + "[SCANFI Extraction] no SCANFI rasters provided to extract from. Please", + " provide a list containing one entry for every snapshot year, each", + " containing one raster for each listed SCANFI covariate.", + " Data can be downloaded using scanfi_download().", + call. = FALSE + ) + } + + if ( + !((inherits(scanfi_data, "list")) & + (inherits(scanfi_data[[1]], "list")) & + (inherits(scanfi_data[[1]][[1]], "SpatRaster"))) + ) { + stop( + "[SCANFI Extraction] no SCANFI rasters provided to extract from. Please", + " provide a list containing one entry for every snapshot year, each", + " containing one raster for each listed SCANFI covariate.", + " Data can be downloaded using scanfi_download().", + call. = FALSE + ) + } + + # Grab covariate names from scanfi_data object if not explicitly specified. + if (missing(covariates)) { + yrs <- names(scanfi_data) + layers <- c() + + for (i in yrs) { + layers <- unique(c(layers, names(scanfi_data[[i]]))) + } + + covariates <- paste0("scanfi_", layers) + + warning( + "[SCANFI Extraction] no covariates specified in the covariates", + " argument. Proceeding to extract the covariates found in", + " scanfi_data layers: ", + stringr::str_flatten_comma(covariates), + ".", + call. = FALSE + ) + } + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[SCANFI Extraction] covariates either not listed or one or more are", + " invalid. Please provide covariate names as listed under", + " `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + # If no SCANFI rasters are provided, return error. + if (missing(scanfi_data)) { + stop( + "[SCANFI Extraction] no SCANFI rasters provided to extract from. Please", + " provide a list containing one entry for every snapshot year, each", + " containing one raster for each listed SCANFI covariate.", + " Data can be downloaded using scanfi_download().", + call. = FALSE + ) + } + + if ( + !((inherits(scanfi_data, "list")) & + (inherits(scanfi_data[[1]], "list")) & + (inherits(scanfi_data[[1]][[1]], "SpatRaster"))) + ) { + stop( + "[SCANFI Extraction] no SCANFI rasters provided to extract from. Please", + " provide a list containing one entry for every snapshot year, each", + " containing one raster for each listed SCANFI covariate.", + " Data can be downloaded using scanfi_download().", + call. = FALSE + ) + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[SCANFI Extraction] extraction requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + if (length(attr_names[attr_names %in% names(attributes(data))]) > 0) { + attrs <- attributes(data)[attr_names[ + attr_names %in% names(attributes(data)) + ]] + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols)) + ) { + stop( + "[SCANFI Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + # For sf objects, create area of interest to crop SCANFI rasters to to + # reduce memory load. + if (input_fmt$type == "sf") { + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_transform("ESRI:102001") %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } else { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } + } + + # For terra objects, create area of interest to crop SCANFI rasters to to + # reduce memory load. + if (input_fmt$type == "terra") { + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::project("ESRI:102001") %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } else { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + if (interpolate == FALSE) { + match_years <- as.character(sort(unique(data$survey_year[ + data$survey_year %in% as.numeric(names(scanfi_data)) + ]))) + + if (length(match_years) == 0) { + stop( + "[SCANFI Extraction] Data does not contain observations within the", + " SCANFI snapshot years (", + stringr::str_flatten_comma(sort(as.numeric(names(scanfi_data)))), + ") in scanfi_data.", + " If wanting to match interceding years to snapshots, use interpolate", + " = TRUE.", + call. = FALSE + ) + } + + closest_year <- data.frame( + data_year = sort(unique(data$survey_year[ + data$survey_year %in% as.numeric(names(scanfi_data)) + ])), + scanfi_year = sort(names(scanfi_data)) + ) + + closest_year$scanfi_year <- as.character(closest_year$scanfi_year) + } else { + closest_year <- data.frame( + data_year = sort(unique(data$survey_year)), + scanfi_year = NA + ) + + available_years <- sort(as.numeric(names(scanfi_data))) + + for (i in closest_year$data_year) { + closest_year$scanfi_year[ + closest_year$data_year == i + ] <- available_years[which( + abs(i - available_years) == min(abs(i - available_years)) + )] + } + + outside_years <- closest_year$data_year[ + abs(closest_year$scanfi_year - closest_year$data_year) > 5 + ] + + if (length(outside_years) > 0) { + if (TRUE %in% (outside_years %in% 1980:2030)) { + warning( + "[SCANFI Download] Data contains years more than 5 years away", + " from nearest SCANFI snapshot (", + stringr::str_flatten_comma(outside_years), + "). No value will be returned for observations in these years.", + " Nearby (< 5 years away) snapshots are available for some data", + " years (", + stringr::str_flatten_comma(outside_years[ + outside_years %in% 1980:2030 + ]), + "), but were not provided via the scanfi_data argument. These can be", + " downloaded with scanfi_download().", + call. = FALSE + ) + } else { + warning( + "[SCANFI Download] Data contains years more than 5 years away", + " from nearest SCANFI snapshot (", + stringr::str_flatten_comma(outside_years), + "). No value will be returned for observations in these years.", + call. = FALSE + ) + } + } + + closest_year <- dplyr::filter( + closest_year, + !(.data$data_year %in% outside_years) + ) + + closest_year$scanfi_year <- as.character(closest_year$scanfi_year) + + match_years <- unique(closest_year$scanfi_year) + } + + # Fetch index from covariates argument. + scanfi_vars <- gsub( + pattern = "scanfi_", + replacement = "", + grep("scanfi_", covariates, value = TRUE) + ) + + # Loop through each requested SCANFI variable. + for (i in scanfi_vars) { + # Loop through each snapshot year + for (j in match_years) { + message("[SCANFI Extraction] extracting SCANFI ", i, ".") + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE & i == "nfilc") { + have_pkg_check("landscapemetrics") + } + + if (buffered == TRUE & !(i == "nfilc")) { + have_pkg_check("exactextractr") + } + + # Check that required raster is available. + if (is.null(scanfi_data[[j]][[i]])) { + stop( + "[SCANFI Extraction] requested covariate raster unavailable for ", + "SCANFI ", + i, + " in snapshot year ", + j, + ". This can be downloaded using scanfi_download().", + call. = FALSE + ) + } + + terra::terraOptions(progress = 0) + + # Crop SCANFI data to study area. + scanfi_data[[j]][[i]] <- terra::crop( + scanfi_data[[j]][[i]], + terra::project(study_area, terra::crs(scanfi_data[[j]][[i]])) + ) + + # Create filled extent polygon of cropped scanfi layer. + + scanfi_filled <- terra::as.polygons(terra::subst( + scanfi_data[[j]][[i]], + from = unname(c(stats::na.omit(unique(terra::values(scanfi_data[[j]][[ + i + ]]))))), + to = 1, + raw = TRUE + )) + + # Loop through each site and extract. + for (k in unique(data$SurveyAreaIdentifier)) { + if ( + (interpolate == FALSE & + as.numeric(j) %in% + data$survey_year[data$SurveyAreaIdentifier == k]) | + interpolate == TRUE + ) { + # Create temporary object with only point/buffer for site k. + tmp <- data %>% + dplyr::filter(.data$SurveyAreaIdentifier == k) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(scanfi_data[[j]][[i]])) + + # Check if the site out of or only partially covered by the spatial + # extent of the provided SCANFI data. Warn if so. + if ( + !terra::is.related(scanfi_filled, terra::vect(tmp), "contains") & + !terra::is.related(scanfi_filled, terra::vect(tmp), "overlaps") + ) { + warning( + "[SCANFI (", + i, + ") Extraction] site ", + k, + " falls outside of the spatial extent of the SCANFI rasters provided.", + " No value will be returned.", + call. = FALSE + ) + } else if ( + !terra::is.related(scanfi_filled, terra::vect(tmp), "contains") & + terra::is.related(scanfi_filled, terra::vect(tmp), "overlaps") + ) { + warning( + "[SCANFI (", + i, + ") Extraction] site ", + k, + "'s buffered area is only partially contained by the spatial extent", + " of the SCANFI rasters provided. Returned ", + i, + " value will be derived from the available values.", + call. = FALSE + ) + } else { + # If no issues with coverage, proceed to extract. For NFI Land Cover, + # extract with landscapemetrics::calculate_lsm() if buffered and with + # terra::extract() if not. Otherwise, extract with + # exactextractr::exact_extract() if buffered, and terra::extract() + # if not. + if (i == "nfilc") { + # Create object containing parseable names for NFI Land Cover classes. + nfilc_classes <- data.frame( + class = c(1:8), + name = c( + "bryoid", + "herbs", + "rock", + "shrub", + "treed_broadleaf", + "treed_conifer", + "treed_mixed", + "water" + ) + ) + + # If buffered, extract with landscapemetrics::calculate_lsm(). + if (buffered == TRUE) { + # Convert temporary object to SpatVector to use with terra:crop() + tmp <- tmp %>% + terra::vect() + + # Crop SCANFI data to site buffer. + scanfi_clip <- terra::crop(scanfi_data[[j]][[i]], tmp) + + # Use landscapemetrics::calculate_lsm() to calculate the proportion + # of each land cover type present in the cropped raster ("pland"). + scanfi_pland <- landscapemetrics::calculate_lsm( + scanfi_clip, + metric = "pland" + ) + + # Loop through each land cover type present in the cropped raster + # and append proportion at site k to input data. Create parseable + # column names using names for each class listed above. + for (l in scanfi_pland$class) { + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + paste0( + "nfilc_", + nfilc_classes$name[nfilc_classes$class == l] + ) + ] <- scanfi_pland$value[scanfi_pland$class == l] + } + + # Check whether any land cover classes were never in the cropped + # raster. These are true zeros, but would be left out otherwise. + # Add these columns in with 0 values. + missing_cols <- paste0("nfilc_", nfilc_classes$name)[ + !(paste0("nfilc_", nfilc_classes$name) %in% names(data)) + ] + + for (l in missing_cols) { + data[ + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + l + ] <- 0 + } + + # Replace NAs present in columns for land cover classes that were + # found at some sites but not others with the true zeros they + # represent. + for (l in paste0( + "nfilc_", + nfilc_classes$name[ + paste0("nfilc_", nfilc_classes$name) %in% names(data) + ] + )) { + data[ + is.na(data[, l] %>% sf::st_drop_geometry()) & + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + l + ] <- 0 + } + + # Reorder columns to match class order provided in NFILC + # documentation. + data <- data[, c( + grep("nfilc_", names(data), value = TRUE, invert = TRUE), + paste0("nfilc_", nfilc_classes$name) + )] + } else { + # Extract point value from SCANFI raster. It appears to be possible + # that a point falls such that it extracts from two raster tiles, + # so handle that possibility below. + extr_table <- terra::extract( + scanfi_data[[j]][[i]], + tmp, + fun = unique + )[, 2] + + # Whether only a single value was extracted (class == "integer") or + # multiple values (else) prepare to pass to input data. + if (inherits(extr_table, "integer")) { + extr_table <- extr_table %>% + as.data.frame() + + names(extr_table) <- "class" + + extr_table <- dplyr::left_join( + extr_table, + nfilc_classes, + by = "class" + ) + } else { + extr_table <- extr_table %>% + as.data.frame() %>% + dplyr::select(terra::names(scanfi_data[[j]][[i]])) + + names(extr_table) <- "class" + + extr_table <- dplyr::left_join( + extr_table, + nfilc_classes, + by = "class" + ) + } + + # Join extracted value to input data. If multiple values were + # extracted, join the first value in extr_table and warn the user + # about potential values so they can adjust manually. + tryCatch( + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + "nfilc_class" + ] <- nfilc_classes$name[ + nfilc_classes$class == + terra::extract(scanfi_data[[j]][[i]], tmp, fun = unique)[, + terra::names(scanfi_data[[j]][[i]]) + ] + ], + warning = function(w) { + if ( + conditionMessage(w) == + paste0( + "longer object length is not a multiple of shorter", + " object length" + ) + ) { + warning(paste0( + "[SCANFI (", + i, + ") Extraction] site ", + k, + " touches multiple cells. Extraction returned `", + suppressWarnings(nfilc_classes$name[ + nfilc_classes$class == + terra::extract( + scanfi_data[[j]][[i]], + tmp, + fun = unique + )[, + terra::names(scanfi_data[[j]][[i]]) + ] + ]), + "` but possible values were `", + stringr::str_flatten( + extr_table$name, + collapse = "`, `" + ), + "`. Please examine to choose desired output and replace if", + " necessary.", + call. = FALSE + )) + } else { + warning(conditionMessage(w), call. = FALSE) + } + } + ) + } + } else { + # For other SCANFI variables, if buffered, extract using + # exactextractr::exact_extract(). If not, extract using + # terra::extract(). + if (buffered == TRUE) { + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + paste0("scanfi_", i) + ] <- exactextractr::exact_extract( + x = scanfi_data[[j]][[i]], + y = tmp, + fun = "mean" + ) + } else { + data[ + data$SurveyAreaIdentifier == k & + data$survey_year %in% + closest_year$data_year[closest_year$scanfi_year == j], + paste0("scanfi_", i) + ] <- terra::extract( + x = scanfi_data[[j]][[i]], + y = tmp, + fun = "mean", + na.rm = TRUE + )[, 2] + } + } + } + } + } + } + } + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + if (!is.null(date_year)) { + names(data)[names(data) == "survey_year"] <- date_year + } + + # Remove SCANFI files if requested. + if (retain == FALSE) { + # Check that if default directory doesn't exist an alterate has been + # specified. + if (is.null(dl_path) & !dir.exists("./scanfi")) { + warning( + "[SCANFI Extraction] unable to find default SCANFI", + " directory and no alternate specified using dl_path argument", + ". No files will be removed.", + call. = FALSE + ) + } else { + message(paste0("[SCANFI Extraction] task complete. Removing files.")) + + file.remove(list.files( + ifelse(is.null(dl_path), "./scanfi", paste0(dl_path, "/scanfi")), + full.names = TRUE + )) + } + } + + # Return input data with appended SCANFI columns. + return(data) +} diff --git a/R/vegetation_download.R b/R/vegetation_download.R new file mode 100644 index 00000000..1381e610 --- /dev/null +++ b/R/vegetation_download.R @@ -0,0 +1,518 @@ +#' Download MODIS NDVI/EVI Data +#' +#' Downloads [16-day NDVI/EVI data](https://doi.org/10.5067/MODIS/MOD13A1.061) +#' derived from imagery from the MODIS Terra and Aqua satellites at +#' approximately 500 m spatial resolution. This data is retreived via the NASA +#' EarthData Archive, requiring an EarthData account to be made. This can be +#' done at the following link: [register for an EarthData +#' account](https://urs.earthdata.nasa.gov/users/new). +#' +#' Both NDVI and EVI data are downloaded in a single file, and can be accessed +#' specifically by specifying `modis_ndvi` and/or `modis_evi` to the `covariates` +#' argument in a call to `vegetation_extract()`. +#' +#' Downloads are facilitated by a call to [luna::getNASA()]. +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param ed_email Character. The email address associated with your EarthData +#' account. +#' @param ed_transfer Logical. Should data be downloaded from EarthData? +#' If `FALSE`, a vector containing the names of the files that would be +#' downloaded is returned. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()]. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day-of-month (i.e., a number from 1 to 31) data if not +#' contained within the BMDE column `survey_day`. Can be left `NULL` and still +#' function properly if originally specified in a call to [data_fmt()]. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `modis/` in the working +#' directory. +#' @param progress Logical. Should progress bars for downloads be displayed? +#' +#' @returns If `ed_transfer = TRUE`, character vector containing +#' file-paths to downloaded MODIS landcover files. If `ed_transfer = +#' FALSE`, character vector containing filenames of MODIS landcover files that +#' would be downloaded. +#' +#' @examplesIf interactive() +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Grab one year to reduce number of files to download +#' bcch <- dplyr::filter(bcch, survey_year == 2010) +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Get file names that would be downloaded. +#' output <- vegetation_download( +#' data = bcch, +#' ed_transfer = FALSE +#' ) +#' +#' # Enter EarthData email +#' ed_email <- "your EarthData email" +#' +#' # Download MODIS data +#' #output <- vegetation_download( +#' # data = bcch, +#' # ed_email = ed_email +#' #) +#' +#' @seealso [luna::getNASA()] which this function wraps. +#' +#' [vegetation_extract()] which can be used to extract data from downloaded +#' vegetation data files. +#' +#' @export + +# Function for downloading MODIS MOD13A1 data from NASA EarthData. Wrapper for +# luna::getNASA(). +vegetation_download <- function( + data, + ed_email = NULL, # users' EarthData account email address. + ed_transfer = TRUE, # should data be downloaded from EarthData? + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month' + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. + dl_path = NULL, # optional argument to provide path to download data to. By + # default, data is downloaded to a subfolder 'modis/' in the working + # directory. + progress = TRUE # Should progress bars for downloads be displayed? +) { + # Check packages + have_pkg_check(c( + "sf", + "terra", + "luna" + )) + + # Check that ed_transfer is logical. + if (!is.logical(ed_transfer)) { + stop( + "[MODIS NDVI/EVI Download] ed_transfer must be TRUE or FALSE.", + call. = FALSE + ) + } + + # Check that an EarthData account email has been provided. If not, return + # error. + if (missing(ed_email) & ed_transfer == TRUE) { + stop( + "[MODIS NDVI/EVI Download] MODIS data requested but Earthdata system", + " login information not supplied. Please register at", + " https://urs.earthdata.nasa.gov/users/new and supply using `ed_email`", + " argument.", + call. = FALSE + ) + } + + # Check whether user password is stored in .Renviron + if (ed_transfer == TRUE) { + ed_password <- Sys.getenv("EarthData_password") + + # If not available in .Renviron, check whether an EarthData password exists + # in the environment (is specified earlier in the nc_covariates() workflow), + # and if not, request using askpass::askpass(). + if (ed_password == "") { + if (is.null(parent.frame()$ed_password)) { + ed_password <- askpass::askpass( + prompt = paste0( + "Please enter password for ", + "EarthData user '", + ed_email, + "'." + ) + ) + + if (is.null(ed_password)) { + stop( + "[MODIS NDVI/EVI Download] EarthData password could not be found", + ". Please add line 'EarthData_password = yourpassword' to your", + " .Renviron file. This can be accessed using usethis::edit_r_environ().", + call. = FALSE + ) + } + } else { + ed_password <- parent.frame()$ed_password + } + } + + # Attempt EarthData authentication three times to avoid errant API + # connect failures. + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + + if (inherits(auth, "try-error")) { + if (stringr::str_detect(auth, "aborted by an application callback")) { + stop(auth, call. = FALSE) + } else if (stringr::str_detect(auth, "could not reach Earthdata Login")) { + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + if (inherits(auth, "try-error")) { + if (stringr::str_detect(auth, "aborted by an application callback")) { + stop(auth, call. = FALSE) + } else if ( + stringr::str_detect(auth, "could not reach Earthdata Login") + ) { + auth <- try( + luna::earthdataLogin( + username = ed_email, + password = ed_password, + verbose = progress + ), + silent = TRUE + ) + if (inherits(auth, "try-error")) { + stop(auth, call. = FALSE) + } + } + } + } + } + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[MODIS NDVI/EVI Download] downloading requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + if (is.null(date_month) & !is.null(attr(data, "date_month"))) { + date_month <- attr(data, "date_month") + } + + if (is.null(date_day) & !is.null(attr(data, "date_day"))) { + date_day <- attr(data, "date_day") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year, date_month, date_day) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols) | + !("survey_month" %in% data_cols) | + !("survey_day" %in% data_cols)) + ) { + stop( + "[MODIS NDVI/EVI Download] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that", + " diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + if (!is.null(date_month)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + # Use month_check() to validate month data. + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + data$survey_month <- month_corr + + if (!is.null(date_day)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_day" = !!date_day) + } + + # Use dom_check() to validate day data. + for (i in data$survey_day) { + dom_check(i) + } + + # Create area of interest polygon from provided sf object. + if (input_fmt$type == "sf") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_transform("ESRI:102001") %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } else { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_buffer(20000) %>% # # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } + } + + # Create area of interest polygon from provided terra object. + if (input_fmt$type == "terra") { + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::project("ESRI:102001") %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } else { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) # Maybe down the line write full process out in + # terra for terra data. + } + + # Remove any observations missing year, month, or day data. Warn. + if ( + TRUE %in% + is.na(data$survey_year) | + TRUE %in% is.na(data$survey_month) | + TRUE %in% is.na(data$survey_day) + ) { + warning( + "[MODIS NDVI/EVI Download] missing date data detected. Complete year,", + " month, and day data is needed for data download. Observations missing", + " date data will be dropped.", + call. = FALSE + ) + + data <- data %>% + dplyr::filter( + !is.na(.data$survey_year), + !is.na(.data$survey_month), + !is.na(.data$survey_day) + ) + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./modis/MOD13A1")) { + dir.create("./modis/MOD13A1", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/modis/MOD13A1"))) { + dir.create(paste0(dl_path, "/modis/MOD13A1"), recursive = TRUE) + } + + # In first iteration of loop, fetch number of files to download to warn + # user as the 16-day resolution of this data can result in large file batches + # by setting download = FALSE in luna::getNASA(). + for (i in unique(c(FALSE, ed_transfer))) { + if (i == TRUE) { + if (length(modis_files > 0)) { + message("[MODIS NDVI/EVI Download] downloading data.") + } + } else if (i == FALSE & ed_transfer == FALSE) { + message("[MODIS NDVI/EVI Download] fetching data filenames.") + } + + dates <- sort(unique(paste0( + data$survey_year, + "-", + data$survey_month, + "-", + data$survey_day + ))) + + # Open vector to store filenames. + modis_files <- c() + warning_dates <- c() + + for (j in dates) { + if (i == FALSE) { + tryCatch( + tmp <- luna::getNASA( + product = "MOD13A1", + start = j, + end = j, + aoi = terra::project(study_area, "epsg:4326"), + download = i, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MOD13A1", + paste0(dl_path, "/modis/MOD13A1") + ), + verbose = progress + ), + warning = function(w) { + if ( + conditionMessage(w) == + "No downloadable granules found for product='MOD13A1'. Did you mean: MOD13A2, MOD13A3, MOD13A4N, MOD13C1, MOD13C2? Use `getProducts('MOD13')` to list related products." + ) { + warning_dates <<- unique(c(warning_dates, j)) + } else { + warning(conditionMessage(w)) + } + } + ) + } else { + tryCatch( + tmp <- luna::getNASA( + product = "MOD13A1", + start = j, + end = j, + aoi = terra::project(study_area, "epsg:4326"), + download = i, + overwrite = FALSE, + path = ifelse( + is.null(dl_path), + "./modis/MOD13A1", + paste0(dl_path, "/modis/MOD13A1") + ), + auth = auth, + verbose = progress + ), + warning = function(w) { + if ( + conditionMessage(w) == + "No downloadable granules found for product='MOD13A1'. Did you mean: MOD13A2, MOD13A3, MOD13A4N, MOD13C1, MOD13C2? Use `getProducts('MOD13')` to list related products." + ) { + warning_dates <<- unique(c(warning_dates, j)) + } else { + warning(conditionMessage(w)) + } + } + ) + } + + if (!(j %in% warning_dates)) { + modis_files <- unique(c(modis_files, tmp)) + } + } + + # Warn of any out of range dates on first iteration only. + if (i == FALSE & length(warning_dates > 0)) { + warning( + "Observation on date(s) ", + stringr::str_flatten_comma(warning_dates), + " could not be matched to a MODIS vegetation data file. Are they", + " outside of the temporal coverage of the data (i.e., before 2000 or in the current year)?", + call. = FALSE + ) + } + + # On first iteration (if downloading files) send message about expected + # number of files to download. + if (i == FALSE & ed_transfer == TRUE & length(modis_files > 0)) { + message(paste0( + "[MODIS NDVI/EVI Download] data products are at a 16 day resolution, resulting in ", + length(modis_files), + " files to download for your data. This may take some time." + )) + } + } + + # Return character vector of filepaths to downloaded files (if ed_transfer = TRUE) + # or character vector of filenames (if ed_transfer = FALSE). + return(modis_files) +} diff --git a/R/vegetation_extract.R b/R/vegetation_extract.R new file mode 100644 index 00000000..dcb80d26 --- /dev/null +++ b/R/vegetation_extract.R @@ -0,0 +1,907 @@ +#' Extract MODIS NDVI/EVI Data +#' +#' Extracts [16-day NDVI/EVI data](https://doi.org/10.5067/MODIS/MOD13A1.061) +#' derived from imagery from the MODIS Terra and Aqua satellites at +#' approximately 500 m spatial resolution. This data can be downloaded using +#' [vegetation_download()]. The user guide for these data can be found +#' [here](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). +#' +#' Both NDVI and EVI are available through this function and +#' can be accessed by supplying the following arguments to the `covariates` +#' argument: +#' - `modis_ndvi` - NDVI +#' - `modis_evi` - EVI +#' +#' Details on the calculation of these indices can be found in the +#' [MOD13 user guide](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). +#' +#' NDVI/EVI calculations are sensitive to the presence of snow/ice and cloudiness. +#' So users can assess the quality of data extracted at each site, we have included +#' the option to extract pixel reliability assessments included in these NDVI/EVI +#' products by setting argument `reliability = TRUE`. The reliability scale is +#' as in the [user manual](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf), +#' and is supplied to the user in the `vegetation_reliability` column if requested. +#' +#' @inheritParams vegetation_download +#' +#' @param covariates Character, vector if both NDVI and EVI desired. By +#' default, extracts NDVI (`modis_ndvi`). +#' @param vegetation_files Character, vector if multiple files. File-path(s) to +#' downloaded MODIS vegetation data file(s). We recommend using +#' [vegetation_download()] to download MODIS files to ensure all files +#' necessary for your data are captured. Direct output of +#' [vegetation_download()] can be supplied here. +#' @param reliability Logical. Should pixel reliability information be extracted +#' at each site? +#' @param site_name Character. Optional argument to provide name of the column +#' containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()] or [vegetation_download()]. +#' @param date_year Character. Optional argument to provide the name of the +#' column containing year data if not contained within the BMDE column +#' `survey_year`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()] or [vegetation_download()]. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()] or [vegetation_download()]. +#' @param date_day Character. Optional argument to provide the name of the +#' column containing day-of-month (i.e., a number from 1 to 31) data if not +#' contained within the BMDE column `survey_day`. Can be left `NULL` and still +#' function properly if originally specified in a call to [data_fmt()] or +#' [vegetation_download()]. +#' @param retain Logical. Should MODIS data files be kept after extraction. If +#' `FALSE`, files will be deleted. +#' +#' @returns For `sf` 'POINT' or `terra` 'points' input data, original data with +#' numeric column(s) `ndvi` and/or `evi` appended containing the NDVI/EVI value +#' at that point. If reliability information requested, an additional +#' `vegetation_reliability` column is appended containing the reliability +#' assessment as defined in table 4 of the +#' [product's user manual](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). +#' +#' For `sf` 'POLYGON' or `terra` 'polygons' input data, original data with +#' numeric column(s) `ndvi` and/or `evi` appended containing the mean NDVI/EVI +#' value within each polygon. If reliability information requested, an additional +#' `vegetation_reliability` column is appended containing the percentage of +#' pixels overlapped by each polygon in each reliability assessment as defined in table 4 of the +#' [product's user manual](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). +#' +#' @examplesIf interactive() +#' +#' # Using the included, test data on black-capped chickadees +#' bcch # look at the data +#' +#' # Grab one year to reduce number of files to download +#' bcch <- dplyr::filter(bcch, survey_year == 2010) +#' +#' # Convert to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Enter EarthData email +#' ed_email <- readline(prompt = "Enter EarthData email: ") +#' +#' # Download MODIS data +#' modis_files <- vegetation_download( +#' bcch, +#' ed_email = ed_email +#' ) +#' +#' # Extract vegetation data +#' output <- vegetation_extract( +#' data = bcch, +#' covariates = "modis_ndvi", +#' vegetation_files = modis_files, +#' retain = FALSE +#' ) +#' +#' @seealso [vegetation_download()] which can be used to download data from +#' the MODIS Vegetation Indices database. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @export + +# Function to extract vegetation data from provided MODIS MOD13A1 data files. +vegetation_extract <- function( + data, + covariates = "modis_ndvi", # Other options listed in nc_covariate_table(). + vegetation_files, # Character vector of filepaths to downloaded files. + reliability = FALSE, # Should pixel reliability information be extracted at + # each site? + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_year = NULL, # optional argument to provide column name containing year + # data. Default is assumed to be the BMDE column 'survey_year'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_day = NULL, # optional argument to provide column name containing day + # data. Default is assumed to be the BMDE column 'survey_day'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + retain = TRUE # Should data files be kept after extraction? +) { + # Check packages + have_pkg_check(c( + "sf", + "luna", + "terra" + )) + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[MODIS NDVI/EVI Extraction] covariates either not listed or one or more are invalid. Please provide covariate names as listed under `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + # If no vegetation files are provided, return error. + if (missing(vegetation_files) | length(vegetation_files) == 0) { + stop( + "[MODIS NDVI/EVI Extraction] no vegetation files provided to extract from. Please provide a vector containing filepaths of all necessary MODIS files for your data. Data can be downloaded using vegetation_download().", + call. = FALSE + ) + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[MODIS NDVI/EVI Extraction] extraction requires an sf or terra object as input in this workflow. Consider using `data_fmt` to conform data first.", + call. = FALSE + ) + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + if (length(attr_names[attr_names %in% names(attributes(data))]) > 0) { + attrs <- attributes(data)[attr_names[ + attr_names %in% names(attributes(data)) + ]] + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_year) & !is.null(attr(data, "date_year"))) { + date_year <- attr(data, "date_year") + } + + if (is.null(date_month) & !is.null(attr(data, "date_month"))) { + date_month <- attr(data, "date_month") + } + + if (is.null(date_day) & !is.null(attr(data, "date_day"))) { + date_day <- attr(data, "date_day") + } + + # Check that all specified column names are present in the data. + + # Gather all potentially specified columns. + specified_cols <- c(site_name, date_year, date_month, date_day) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_year" %in% data_cols) | + !("survey_month" %in% data_cols) | + !("survey_day" %in% data_cols)) + ) { + stop( + "[MODIS NDVI/EVI Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_year) & !("survey_year" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_year" = !!date_year) + } + + data$survey_year <- as.numeric(data$survey_year) + + if (!is.null(date_month) & !("survey_month" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + # Use month_check() to validate month data. + data$survey_month <- month_corr + + data$survey_month <- as.numeric(data$survey_month) + + if (!is.null(date_day) & !("survey_day" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_day" = !!date_day) + } + + # Use dom_check() to validate day data. + for (i in data$survey_day) { + dom_check(i) + } + + data$survey_day <- as.numeric(data$survey_day) + + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "sf") { + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + } + + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + if (input_fmt$type == "terra") { + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) # Maybe down the line write full process out in + # terra for terra data. + } + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE) { + have_pkg_check("exactextractr") + } + + # Remove any observations missing year, month, or day data. + if ( + TRUE %in% + is.na(data$survey_year) | + TRUE %in% is.na(data$survey_month) | + TRUE %in% is.na(data$survey_day) + ) { + warning( + "[MODIS NDVI/EVI Extraction] Missing date data detected. Complete year,", + " month, and day data is needed for extraction. Observations missing", + " date data will be dropped.", + call. = FALSE + ) + + data <- data %>% + dplyr::filter( + !is.na(.data$survey_year), + !is.na(.data$survey_month), + !is.na(.data$survey_day) + ) + } + + # Parse dates stored in filenames of MODIS data files and append column to + # filenames. + modis_files <- luna::modisDate(vegetation_files) + + # As each files contains data covering a 16 day period, create an end date of + # each files coverage. + modis_files$enddate <- modis_files$date + 16 + + modis_files$year <- as.numeric(modis_files$year) + modis_files$month <- as.numeric(modis_files$month) + modis_files$day <- as.numeric(modis_files$day) + + modis_files$endyear <- lubridate::year(modis_files$enddate) + modis_files$endmonth <- lubridate::month(modis_files$enddate) + modis_files$endday <- lubridate::day(modis_files$enddate) + + modis_files$yday <- lubridate::yday(modis_files$date) + modis_files$endyday <- lubridate::yday(modis_files$enddate) + + # Function for quick conversion of ordinal dates. + yearyearday <- function(yr, yd) { + base <- as.Date(paste0(yr, "-01-01")) # take Jan 1 of year + day <- base + yd - 1 + } + + # Some date windows have multiple files produced at different times. Extract + # and store production dates so we can select between these files later. + modis_files$productiondate <- yearyearday( + as.numeric(substr( + gsub(pattern = ".*modis", replacement = "./modis", modis_files$filename), + 61 - 16, + 61 - 13 + )), + as.numeric(substr( + gsub(pattern = ".*modis", replacement = "./modis", modis_files$filename), + 61 - 12, + 61 - 10 + )) + ) + + lubridate::hms(paste0( + substr( + gsub( + pattern = ".*modis", + replacement = "./modis", + modis_files$filename + ), + 61 - 9, + 61 - 8 + ), + ":", + substr( + gsub( + pattern = ".*modis", + replacement = "./modis", + modis_files$filename + ), + 61 - 7, + 61 - 6 + ), + ":", + substr( + gsub( + pattern = ".*modis", + replacement = "./modis", + modis_files$filename + ), + 61 - 5, + 61 - 4 + ) + )) # So long as date format in files stays consistent, this should work + # fine. + + # Extract and bind spatial extent of each data file. + modis_files <- cbind( + modis_files, + as.data.frame(luna::modisExtent(modis_files$filename)) + ) + + # Build object to use in matching sites to their respective MODIS data file. + modis_match <- data %>% + dplyr::mutate( + date = as.Date(paste0( + .data$survey_year, + "-", + .data$survey_month, + "-", + .data$survey_day + )) + ) %>% + dplyr::mutate(yday = lubridate::yday(.data$date)) %>% + dplyr::select( + "SurveyAreaIdentifier", + "survey_year", + "date", + "yday", + "geometry" + ) %>% + sf::st_transform(terra::crs(terra::rast(modis_files$filename[1]))) + + # If buffered, extract coordinates from centroids. Append coordinates. + if (buffered == TRUE) { + suppressWarnings( + modis_match <- cbind( + modis_match, + sf::st_coordinates(sf::st_centroid(modis_match)) + ) + ) + } else { + modis_match <- cbind(modis_match, sf::st_coordinates(modis_match)) + } + + # Open vectors to store site/date information for sites/dates that are unable + # to be matched to a data file. + warning_sites <- c() + warning_years <- c() + warning_dates <- c() + + # Loop through each site-date combination and match to a data file. + for (i in unique(modis_match$SurveyAreaIdentifier)) { + for (j in unique(modis_match$survey_year[ + modis_match$SurveyAreaIdentifier == i + ])) { + for (k in unique(modis_match$date[ + modis_match$SurveyAreaIdentifier == i & modis_match$survey_year == j + ])) { + # Create temporary object containing only data for site i on day k + # of year j. + tmp <- dplyr::filter( + modis_match, + .data$SurveyAreaIdentifier == i, + .data$survey_year == j, + .data$date == k + ) + + # Check to see whether the site-date combination can be matched to a + # data file. + if ( + nrow(modis_files[ + modis_files$year == tmp$survey_year & + modis_files$xmin < tmp$X & + modis_files$xmax > tmp$X & + modis_files$ymin < tmp$Y & + modis_files$ymax > tmp$Y & + modis_files$date <= tmp$date & + modis_files$enddate > tmp$date, + ]) == + 0 + ) { + # Do the coordinates fall within the area covered by any of + # the data files? + spatial_check <- ifelse( + nrow(modis_files[ + modis_files$xmin < tmp$X & + modis_files$xmax > tmp$X & + modis_files$ymin < tmp$Y & + modis_files$ymax > tmp$Y, + ]) > + 0, + TRUE, + FALSE + ) + + # Does data exist for the data's year? + year_check <- ifelse( + nrow(modis_files[modis_files$year == tmp$survey_year, ]) > 0, + TRUE, + FALSE + ) + + # Does the date fall within the date windows covered by any of the + # data files? + yday_check <- ifelse( + nrow(modis_files[ + modis_files$date <= tmp$date & modis_files$enddate > tmp$date, + ]) > + 0, + TRUE, + FALSE + ) + + # If any checks not passed, store for later warning message. + if (!(spatial_check)) { + warning_sites <- c(warning_sites, i) + } + + if (!(year_check)) { + warning_years <- c(warning_years, j) + } + + # Only warn about date if the data is within the spatial extent of + # the provided MODIS data and is in a year covered by the data. + if (spatial_check & year_check & !(yday_check)) { + warning_dates <- c(warning_dates, k) + } + } else { + # If no issues with coverage, match site-date combinations to + # respective files. + + # List all files that match the location and date. + suppressWarnings( + { + poss_files <- modis_files[ + modis_files$year == tmp$survey_year & + modis_files$xmin < tmp$X & + modis_files$xmax > tmp$X & + modis_files$ymin < tmp$Y & + modis_files$ymax > tmp$Y & + modis_files$date <= tmp$date & + modis_files$enddate > tmp$date, + ] + + # Pick the most recently produced file. + modis_match[ + modis_match$SurveyAreaIdentifier == i & + modis_match$survey_year == j & + modis_match$date == k, + "filename" + ] <- poss_files$filename[ + poss_files$productiondate == max(poss_files$productiondate) + ] + } + ) + } + } + } + } + + # Order sites and dates for warning message. + warning_sites <- sort(unique(warning_sites)) + warning_years <- sort(unique(warning_years)) + warning_dates <- sort(unique(warning_dates)) + + # Warn about sites that fall outside of the spatial extent of the provided + # MODIS data. + if (length(warning_sites) > 0) { + if (length(warning_sites) == 1) { + warning( + "[MODIS NDVI/EVI Extraction] site ", + stringr::str_flatten_comma(unique(warning_sites)), + " falls outside of the spatial extent of the files provided. No value", + " will be returned.", + call. = FALSE + ) + } else { + warning( + "[MODIS NDVI/EVI Extraction] sites ", + stringr::str_flatten_comma(unique(warning_sites)), + " fall outside of the spatial extent of the files provided. No value", + " will be returned.", + call. = FALSE + ) + } + } + + # Warn about observations in years that fall outside of the temporal coverage + # of the provided MODIS data. + if (length(warning_years) > 0) { + if (length(warning_years) == 1) { + warning( + "[MODIS NDVI/EVI Extraction] observations from year ", + stringr::str_flatten_comma(unique(warning_years)), + " fall outside of the temporal extent of the files provided. Is it in", + " a year where data is unavailable from this dataset? No value will", + " be returned.", + call. = FALSE + ) + } else { + warning( + "[MODIS NDVI/EVI Extraction] observations from years ", + stringr::str_flatten_comma(unique(warning_years)), + " fall outside of the temporal extent of the files provided. Is it in", + " a year where data is unavailable from this dataset? No value will be", + " returned.", + call. = FALSE + ) + } + } + + # Warn about observations on dates that fall outside of the temporal coverage + # of the provided MODIS data. + if (length(warning_dates) > 0) { + warning( + "[MODIS NDVI/EVI Extraction] observations on ", + stringr::str_flatten_comma(unique(as.Date(warning_dates))), + " fall outside of the temporal extent of the files provided. You have", + " provided data for this year but not this 16-day window. No value will", + " be returned.", + call. = FALSE + ) + } + + # Remove observations without matches. + modis_match <- dplyr::filter(modis_match, !is.na(.data$filename)) + + # Edge case: there is a column in the data called yday that we don't want to + # overwrite. + + if ("yday" %in% names(data)) { + yday_storage <- data$yday + yday_before <- names(data)[which(names(data) == "yday") - 1] + } + + # Create an ordinal date column in original data for later joining. + data$yday <- paste0( + data$survey_year, + "-", + data$survey_month, + "-", + data$survey_day + ) %>% + as.Date() %>% + lubridate::yday() + + # Loop through each requested vegetation metric, extract, and join to original + # data. + for (i in `if`( + "modis_ndvi" %in% covariates, + `if`( + "modis_evi" %in% covariates, + c("modis_ndvi", "modis_evi"), + "modis_ndvi" + ), + "modis_evi" + )) { + message(paste0( + "[MODIS NDVI/EVI Extraction] calculating MODIS ", + ifelse(i == "modis_ndvi", "NDVI", "EVI"), + "." + )) + + # Create index to access appropriate data layer from MODIS rasters. + index <- ifelse( + i == "modis_ndvi", + "\"500m 16 days NDVI\"", + "\"500m 16 days EVI\"" + ) + + # Loop through each matched MODIS data file. + for (j in unique(modis_match$filename)) { + # Create object with all site-date combinations that matched to file j. + pts_to_fill <- data[ + data$SurveyAreaIdentifier %in% + modis_match$SurveyAreaIdentifier[modis_match$filename == j] & + data$survey_year %in% + modis_match$survey_year[modis_match$filename == j] & + data$yday %in% modis_match$yday[modis_match$filename == j], + ] + + # Open the requested layer in file j. `raw` argument is to avoid erroneous + # scaling factor specified in file. See https://github.com/rspatial/terra/issues/1620. + modis <- terra::rast(j, raw = TRUE)[index] + + if (reliability == TRUE) { + modis_reliability <- terra::rast(j)[ + "\"500m 16 days pixel reliability\"" + ] + } + + # Replace fill values with NAs. + modis <- terra::subst(modis, -3000, NA) + + # Loop through each site matched to file j and extract. + for (k in unique(pts_to_fill$SurveyAreaIdentifier)) { + # If buffered, extract using exactextractr::exact_extract(). If not, + # extract using terra::extract(). + if (buffered == TRUE) { + # Create temporary object containing only the buffer for site k. + tmp <- data %>% + dplyr::filter( + .data$SurveyAreaIdentifier == k, + .data$survey_year %in% + modis_match$survey_year[modis_match$filename == j] + ) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(modis)) + + # Crop MODIS data file to site k's buffer. + modis_clip <- terra::crop(modis, tmp) + + if (reliability == TRUE) { + modis_reliability_clip <- terra::crop(modis_reliability, tmp) + } + + # Extract using exactextractr::exact_extract(). + data[ + data$SurveyAreaIdentifier == k & + data$survey_year == + unique(modis_match$survey_year[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ]) & + data$yday %in% + modis_match$yday[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ], + ifelse(i == "modis_ndvi", "ndvi", "evi") + ] <- exactextractr::exact_extract(modis_clip, tmp, fun = "mean") + + # Extract pixel reliability information if requested. + if (reliability == TRUE) { + pixel_vals <- table( + exactextractr::exact_extract(modis_reliability_clip, tmp)[[ + 1 + ]]$value + ) + + str_components <- c() + for (l in 1:length(pixel_vals)) { + labels <- data.frame( + value = c(-1:3), + label = c( + "Fill/No Data", + "Good Data", + "Marginal Data", + "Snow/Ice", + "Cloudy" + ) + ) + str_components[l] <- paste0( + labels$label[labels$value == names(pixel_vals)[l]], + " (", + round((unname(pixel_vals[l]) / sum(pixel_vals)) * 100, 2), + "%)" + ) + } + + data[ + data$SurveyAreaIdentifier == k & + data$survey_year == + modis_match$survey_year[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ] & + data$yday %in% + modis_match$yday[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ], + "vegetation_reliability" + ] <- stringr::str_flatten_comma(str_components) + } + } else { + # Create temporary object containing only the point for site k. + tmp <- data %>% + dplyr::filter( + .data$SurveyAreaIdentifier == k, + .data$survey_year %in% + modis_match$survey_year[modis_match$filename == j] + ) %>% + dplyr::select("SurveyAreaIdentifier", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(modis)) %>% + terra::vect() + + # Extract using terra::extract(). + data[ + data$SurveyAreaIdentifier == k & + data$survey_year == + unique(modis_match$survey_year[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ]) & + data$yday %in% + modis_match$yday[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ], + ifelse(i == "modis_ndvi", "ndvi", "evi") + ] <- terra::extract(modis, tmp)[, 2] + + # Extract pixel reliability information if requested. + if (reliability == TRUE) { + labels <- data.frame( + value = c(-1:3), + label = c( + "Fill/No Data", + "Good Data", + "Marginal Data", + "Snow/Ice", + "Cloudy" + ) + ) + + data[ + data$SurveyAreaIdentifier == k & + data$survey_year == + modis_match$survey_year[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ] & + data$yday %in% + modis_match$yday[ + modis_match$filename == j & + modis_match$SurveyAreaIdentifier == k + ], + "vegetation_reliability" + ] <- labels$label[ + labels$value == + unique(terra::extract(modis_reliability, tmp)[, 2]) + ] + } + } + } + } + } + + # Apply scaling factor. + if ("modis_ndvi" %in% covariates) { + data$ndvi <- data$ndvi * 0.0001 + } + + if ("modis_evi" %in% covariates) { + data$evi <- data$evi * 0.0001 + } + + # Remove ordinal date column from original data. + data <- dplyr::select(data, -"yday") + + # If a yday column was stored, return it here + if (exists("yday_storage")) { + data$yday <- yday_storage + data <- dplyr::relocate(.data = data, "yday", .after = yday_before) + + rm(yday_storage) + rm(yday_before) + } + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + if (!is.null(date_year)) { + names(data)[names(data) == "survey_year"] <- date_year + } + + if (!is.null(date_month)) { + names(data)[names(data) == "survey_month"] <- date_month + } + + if (!is.null(date_day)) { + names(data)[names(data) == "survey_day"] <- date_day + } + + # If requested, remove MODIS data files. + if (retain == FALSE) { + message(paste0( + "[MODIS NDVI/EVI Extraction] task complete. Removing files." + )) + + file.remove(modis_files$filename) + } + + # Return input data with appended vegetation columns. + return(data) +} diff --git a/R/worldclim_download.R b/R/worldclim_download.R new file mode 100644 index 00000000..ea718810 --- /dev/null +++ b/R/worldclim_download.R @@ -0,0 +1,267 @@ +#' Load WorldClim Climate Data +#' +#' Downloads monthly WorldClim Monthly Climate Norms, averaged over 1970-2000, +#' from [WorldClim version 2.1](https://www.worldclim.org/data/worldclim21.html) +#' at a ~ 1 km^2 spatial resolution (Fick & Hijmans 2017). Several climate variables +#' are available in this dataset: minimum, maximum, and average temperature (°C), +#' precipitation (mm), solar radiation (kJ/m^2/day), and wind speed (m/s). +#' Users should note that these files are downloaded at the country-scale so +#' they can be quite large. +#' +#' One (or multiple) climate variable(s) can be downloaded by specifying the following +#' values to the `covariates` argument +#' - Minimum temperature: `worldclim_tmin` +#' - Maximum temperature: `worldclim_tmax` +#' - Average temperature: `worldclim_tavg` +#' - Precipitation: `worldclim_prec` +#' - Solar radiation: `wordclim_srad` +#' - Wind speed: `worldclim_wind` +#' +#' Downloads are facilitated by a call to [geodata::worldclim_country()]. +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. Not required if `countries` is specified, but must be +#' specified if `countries` is left unspecified. +#' @param covariates Character, vector if multiple climate data types desired. By +#' default, downloads WorldClim average temperature data. +#' @param countries Character, vector if multiple countries. Country names or +#' [ISO3 country codes](https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3) for which +#' data should be downloaded. If left `NULL`, function will attempt to identify +#' countries needed based on locations in `data`. +#' @param dl_path Character. Optional argument to provide path to download data +#' to. By default, data is downloaded to a subfolder `WorldClim/` in the working +#' directory. +#' @param progress Logical. Should progress bars and download messages be displayed? +#' +#' @returns A merged `terra SpatRaster` containing all requested data. A `list` of +#' multiple `terra SpatRaster` objects if multiple climate data types requested. +#' +#' @examples +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Load WorldClim data +#' output <- worldclim_download(data = bcch, +#' covariates = "worldclim_wind", +#' progress = FALSE) +#' +#' @seealso [geodata::worldclim_country()] which this function wraps. +#' +#' [worldclim_extract()] +#' which can be used to extract data from loaded WorldClim data files. +#' +#' @references Fick, S.E. and R.J. Hijmans, 2017. WorldClim 2: new 1km spatial resolution climate surfaces for global land areas. International Journal of Climatology 37 (12): 4302-4315. +#' +#' @export + +# Function for downloading WorldClim data. Wrapper for +# geodata::worldclim_country(). +worldclim_download <- function( + data = NULL, + covariates = "worldclim_tavg", # Other options listed in nc_covariate_table(). + countries = NULL, # Character vector of country names or ISO3 codes. If left + # NULL, country will be auto-detected. + dl_path = NULL, # optional argument to provide path to download data to. By + # default, data is downloaded to a subfolder 'worldclim/' in the working + # directory. + progress = TRUE +) { + # Check packages + have_pkg_check(c( + "sf", + "geodata", + "terra" + )) + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[WorldClim Download] covariates either not listed or one or more are", + " invalid. Please provide covariate names as listed under", + " `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + # Create download path if it doesn't already exist. + if (is.null(dl_path) & !dir.exists("./worldclim")) { + dir.create("./worldclim", recursive = TRUE) + } + + if (!is.null(dl_path) & !dir.exists(paste0(dl_path, "/worldclim"))) { + dir.create(paste0(dl_path, "/worldclim"), recursive = TRUE) + } + + # Create index for climate variables from covariate request. + clim_vars <- gsub( + pattern = "worldclim_", + replacement = "", + grep("worldclim_", covariates, value = TRUE) + ) + + # Unless user specified, attempt to automatically detect the countries for + # which data must be downloaded. + if (is.null(countries)) { + # Check for additional package necessary in this workflow. + have_pkg_check("spData") + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[WorldClim Download] downloading requires an sf or terra object as", + " input in this workflow. Consider using `data_fmt` to conform", + " data first.", + call. = FALSE + ) + } + + # For sf input, compare to country data from spData package. + if (input_fmt$type == "sf") { + world <- sf::st_read( + system.file("shapes/world.gpkg", package = "spData"), + quiet = TRUE + ) + + data <- sf::st_transform(data, sf::st_crs(world)) + + world <- suppressWarnings(sf::st_intersection(world, data)) + + countries <- unique(world$name_long) + } + + # For terra input, convert to sf and compare to country data from spData + # package. + if (input_fmt$type == "terra") { + data <- sf::st_as_sf(data) + + world <- sf::st_read( + system.file("shapes/world.gpkg", package = "spData"), + quiet = TRUE + ) + + data <- sf::st_transform(data, sf::st_crs(world)) + + world <- suppressWarnings(sf::st_intersection(world, data)) + + countries <- unique(world$name_long) + } + } + + # Open list to store downloaded rasters. + clim <- list() + + # Loop through each requested WorldClim variable, download. + for (i in clim_vars) { + # Loop through each country requested or detected. + for (j in countries) { + # Pull country codes table to handle ISO3 codes. + country_code <- geodata::country_codes() + + # Check if provided country is an ISO3 code, if so, convert. + if (!(j %in% country_code$ISO3)) { + country_code <- country_code$ISO3[country_code$NAME == j] + } else { + country_code <- j + } + + # If file doesn't already exist, call geodata::worldclim_country() to + # download data. + if ( + !file.exists(ifelse( + is.null(dl_path), + paste0( + "./worldclim/climate/wc2.1_country/", + country_code, + "_wc2.1_30s_", + i, + ".tif" + ), + paste0( + dl_path, + "/worldclim/climate/wc2.1_country/", + country_code, + "_wc2.1_30s_", + i, + ".tif" + ) + )) + ) { + message( + "[Worldclim Download] downloading WorldClim '", + i, + "' data for ", + j, + "." + ) + + clim[[i]][[j]] <- geodata::worldclim_country( + var = i, + country = j, + path = ifelse( + is.null(dl_path), + "./worldclim", + paste0(dl_path, "/worldclim") + ), + quiet = !progress + ) + + if (is.null(clim[[i]][[j]])) { + warning( + "[WorldClim Download] Download failed for ", + j, + " [", + i, + "].", + call. = FALSE + ) + } + } else { + clim[[i]][[j]] <- terra::rast(ifelse( + is.null(dl_path), + paste0( + "./worldclim/climate/wc2.1_country/", + country_code, + "_wc2.1_30s_", + i, + ".tif" + ), + paste0( + dl_path, + "/worldclim/climate/wc2.1_country/", + country_code, + "_wc2.1_30s_", + i, + ".tif" + ) + )) + } + } + + # Convert each variable's different country rasters to a SpatRasterCollection + # then merge into a single layer for each variable. + + if (!is.null(clim[[i]][[j]])) { + clim[[i]] <- terra::sprc(clim[[i]]) + + terra::terraOptions(progress = 0) + + if (length(clim_vars) == 1) { + clim <- terra::merge(clim[[i]]) + } else { + clim[[i]] <- terra::merge(clim[[i]]) + } + + terra::terraOptions(progress = 1) + } + } + + # Return WorldClim SpatRasters + return(clim) +} diff --git a/R/worldclim_extract.R b/R/worldclim_extract.R new file mode 100644 index 00000000..a760e926 --- /dev/null +++ b/R/worldclim_extract.R @@ -0,0 +1,574 @@ +#' Extract WorldClim Climate Data +#' +#' Extracts monthly WorldClim Monthly Climate Norms, averaged over 1970-2000, +#' from downloaded [WorldClim version 2.1](https://www.worldclim.org/data/worldclim21.html) +#' (Fick & Hijmans 2017). Several climate variables can be extracted with this +#' functions: minimum, maximum, and average temperature (°C), +#' precipitation (mm), solar radiation (kJ/m^2/day), and wind speed (m/s). +#' Data can be downloaded with [worldclim_download()] +#' +#' One (or multiple) climate variable(s) can be extracted by specifying the following +#' values to the `covariates` argument +#' - Minimum temperature: `worldclim_tmin` +#' - Maximum temperature: `worldclim_tmax` +#' - Average temperature: `worldclim_tavg` +#' - Precipitation: `worldclim_prec` +#' - Solar radiation: `wordclim_srad` +#' - Wind speed: `worldclim_wind` +#' +#' @inheritParams worldclim_download +#' +#' @param data An `sf` 'POINT' or 'POLYGON' object, or `terra` 'points' or +#' 'polygons' object. +#' @param worldclim_data `terra SpatRaster` or `list` of `terra SpatRaster`s if +#' extracting multiple climate variables. We recommend using +#' [worldclim_download()] to ensure that all data necessary to match your +#' input data are captured. Direct output of [worldclim_download()] can be +#' supplied here. +#' @param covariates Character, vector if multiple climate data types desired. By +#' default, extracts WorldClim average temperature data. +#' @param site_name Character. Optional argument to provide the name of the +#' column containing site names if not contained within the BMDE column +#' `SurveyAreaIdentifier`. Can be left `NULL` and still function properly if +#' originally specified in a call to [data_fmt()] or [worldclim_download()]. +#' @param date_month Character. Optional argument to provide the name of the +#' column containing month data if not contained within the BMDE column +#' `survey_month`. Can be left `NULL` and still function properly if originally +#' specified in a call to [data_fmt()] or [worldclim_download()]. +#' @param dl_path Character. Path to downloaded files. Only needed if `retain = TRUE` +#' and custom download filepath used. +#' @param retain Logical. Should WorldClim data files be kept after extraction? If +#' `FALSE`, files will be deleted. +#' +#' @returns For sf 'POINT' or terra 'points' input data, original data with +#' numeric column(s) appended containing the climate data value(s) at each point. +#' +#' For sf 'POLYGON' or terra 'polygons' input data, original data with numeric +#' column(s) appended containing the mean climate data value(s) within each polygon. +#' +#' @examples +#' # Convert included test data on black-capped chickadees to sf POINT object +#' bcch <- sf::st_as_sf( +#' bcch, +#' coords = c("longitude", "latitude"), +#' crs = 4326 +#' ) +#' +#' # Load WorldClim data +#' wind <- worldclim_download(data = bcch, +#' covariates = "worldclim_wind", +#' progress = FALSE) +#' +#' # Extract average temperature +#' output <- worldclim_extract(data = bcch, +#' worldclim_data = wind, +#' covariates = "worldclim_wind", +#' retain = FALSE) +#' +#' @seealso [worldclim_download()] which can be used to download WorldClim data files. +#' +#' [nc_covariates_merge()] to merge extracted +#' covariate data into data originally provided to the `data` argument of +#' [data_fmt()]. +#' +#' @references Fick, S.E. and R.J. Hijmans, 2017. WorldClim 2: new 1km spatial resolution climate surfaces for global land areas. International Journal of Climatology 37 (12): 4302-4315. +#' +#' @export + +# Function to extract WorldClim data from provided WorldClim SpatRaster(s). +worldclim_extract <- function( + data, + worldclim_data, # named list containing SpatRaster containing + # WorldClim data, downloadable via WorldClim_download(). Names derived from + # WorldClim variable names ("tmin", "tmax", "tavg", "prec", "wind", "vapr", + # "bio"). + covariates = "worldclim_tavg", # Other options listed in nc_covariate_table(). + site_name = NULL, # optional argument to provide column name containing site + # names. Default is assumed to be the BMDE column 'SurveyAreaIdentifier'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + date_month = NULL, # optional argument to provide column name containing month + # data. Default is assumed to be the BMDE column 'survey_month'. Can + # be left NULL and still function properly if originally specified in a call + # to data_fmt(). + dl_path = NULL, # Path to downloaded files. Only needed if retain = TRUE and + # custom dl_path is used. + retain = TRUE # Should data files be kept after extraction? +) { + # Check packages + have_pkg_check(c( + "sf", + "terra" + )) + + # Catch misspecified covariates. Return error if any exist. + if (FALSE %in% (covariates %in% nc_covariate_table()$covariate_name)) { + stop( + "[WorldClim Extraction] covariates either not listed or one or more are", + " invalid. Please provide covariate names as listed under", + " `covariate_name` in nc_covariate_table().", + call. = FALSE + ) + } + + # If no WorldClim rasters are provided, return error. + if (missing(worldclim_data)) { + stop( + "[WorldClim Extraction] no WorldClim rasters provided to extract from.", + " Please provide a list of the necessary rasters. Data can be downloaded", + " using worldclim_download().", + call. = FALSE + ) + } + + if ( + !(((inherits(worldclim_data, "list")) & + (inherits(worldclim_data[[1]], "SpatRaster"))) | + inherits(worldclim_data, "SpatRaster")) + ) { + stop( + "[WorldClim Extraction] no WorldClim rasters provided to extract from.", + " Please provide a list of the necessary rasters. Data can be downloaded", + " using worldclim_download().", + call. = FALSE + ) + } + + # Check data is in the desired format. + input_fmt <- covariate_fmt_check(data) + + # If not an sf or terra object, return error and point towards data_fmt(). + if (input_fmt$type == "data.frame") { + stop( + "[WorldClim Extraction] downloading requires an sf or terra object as", + " input in this workflow. Consider using `data_fmt` to conform data", + " first.", + call. = FALSE + ) + } + + # Store attributes so they don't get lost. + + # List potential attributes. + attr_names <- c( + "site_name", + "coord_lon", + "coord_lat", + "date_year", + "date_month", + "date_day", + "date_ordinal", + "date_lubridate", + "crs" + ) + + # If any potential attribute names are present in the data attributes, + # store. + if (length(attr_names[attr_names %in% names(attributes(data))]) > 0) { + attrs <- attributes(data)[attr_names[ + attr_names %in% names(attributes(data)) + ]] + } + + # Check whether information on alternate column names has been stored + # in the attributes by data_fmt(). However, prioritize alternate column names + # specified in the current call. + if (is.null(site_name) & !is.null(attr(data, "site_name"))) { + site_name <- attr(data, "site_name") + } + + if (is.null(date_month) & !is.null(attr(data, "date_month"))) { + date_month <- attr(data, "date_month") + } + + # Check that all specified column names are present in the data. + specified_cols <- c(site_name, date_month) + + # Remove any that haven't been specified. + specified_cols <- specified_cols[!is.null(specified_cols)] + + data_cols <- names(data) + + # Compare to columns present in data. Return error if any specified columns + # are not present. 'if' wrapper needed for when alternate column names exist + # in the attributes of the data, but conversion of those columns to + # standardized names has already taken place in data_fmt(). + if ( + !(all(specified_cols %in% data_cols)) & + (!("SurveyAreaIdentifier" %in% data_cols) | + !("survey_month" %in% data_cols)) + ) { + stop( + "[WorldClim Extraction] some specified columns missing from the data: ", + stringr::str_flatten_comma(specified_cols[ + !(specified_cols %in% data_cols) + ]), + ". Use arguments to specify alternate column names if using data that diverges from naturecounts default column names.", + call. = FALSE + ) + } + + # Conform specified columns to naturecounts default column names. Calls to + # st_sf() needed to avoid sf specific issue with attributes. + if (!is.null(site_name) & !("SurveyAreaIdentifier" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "SurveyAreaIdentifier" = !!site_name) + } + + data$SurveyAreaIdentifier <- as.character(data$SurveyAreaIdentifier) + + if (!is.null(date_month) & !("survey_month" %in% data_cols)) { + if (input_fmt$type == "sf") { + data <- sf::st_sf(data) + } + + data <- dplyr::rename(data, "survey_month" = !!date_month) + } + + # Use month_check() to validate month data. + month_corr <- c() + + for (i in 1:length(data$survey_month)) { + month_corr[i] <- month_check(data$survey_month[i]) + } + + data$survey_month <- month_corr + + data$survey_month <- as.numeric(data$survey_month) + + # For sf objects, create area of interest to crop WorldClim rasters to to + # reduce memory load. + if (input_fmt$type == "sf") { + # Check whether sf object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "POINT", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_transform("ESRI:102001") %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } else { + study_area <- sf::st_bbox(data) %>% + sf::st_as_sfc() %>% + sf::st_buffer(20000) %>% # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + terra::vect() + } + } + + # For terra objects, create area of interest to crop WorldClim rasters to to + # reduce memory load. Convert to sf. + if (input_fmt$type == "terra") { + # Check whether terra object is buffered or not to determine extraction + # procedure down the line. + buffered <- ifelse(input_fmt$geometry == "points", FALSE, TRUE) + + # Store original CRS so data can be returned as provided. + orig_crs <- terra::crs(data) + + # Convert to CRS used in this workflow if not already in that CRS, create + # bounding box polygon with generous buffer to ensure data isn't missed. + if (!(orig_crs == terra::crs("ESRI:102001"))) { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::project("ESRI:102001") %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } else { + study_area <- terra::ext(data) %>% + terra::vect(crs = orig_crs) %>% + terra::buffer(20000) # Arbitrarily high number selected (20km). + # Maybe unnecessary, could reduce download size. + } + + # Convert to sf object for use in workflow. + data <- sf::st_as_sf(data) + } + + # If buffered, check for packages necessary in buffered workflow. + if (buffered == TRUE) { + have_pkg_check("exactextractr") + } + + clim <- worldclim_data + + if (inherits(worldclim_data, "list")) { + loop <- names(worldclim_data) + } else if (inherits(worldclim_data, "SpatRaster")) { + loop <- gsub( + pattern = "worldclim_", + replacement = "", + grep("worldclim_", covariates, value = TRUE) + ) + } + + terra::terraOptions(progress = 0) + + # Loop through each requested WorldClim variable. + for (i in loop) { + message("[WorldClim Extraction] extracting WorldClim ", i, ".") + if (length(loop) > 1) { + source <- clim[[i]] + } else { + source <- clim + } + # Loop through each site and extract. + for (j in unique(data$SurveyAreaIdentifier)) { + # Create temporary object with only point/buffer for site i. + tmp <- data %>% + dplyr::filter(.data$SurveyAreaIdentifier == j) %>% + dplyr::select("SurveyAreaIdentifier", "survey_month", "geometry") %>% + dplyr::distinct() %>% + sf::st_transform(terra::crs(source)) + + # Loop through each month site i was visited, extract. + for (k in unique(data$survey_month[data$SurveyAreaIdentifier == j])) { + # Use variable name and month to pull correct layer from WorldClim + # raster. + + layername <- paste0( + substr( + names(source)[1], + start = 1, + stop = nchar(names(source)[1]) - 1 + ), + k + ) + + # In the first iteration of the loop, check that the site falls within + # or is only partially covered by the spatial extent of the provided + # WorldClim rasters. If not, warn. + if ( + which( + unique(data$survey_month[data$SurveyAreaIdentifier == j]) == k + ) == + 1 + ) { + if ( + all(is.na(terra::extract(source[[layername]], tmp)[, layername])) + ) { + warning( + "[WorldClim (", + i, + ") Extraction] site ", + j, + " falls outside of the spatial extent of the WorldClim rasters", + " provided. No value will be returned.", + call. = FALSE + ) + } else if ( + TRUE %in% + is.na(terra::extract(source[[layername]], tmp)[, layername]) + ) { + warning( + "[WorldClim (", + i, + ") Extraction] site ", + j, + "'s buffered area is only partially contained by the spatial", + " extent of the WorldClim rasters provided. Returned mean ", + i, + " value will be derived from the available values.", + call. = FALSE + ) + + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- exactextractr::exact_extract( + x = source[[layername]], + y = tmp %>% dplyr::filter(.data$survey_month == k), + fun = "mean" + ) + } else { + # If no issues with coverage, proceed to extract. If buffered, + # extract using exactextractr::exact_extract(). If not, extract + # using terra::extract(). + if (buffered == TRUE) { + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- exactextractr::exact_extract( + x = source[[layername]], + y = tmp %>% dplyr::filter(.data$survey_month == k), + fun = "mean" + ) + } else { + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- terra::extract( + x = source[[layername]], + y = tmp %>% dplyr::filter(.data$survey_month == k), + fun = "mean", + na.rm = TRUE + )[, layername] + } + } + } else { + # For all iterations after the first, extract if covered by the + # WorldClim rasters. Issue no further warnings if not. + if ( + all(is.na(terra::extract(source[[layername]], tmp)[, layername])) + ) { + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- NA + } else { + if (buffered == TRUE) { + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- exactextractr::exact_extract( + x = source[[layername]], + y = tmp %>% dplyr::filter(.data$survey_month == k), + fun = "mean" + ) + } else { + data[ + data$SurveyAreaIdentifier == j & data$survey_month == k, + i + ] <- terra::extract( + x = source[[layername]], + y = tmp %>% dplyr::filter(.data$survey_month == k), + fun = "mean", + na.rm = TRUE + )[, layername] + } + } + } + } + } + + terra::terraOptions(progress = 1) + + # Code to grab nearest raster value for sites outside of raster coverage. + # Not sure whether to keep this since we are warning users about these sites + # and saying nothing will be returned. Maybe keep as an option + # (nearest = TRUE)? + # if (TRUE %in% is.na(data[, i])) { + # for (j in unique(data$SurveyAreaIdentifier[is.na(data[, i])])) { + # for (k in unique(data$survey_month[data$SurveyAreaIdentifier == j])) { + # layername <- paste0( + # substr( + # names(clim[[i]])[1], + # start = 1, + # stop = nchar(names(clim[[i]])[1]) - 1 + # ), + # k + # ) + # + # tmp <- data %>% + # dplyr::filter(SurveyAreaIdentifier == j) %>% + # dplyr::select(SurveyAreaIdentifier, survey_month, geometry) %>% + # dplyr::distinct() %>% + # sf::st_transform(terra::crs(clim[[i]])) + # + # if ( + # terra::is.related( + # clim[[i]], + # terra::vect(tmp), + # relation = "intersects" + # ) + # ) { + # if ( + # which( + # unique(data$SurveyAreaIdentifier[is.na( + # data$SurveyAreaIdentifier + # )]) == + # j + # ) == + # 1 + # ) { + # warning( + # paste0( + # "[WorldClim (", + # i, + # ") Extraction] some points are close to shore, and so fall outside of raster coverage. For these cells, the nearest cell value has been used." + # ), + # call. = FALSE + # ) + # } + # + # tmp <- data %>% + # dplyr::filter(SurveyAreaIdentifier == j, survey_month == k) %>% + # dplyr::select(SurveyAreaIdentifier, survey_month, geometry) %>% + # dplyr::distinct() %>% + # sf::st_buffer(2500) %>% + # sf::st_transform(terra::crs(clim[[i]])) + # + # clim_crop <- terra::crop( + # clim[[i]][[layername]], + # terra::vect(tmp) + # ) %>% + # terra::as.points() + # + # data[ + # data$SurveyAreaIdentifier == j & data$survey_month == k, + # i + # ] <- terra::values(clim_crop[ + # terra::nearest(terra::vect(tmp), clim_crop)$to_id + # ]) + # } + # } + # } + # } + } + + # Check if attributes were found and stored from input data. If they were + # found reattach. + if (exists("attrs")) { + # Reattach attributes + + attributes(data)[names(attrs)] <- attrs + } + + # Reinstate user's specified column names. + if (!is.null(site_name)) { + names(data)[names(data) == "SurveyAreaIdentifier"] <- site_name + } + + if (!is.null(date_month)) { + names(data)[names(data) == "survey_month"] <- date_month + } + + # Remove WorldClim files if requested. + if (retain == FALSE) { + # Check that if default directory doesn't exist an alterate has been + # specified. + if (is.null(dl_path) & !dir.exists("./worldclim")) { + warning( + "[WorldClim Extraction] unable to find default WorldClim", + " directory and no alternate specified using dl_path argument", + ". No files will be removed.", + call. = FALSE + ) + } else { + message(paste0("[WorldClim Extraction] task complete. Removing files.")) + + unlink( + ifelse( + is.null(dl_path), + "./worldclim/climate", + paste0(dl_path, "/worldclim/climate") + ), + recursive = TRUE + ) + } + } + + # Return input data with appended WorldClim columns. + return(data) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index ae328415..bab776d2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -51,6 +51,27 @@ reference: contents: - cosewic_ranges - cosewic_plot +- title: Covariate Download and Extraction + desc: Functions for formatting data for use in covariate download and extraction, as well as for downloading and extracting covariate data + contents: + - nc_covariate_table + - data_fmt + - data_buff + - landcover_download + - landcover_extract + - vegetation_download + - vegetation_extract + - elevation_download + - elevation_extract + - worldclim_download + - worldclim_extract + - scanfi_download + - scanfi_extract + - daymet_request + - daymet_check + - daymet_download + - daymet_extract + - nc_covariates_merge - title: Data desc: Included example data sets contents: @@ -86,6 +107,16 @@ articles: contents: - '`articles/3.1-ZeroFilling`' - '`articles/3.2-AuxiliaryTables`' +- title: The NatureCounts Covariate Download and Extraction Tutorial + desc: An R guide to help download and extract covariate data using naturecounts functions. + contents: + - '`articles/4.1-CovariateFormatting`' + - '`articles/4.2-LandCover`' + - '`articles/4.3-Vegetation`' + - '`articles/4.4-Elevation`' + - '`articles/4.5-WorldClim`' + - '`articles/4.6-SCANFI`' + - '`articles/4.7-Daymet`' - title: Additional Tutorials desc: How-to articles describing common tasks contents: @@ -107,5 +138,4 @@ articles: - title: internal desc: Internal articles for reference contents: - - '`articles/test`' - \ No newline at end of file + - '`articles/test`' \ No newline at end of file diff --git a/man/data_buff.Rd b/man/data_buff.Rd new file mode 100644 index 00000000..ff1bbed6 --- /dev/null +++ b/man/data_buff.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_buff.R +\name{data_buff} +\alias{data_buff} +\title{Buffer Data for Covariate Download and Extraction} +\usage{ +data_buff(data, buffer = TRUE, buffer_distance = 500, buffer_units = "m") +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{buffer}{Logical. Should the provided data be buffered? \code{TRUE} by +default.} + +\item{buffer_distance}{Numeric. Distance that the provided points or +polygons should be buffered by. 500 by default.} + +\item{buffer_units}{Character. Units of provided distance. Options are "m" +(metres), "km" (kilometers), "ft" (feet), "yd" (yards), "mi" (miles), or +"naut_mi" (nautical miles). Metres ("m") by default.} +} +\value{ +Either \code{sf} 'POLYGON' or \code{terra} 'polygons' (depending on format of +input data) with original coordinate reference system and columns +preserved, and all geometries buffered by requested distance. +} +\description{ +Buffers input data by a specifiable distance. +} +\details{ +If input data is an \code{sf} 'POINT' object or a \code{terra} 'points' object, points +are buffered to a circle with the radius specified in \code{buffer_distance} (500 +m by default). If input is an \code{sf} 'POLYGON' object or a \code{terra} 'polygons' +object, the polygon is buffered on all sides by the distance specified in +\code{buffer_distance} (500 m by default). +} +\examples{ +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Buffer by 1 km +output <- data_buff(bcch, + buffer = TRUE, + buffer_distance = 1, + buffer_units = "km" +) + +} +\seealso{ +\code{\link[=data_fmt]{data_fmt()}} for a convenient way to convert \code{data.frame} data to a +compatible \code{sf} or \code{terra} object. + +\code{\link[sf:geos_unary]{sf::st_buffer()}} which this function wraps. +} diff --git a/man/data_fmt.Rd b/man/data_fmt.Rd new file mode 100644 index 00000000..c461ea9e --- /dev/null +++ b/man/data_fmt.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_fmt.R +\name{data_fmt} +\alias{data_fmt} +\title{Format Data for Covariate Download and Extraction} +\usage{ +data_fmt( + data, + site_name = NULL, + coord_lon = NULL, + coord_lat = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + date_lubridate = NULL, + date_ordinal = NULL, + crs = NULL +) +} +\arguments{ +\item{data}{Data frame, \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' +or 'polygons' object containing observations associated with coordinate and +date data.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}.} + +\item{coord_lon}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{longitude}.} + +\item{coord_lat}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{latitude}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day of month data if not contained within the BMDE column +\code{survey_day}.} + +\item{date_lubridate}{Character. Optional argument to provide the name of a +column containing date data in \code{lubridate} formats.} + +\item{date_ordinal}{Character. Optional argument to provide the name of a +column containing date data in ordinal format.} + +\item{crs}{Character. Optional argument to provide the coordinate reference +system of the provided data. Only required when providing a data frame +containing data not using the typical GPS latitude/longitude +\href{https://epsg.io/4326}{WGS84} (\code{EPSG:4326}) coordinate reference system, or +\code{sf}/ \code{terra} objects without coordinate reference systems embedded.} +} +\value{ +If \code{data.frame}, \code{sf} "POINT", or \code{terra} "points" data provided, +\code{sf} "POINT" object. If \code{sf} "POLYGON" or \code{terra} "polygons" data provided, +\code{sf} "POLYGON" object. Returned object contains a row for each unique +site-date combination in the provided data, and is provided in the \href{https://epsg.io/102001}{NAD 1983 Albers Canada} (\code{EPSG:102001}) coordinate reference system with the +following columns. +\itemize{ +\item SurveyAreaIdentifier - character. Site names, or if missing in original +data, filled site names for use in later functions. +\item latitude - numeric. Y-coordinate in NAD 1983 Albers Canada +(\code{EPSG:102001}) coordinate reference system. +\item longitude - numeric. X-coordinate in NAD 1983 Albers Canada +(\code{EPSG:102001}) coordinate reference system. +\item survey_year - numeric. Observation year. +\item survey_month - numeric. Observation month. +\item survey_day - numeric. Observation day (of month). +\item geometry - \code{sf} geometry column. +} +} +\description{ +This function accepts a variety of input data and conforms it to a +standardized format for use in the various covariate download and extraction +functions available in the naturecounts R package. Users are not required to +use this function before using covariate download and extraction functions, +but may avoid some finnicky work by doing so. +} +\examples{ + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Format +output <- data_fmt(bcch) + +} +\seealso{ +\code{\link[sf:st_as_sf]{sf::st_as_sf()}} and \code{\link[terra:vect]{terra::vect()}} which this function wraps. + +\code{\link[=data_buff]{data_buff()}} to buffer data points by a specified distance to measure +covariates at desired spatial scales. +} diff --git a/man/daymet_check.Rd b/man/daymet_check.Rd new file mode 100644 index 00000000..7986d81b --- /dev/null +++ b/man/daymet_check.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/daymet_check.R +\name{daymet_check} +\alias{daymet_check} +\title{Check the status of Daymet Data Requests} +\usage{ +daymet_check(daymet_reqs, ed_username, verbose = TRUE) +} +\arguments{ +\item{daymet_reqs}{\code{data.frame}. A \code{data.frame} with columns 1) +\code{request_name} containing AppEEARS request names, 2) \code{request_id} +containing AppEEARS request IDs, and optionally 3) \code{date} containing the +date for which the associated request is downloading data for, or a +filepath to a \code{.rds} file containing such data. The direct output of +\code{\link[=daymet_request]{daymet_request()}} can be supplied here.} + +\item{ed_username}{Character. The username associated with your EarthData account.} + +\item{verbose}{Logical. Should messages be displayed?} +} +\value{ +A \code{data.frame} containing request status information. +} +\description{ +Returns status information on requests submitted through \code{\link[=daymet_request]{daymet_request()}}. +Requests are submitted to the NASA AppEEARS service, requiring an EarthData +account to be made. This can be done at the following link: \href{https://urs.earthdata.nasa.gov/users/new}{register for an EarthData account}. +} +\details{ +Status checks are facilitated by a call to \code{\link[appeears:rs_list_task]{appeears::rs_list_task()}}. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Grab data from a single year +bcch <- bcch[bcch$survey_year == 2011,] + +# Enter EarthData username +ed_username <- "your EarthData username" + +# Submit Daymet requests +requests <- daymet_request(data = bcch, + covariates = "daymet_prcp", + ed_username = ed_username) + +# Check status +status_check <- daymet_check(daymet_reqs = requests, + ed_username = ed_username) + +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=daymet_request]{daymet_request()}} which can be used to submit requests for Dayment +data. + +\code{\link[=daymet_download]{daymet_download()}} to execute downloads once requests have been +submitted and are complete. + +\code{\link[=daymet_extract]{daymet_extract()}} which can be used to extract data +from downloaded Daymet files. +} diff --git a/man/daymet_download.Rd b/man/daymet_download.Rd new file mode 100644 index 00000000..7dd19b81 --- /dev/null +++ b/man/daymet_download.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/daymet_download.R +\name{daymet_download} +\alias{daymet_download} +\title{Download Data from Daymet.} +\usage{ +daymet_download(daymet_reqs, ed_username, dl_path = NULL, verbose = TRUE) +} +\arguments{ +\item{daymet_reqs}{\code{data.frame}. A \code{data.frame} with columns 1) +\code{request_name} containing AppEEARS request names, 2) \code{request_id} +containing AppEEARS request IDs, and optionally 3) \code{date} containing the +date for which the associated request is downloading data for, or a +filepath to a \code{.rds} file containing such data. The direct output of +\code{\link[=daymet_request]{daymet_request()}} can be supplied here.} + +\item{ed_username}{Character. The username associated with your EarthData account.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{scanfi/} in the working +directory.} + +\item{verbose}{Logical. Should messages be displayed?} +} +\value{ +A \code{data.frame} with three columns: 1) \code{request_name} containing +AppEEARS request names, 2) \code{request_id} containing AppEEARS request IDs, +and 3) \code{date} containing the date for which the associated request is +downloading data for. +} +\description{ +Downloads all available variables from the \href{https://daymet.ornl.gov/}{Daymet} +from request data either fetched via \code{\link[=daymet_request]{daymet_request()}} or supplied by the +user. All variables are available at a daily resolution since 1980 in +North America and Hawaii, and since 1950 in Puerto +Rico, and at a ~ 1 km spatial resolution. This data is retreived via the NASA +AppEEARS service, requiring an EarthData account to be made. This can be +done at the following link: \href{https://urs.earthdata.nasa.gov/users/new}{register for an EarthData account}. Users should be aware +that since these data are at a daily resolution a large number of files will +be downloaded for datasets with many dates. +} +\details{ +One (or multiple) Daymet variable(s) can be downloaded by specifying the following +values to the \code{covariates} argument in \code{\link[=daymet_request]{daymet_request()}}: +\itemize{ +\item Day length (s/day): \code{daymet_dayl} +\item Precipitation (mm/day): \code{daymet_prcp} +\item Shortwave radiation (W/m^2): \code{dayment_srad} +\item Snow water equivalent (kg/m^2): \code{daymet_swe} +\item Maximum air temperature (°C): \code{daymet_tmax} +\item Minimum air temperature (°C): \code{daymet_tmin} +\item Water vapor pressure (Pa): \code{daymet_vp} +} + +Downloads are facilitated by a call to \code{\link[appeears:rs_transfer]{appeears::rs_transfer()}}. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Grab data from a single year +bcch <- bcch[bcch$survey_year == 2011,] + +# Enter EarthData username +ed_username <- "your EarthData username" + +# Submit Daymet requests +requests <- daymet_request(data = bcch, + covariates = "daymet_prcp", + ed_username = ed_username) +# Once email is received confirming that request has been processed, execute +# download! +downloaded <- daymet_download(daymet_reqs = requests, + covariates = "daymet_prcp", + ed_username = ed_username) + +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=daymet_request]{daymet_request()}} which can be used to submit requests for Dayment +data. + +\code{\link[=daymet_check]{daymet_check()}} to check the status of existing requests. + +\code{\link[=daymet_extract]{daymet_extract()}} which can be used to extract data from downloaded +Daymet files. +} diff --git a/man/daymet_extract.Rd b/man/daymet_extract.Rd new file mode 100644 index 00000000..3c9dfb38 --- /dev/null +++ b/man/daymet_extract.Rd @@ -0,0 +1,139 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/daymet_extract.R +\name{daymet_extract} +\alias{daymet_extract} +\title{Extract Data from Daymet.} +\usage{ +daymet_extract( + data, + daymet_reqs, + covariates = "daymet_prcp", + site_name = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + dl_path = NULL, + verbose = TRUE, + retain = TRUE +) +} +\arguments{ +\item{data}{A \code{data.frame}, \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' +or 'polygons' object containing columns with the year, month, and day an +observation was made either named the BMDE defaults \code{survey_year}, \code{survey_month} +, and \code{survey_day} respectively or another name specified in arguments +\code{date_year}, \code{date_month}, and/or \code{date_day}.} + +\item{daymet_reqs}{\code{data.frame}. A \code{data.frame} with columns 1) +\code{request_name} containing AppEEARS request names, 2) \code{request_id} +containing AppEEARS request IDs, and optionally 3) \code{date} containing the +date for which the associated request is downloading data for, or a +filepath to a \code{.rds} file containing such data. The direct output of +\code{\link[=daymet_request]{daymet_request()}} can be supplied here.} + +\item{covariates}{Character, vector if multiple Daymet data types desired. By +default, extracts Daymet precipitation data.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=daymet_download]{daymet_download()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=daymet_download]{daymet_download()}}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=daymet_download]{daymet_download()}}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day-of-month (i.e., a number from 1 to 31) data if not +contained within the BMDE column \code{survey_day}. Can be left \code{NULL} and still +function properly if originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or +\code{\link[=daymet_download]{daymet_download()}}.} + +\item{dl_path}{Character. Optional argument to provide path to downloaded data. +By default, data is downloaded to a subfolder \verb{daymet/} in the working directory.} + +\item{verbose}{Logical. Should messages be displayed?} + +\item{retain}{Logical. Should Daymet data files be kept after extraction? If +\code{FALSE}, files will be deleted.} +} +\value{ +For sf 'POINT' or terra 'points' input data, original data with +column(s) appended containing the Daymet data value(s) at each point. + +For sf 'POLYGON' or terra 'polygons' input data, original data with column(s) +appended containing the mean Daymet data value(s) within each polygon. +} +\description{ +Extracts all available variables from \href{https://daymet.ornl.gov/}{Daymet} and +matches them to input observation data. All variables are available at a daily +resolution since 1980 in North America and Hawaii, and since 1950 in Puerto +Rico, and at a ~ 1 km spatial resolution. This data can be requested from the +NASA AppEEARS service using \code{\link[=daymet_request]{daymet_request()}} and downloaded using +\code{\link[=daymet_download]{daymet_download()}}. +} +\details{ +One (or multiple) Daymet variable(s) can be extracted by specifying the following +values to the \code{covariates} argument. The appropriate variables must be available +in the AppEEARS request supplied to \code{daymet_reqs}. Requests can be submitted +via \code{\link[=daymet_request]{daymet_request()}} and downloaded via \code{\link[=daymet_download]{daymet_download()}}: +\itemize{ +\item Day length (s/day): \code{daymet_dayl} +\item Precipitation (mm/day): \code{daymet_prcp} +\item Shortwave radiation (W/m^2): \code{dayment_srad} +\item Snow water equivalent (kg/m^2): \code{daymet_swe} +\item Maximum air temperature (°C): \code{daymet_tmax} +\item Minimum air temperature (°C): \code{daymet_tmin} +\item Water vapor pressure (Pa): \code{daymet_vp} +} +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Grab data from a single year +bcch <- bcch[bcch$survey_year == 2011,] + +# Enter EarthData username +ed_username <- "your EarthData username" + +# Submit Daymet requests +requests <- daymet_download(data = bcch, + covariates = "daymet_prcp", + ed_username = ed_username) + +# Once email is received confirming that request has been processed, execute +# download! +downloaded <- daymet_download(daymet_reqs = requests, + covariates = "daymet_prcp", + ed_username = ed_username) + +# Once download is complete, extract! +extracted <- daymet_extract(data = bcch, + daymet_reqs = requests, + covariates = "daymet_prcp") + +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=daymet_request]{daymet_request()}} which can be used to submit requests for Dayment +data. + +\code{\link[=daymet_download]{daymet_download()}} to execute downloads once requests have been +submitted and are complete. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/man/daymet_request.Rd b/man/daymet_request.Rd new file mode 100644 index 00000000..363c0d55 --- /dev/null +++ b/man/daymet_request.Rd @@ -0,0 +1,145 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/daymet_request.R +\name{daymet_request} +\alias{daymet_request} +\title{Submit Request for Daymet Data.} +\usage{ +daymet_request( + data, + covariates = "daymet_prcp", + ed_username, + request_name = NULL, + site_name = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + dl_path = NULL, + save = FALSE, + verbose = TRUE +) +} +\arguments{ +\item{data}{A \code{data.frame}, \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' +or 'polygons' object containing columns with the year, month, and day an +observation was made either named the BMDE defaults \code{survey_year}, \code{survey_month} +, and \code{survey_day} respectively or another name specified in arguments +\code{date_year}, \code{date_month}, and/or \code{date_day}.} + +\item{covariates}{Character, vector if multiple Daymet data types desired. By +default, downloads Daymet precipitation data.} + +\item{ed_username}{Character. The username associated with your EarthData account.} + +\item{request_name}{Character. Optional argument to provide informative name +for the AppEEARS request. This can make file management more intuitive for +the user.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day-of-month (i.e., a number from 1 to 31) data if not +contained within the BMDE column \code{survey_day}. Can be left \code{NULL} and still +function properly if originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}. +\code{survey_year}.} + +\item{dl_path}{Character. Optional argument to provide path to save request +information to. By default, data is downloaded to a subfolder \verb{daymet/} in +the working directory.} + +\item{save}{Logical. Should Daymet request ID information be saved externally +in a .rds file?} + +\item{verbose}{Logical. Should messages be displayed?} +} +\value{ +A \code{data.frame} with three columns: 1) \code{request_name} containing +AppEEARS request names, 2) \code{request_id} containing AppEEARS request IDs, +and 3) \code{date} containing the date for which the associated request is +downloading data for. +} +\description{ +Submits requests for all available variables from the +\href{https://daymet.ornl.gov/}{Daymet} at the spatial extent of provided input +observation data. All variables are available at a daily +resolution since 1980 in North America and Hawaii, and since 1950 in Puerto +Rico, and at a ~ 1 km spatial resolution. Requests are submitted to the NASA +AppEEARS service, requiring an EarthData account to be made. This can be +done at the following link: \href{https://urs.earthdata.nasa.gov/users/new}{register for an EarthData account}. +} +\details{ +One (or multiple) Daymet variable(s) can be requested by specifying the following +values to the \code{covariates} argument: +\itemize{ +\item Day length (s/day): \code{daymet_dayl} +\item Precipitation (mm/day): \code{daymet_prcp} +\item Shortwave radiation (W/m^2): \code{dayment_srad} +\item Snow water equivalent (kg/m^2): \code{daymet_swe} +\item Maximum air temperature (°C): \code{daymet_tmax} +\item Minimum air temperature (°C): \code{daymet_tmin} +\item Water vapor pressure (Pa): \code{daymet_vp} +} + +Due to API limitations, one request will be submitted for each day in \code{data}. +Unfortunately, AppEEARS automatically sends an email upon request receipt +and completion for each request, so for users with many observation dates, +we recommend considering setting rules in their email +client for handling these emails (address \href{mailto:appeears-noreply@nasa.gov}{appeears-noreply@nasa.gov}). + +To preserve request information in the event the R session ends, users can +choose to set \code{save = TRUE} and have request information saved externally +in a \code{.rds} file. Users can then provide the path to this file to +\code{\link[=daymet_check]{daymet_check()}}, \code{\link[=daymet_download]{daymet_download()}} or \code{\link[=daymet_extract]{daymet_extract()}} or read it +back into the R environment using \code{\link[base:readRDS]{base::readRDS()}}. + +Once requests are submitted, users can use \code{\link[=daymet_check]{daymet_check()}} to check the +status of their requests. In the author's experience, requests take from +1-24 hrs to process. Once requests are complete, downloads can be +executed with \code{\link[=daymet_download]{daymet_download()}}. + +Requests are facilitated by a call to \code{\link[appeears:rs_request]{appeears::rs_request()}}. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Grab data from a single year +bcch <- bcch[bcch$survey_year == 2011,] + +# Enter EarthData username +ed_username <- "your EarthData username" + +# Submit Daymet requests +requests <- daymet_request(data = bcch, + covariates = "daymet_prcp", + ed_username = ed_username) + +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=daymet_download]{daymet_download()}} to execute downloads once requests have been +submitted and are complete. + +\code{\link[=daymet_check]{daymet_check()}} to check the status of existing +requests. + +\code{\link[=daymet_extract]{daymet_extract()}} which can be used to extract data +from downloaded Daymet files. +} diff --git a/man/elevation_download.Rd b/man/elevation_download.Rd new file mode 100644 index 00000000..2c8ea4dd --- /dev/null +++ b/man/elevation_download.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/elevation_download.R +\name{elevation_download} +\alias{elevation_download} +\title{Load Terrain Tiles Elevation Data} +\usage{ +elevation_download( + data, + site_name = NULL, + negative_to_na = FALSE, + z = 7, + dl_path = NULL, + progress = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{negative_to_na}{Logical. Should negative elevation values be turned into +\code{NA}? If \code{FALSE}, check the outputted rasters for unrealistically large negative +values as these may instead represent missing data. For coastal areas, negative +elevation values may represent bathymetry (i.e. sea depth).} + +\item{z}{Numeric. Zoom level to fetch, determining the resulting spatial +resolution of downloaded elevation data. More information can be found +\href{https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-the-ground-resolution}{here}.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{TerrainTiles/} in the working +directory.} + +\item{progress}{Logical. Should progress bars and download messages be displayed?} +} +\value{ +A \verb{terra SpatRaster} in the projection of the data supplied to the \code{data} +argument, covering the bounding box of the supplied data. +} +\description{ +Loads \href{https://github.com/tilezen/joerd/tree/master/docs}{Mapzen Terrain Tiles elevation data}, +delivered at varying spatial resolutions. This data is open access via \href{https://registry.opendata.aws/terrain-tiles/}{Amazon Web Services}, +and is a global composite of a variety of \href{https://github.com/tilezen/joerd/blob/master/docs/data-sources.md}{data sources}. +Data is loaded into the R environment, and is not permanently downloaded onto +the user's operating system. +} +\details{ +Users should be conscious of the final spatial resolution of their elevation data, +as this varies by latitude and zoom level. This can be accessed using +\code{\link[terra:dimensions]{terra::res()}}. + +Downloads are facilitated by a call to \code{\link[elevatr:get_elev_raster]{elevatr::get_elev_raster()}}. +} +\examples{ +# Convert included, test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Load Terrain Tiles data +output <- elevation_download(data = bcch) + +} +\seealso{ +\code{\link[elevatr:get_elev_raster]{elevatr::get_elev_raster()}} which this function wraps. + +\code{\link[=elevation_extract]{elevation_extract()}} +which can be used to extract data from loaded elevation data files. +} diff --git a/man/elevation_extract.Rd b/man/elevation_extract.Rd new file mode 100644 index 00000000..86551f88 --- /dev/null +++ b/man/elevation_extract.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/elevation_extract.R +\name{elevation_extract} +\alias{elevation_extract} +\title{Extract Terrain Tiles Elevation Data} +\usage{ +elevation_extract(data, elevation_data, site_name = NULL) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{elevation_data}{\verb{terra SpatRaster}. Terrain Tiles elevation data. We recommend using +\code{\link[=elevation_download]{elevation_download()}} to ensure that all data necessary to match your +input data are captured. Direct output of \code{\link[=elevation_download]{elevation_download()}} can be +supplied here.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=elevation_download]{elevation_download()}}.} +} +\value{ +For sf 'POINT' or terra 'points' input data, original data with +numeric column \code{elevation} appended containing the elevation value (metres +above sea level) at each point. + +For sf 'POLYGON' or terra 'polygons' input data, original data with numeric +column \code{elevation} appended containing the mean elevation value (metres above +sea level) within each polygon. +} +\description{ +Extracts \href{https://github.com/tilezen/joerd/tree/master/docs}{Mapzen Terrain Tiles elevation data} +from a \verb{terra SpatRaster}, as delivered by \code{\link[=elevation_download]{elevation_download()}}. +} +\details{ +Users should be conscious of the final spatial resolution of their elevation data, +as this varies by latitude and zoom level specified in \code{\link[=elevation_download]{elevation_download()}}. +This can be accessed using \code{\link[terra:dimensions]{terra::res()}}. +} +\examples{ +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Load Terrain Tiles data +elev <- elevation_download(data = bcch) + +# Extract Terrain Tiles data +output <- elevation_extract(data = bcch, elevation_data = elev) + +} +\seealso{ +\code{\link[=elevation_download]{elevation_download()}} which can be used to download data from +the MapZen Terrain Tiles database. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/man/landcover_download.Rd b/man/landcover_download.Rd new file mode 100644 index 00000000..0ab5cc01 --- /dev/null +++ b/man/landcover_download.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/landcover_download.R +\name{landcover_download} +\alias{landcover_download} +\title{Download MODIS Landcover Data} +\usage{ +landcover_download( + data, + ed_email = NULL, + ed_transfer = TRUE, + site_name = NULL, + date_year = NULL, + dl_path = NULL, + progress = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{ed_email}{Character. The email address associated with your EarthData +account.} + +\item{ed_transfer}{Logical. Should data be downloaded from EarthData? +If \code{FALSE}, a vector containing the names of the files that would be +downloaded is returned.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{modis/} in the working +directory.} + +\item{progress}{Logical. Should progress bars for downloads be displayed?} +} +\value{ +If \code{ed_transfer = TRUE}, character vector containing +file-paths to downloaded MODIS landcover files. If \code{ed_transfer = FALSE}, character vector containing filenames of MODIS landcover files that +would be downloaded. +} +\description{ +Downloads \href{https://doi.org/10.5067/MODIS/MCD12Q1.061}{annual landcover data} +derived from imagery from the MODIS Terra and Aqua satellites at +approximately 500 m spatial resolution. This data is retreived via the NASA +EarthData Archive, requiring an EarthData account to be made. This can be +done at the following link: \href{https://urs.earthdata.nasa.gov/users/new}{register for an EarthData account}. +} +\details{ +All five classification schemes available through \code{\link[=landcover_extract]{landcover_extract()}} are +downloaded by this function without need for extra specification. + +Downloads are facilitated by a call to \code{\link[luna:getNASA]{luna::getNASA()}}. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Get file names that would be downloaded. +output <- landcover_download( + data = bcch, + ed_transfer = FALSE +) + +# Enter EarthData email +ed_email <- "your EarthData email" + +# Download MODIS data +#output <- landcover_download( +# data = bcch, +# ed_email = ed_email +#) +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[luna:getNASA]{luna::getNASA()}} which this function wraps. + +\code{\link[=landcover_extract]{landcover_extract()}} +which can be used to extract data from downloaded landcover data files. +} diff --git a/man/landcover_extract.Rd b/man/landcover_extract.Rd new file mode 100644 index 00000000..41bca319 --- /dev/null +++ b/man/landcover_extract.Rd @@ -0,0 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/landcover_extract.R +\name{landcover_extract} +\alias{landcover_extract} +\title{Extract MODIS Landcover Data} +\usage{ +landcover_extract( + data, + covariates = "modis_lctype1", + landcover_files, + site_name = NULL, + date_year = NULL, + retain = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{covariates}{Character, vector if multiple landcover types desired. By +default, extracts the IGBP global vegetation classification scheme +(\code{modis_lctype1}).} + +\item{landcover_files}{Character, vector if multiple files. File-path(s) to +downloaded MODIS landcover data file(s). We recommend using +\code{\link[=landcover_download]{landcover_download()}} to download MODIS files to ensure all files +necessary for your data are captured. Direct output of +\code{\link[=landcover_download]{landcover_download()}} can be supplied here.} + +\item{site_name}{Character. Optional argument to provide name of the column +containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=landcover_download]{landcover_download()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left NULL and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=landcover_download]{landcover_download()}}.} + +\item{retain}{Logical. Should MODIS data files be kept after extraction. If +\code{FALSE}, files will be deleted.} +} +\value{ +For \code{sf} 'POINT' or \code{terra} 'points' input data, original data with +a character column \code{lctype1} appended containing the name of the landcover +class that point falls within. + +For \code{sf} 'POLYGON' or \code{terra} 'polygons' input data, original data with +numeric columns containing the proportion of each polygon that is covered +by each landcover type. +} +\description{ +Extracts \href{https://doi.org/10.5067/MODIS/MCD12Q1.061}{annual landcover data} +derived from imagery from the MODIS Terra and Aqua satellites at +approximately 500 m spatial resolution. This data can be downloaded using +\code{\link[=landcover_download]{landcover_download()}}. +} +\details{ +Five landcover classification schemes are available through this function and +can be accessed by supplying the following arguments to the \code{covariates} +argument: +\itemize{ +\item \code{modis_lctype1} - IGBP global vegetation classification scheme +\item \code{modis_lctype2} - University of Maryland (UMD) scheme +\item \code{modis_lctype3} - MODIS-derived LAI/fPAR scheme +\item \code{modis_lctype4} - MODIS-derived Net Primary Production (NPP) scheme +\item \code{modis_lctype5} - Plant Functional Type (PFT) scheme +} + +Details on these classification schemes can be found in Chapter 5 of the +\href{https://lpdaac.usgs.gov/documents/101/MCD12_User_Guide_V6.pdf}{MODIS User Guide}. By +default, the function extracts the University of Maryland scheme +(\code{modis_lctype1}), but we strongly recommend users consider the strengths and +weaknesses of each classification scheme in the context of their analysis and +choose their desired classification scheme appropriately. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Enter EarthData email +ed_email <- readline(prompt = "Enter EarthData email: ") + +# Download MODIS data +modis_files <- landcover_download( + bcch, + ed_email = ed_email +) + +# Extract landcover data +output <- landcover_extract( + data = bcch, + covariates = "modis_lctype1", + landcover_files = modis_files, + retain = FALSE +) +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=landcover_download]{landcover_download()}} which can be used to download data from +the MODIS Landcover dataset. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/man/nc_covariate_table.Rd b/man/nc_covariate_table.Rd new file mode 100644 index 00000000..f818cc2a --- /dev/null +++ b/man/nc_covariate_table.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/metadata_functions.R +\name{nc_covariate_table} +\alias{nc_covariate_table} +\title{Metadata for data sources for the covariate download and extraction functions.} +\usage{ +nc_covariate_table() +} +\value{ +\code{data.frame} containing information on the resolution and source for +the covariate data available through \code{naturecounts}. +} +\description{ +Metadata for data sources for the covariate download and extraction functions. +} diff --git a/man/nc_covariates_merge.Rd b/man/nc_covariates_merge.Rd new file mode 100644 index 00000000..2860e05b --- /dev/null +++ b/man/nc_covariates_merge.Rd @@ -0,0 +1,95 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nc_covariates_merge.R +\name{nc_covariates_merge} +\alias{nc_covariates_merge} +\title{Merge Extracted Covariate Data into Original Input Data} +\usage{ +nc_covariates_merge( + original_data, + covariate_data, + coord_lon = NULL, + coord_lat = NULL, + site_name = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + date_lubridate = NULL, + date_ordinal = NULL +) +} +\arguments{ +\item{original_data}{\code{data.frame}, \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' +or 'polygons'. Object containing data to match covariate data to. For +example, the original input data to a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{covariate_data}{\code{sf} 'POINT' or 'POLYGON' object. Object containing data +output by one of the covariate extraction functions within \link{naturecounts}: +\code{\link[=landcover_extract]{landcover_extract()}}, \code{\link[=vegetation_extract]{vegetation_extract()}}, \code{\link[=elevation_extract]{elevation_extract()}}, +\code{\link[=worldclim_extract]{worldclim_extract()}}, \code{\link[=scanfi_extract]{scanfi_extract()}}, or \link{daymet_extract}.} + +\item{coord_lon}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{longitude}.} + +\item{coord_lat}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{latitude}.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day of month data if not contained within the BMDE column +\code{survey_day}.} + +\item{date_lubridate}{Character. Optional argument to provide the name of a +column containing date data in \code{lubridate} formats.} + +\item{date_ordinal}{Character. Optional argument to provide the name of a +column containing date data in ordinal format.} +} +\value{ +Data provided in \code{original_data} with covariate data columns from +\code{covariate_data} appended. +} +\description{ +Data formatted for covariate extraction using \code{\link[=data_fmt]{data_fmt()}} is transformed +to an \code{sf} object containing a row for each unique site-date combination, +with columns being appended to this by the various covariate extraction +functions within \link{naturecounts}. Users may wish, instead, to have their +covariate data appended to original data in a different format (e.g., a +row for each observation) and can use this function to merge the two data +types accurately. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Format +formatted <- data_fmt(bcch) + +# Download and extract some covariate data. +elev <- elevation_download(data = formatted, + progress = FALSE) + +extracted <- elevation_extract(data = formatted, + elevation_data = elev) + +# Merge with original data +merged <- nc_covariates_merge(original_data = bcch, + covariate_data = extracted) + +merged +\dontshow{\}) # examplesIf} +} diff --git a/man/scanfi_download.Rd b/man/scanfi_download.Rd new file mode 100644 index 00000000..63079ac6 --- /dev/null +++ b/man/scanfi_download.Rd @@ -0,0 +1,116 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scanfi_download.R +\name{scanfi_download} +\alias{scanfi_download} +\title{Download and Load Data from the Spatialized Canadian National Forest Inventory (SCANFI)} +\usage{ +scanfi_download( + data = NULL, + covariates = "scanfi_height", + use_date = TRUE, + snapshot_year = NULL, + date_year = NULL, + timeout = 32000, + dl_path = NULL, + progress = TRUE +) +} +\arguments{ +\item{data}{A \code{data.frame}, \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' +or 'polygons' object containing a column with observation years either named +the BMDE default \code{survey_year} or another name specified in argument \code{date_year}. +Not required if \code{use_date = FALSE}, but must be specified if \code{use_date = TRUE}.} + +\item{covariates}{Character, vector if multiple SCANFI data types desired. By +default, downloads SCANFI forest height data.} + +\item{use_date}{Logical. Should the function use year data provided in \code{data} +to choose which snapshot to download? If \code{FALSE}, \code{snapshot_year} can be used +to specify which snapshot(s) should be downloaded and used.} + +\item{snapshot_year}{Numeric, vector if multiple snapshots desired. Snapshot +years to download. Options include: 1985, 1990, 1995, 2000, 2005, 2010, 2015, +2020, and 2025. If specified, takes precedent over dates from \code{data} when +\code{use_date = TRUE}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{timeout}{Numeric. Number of seconds before downloads timeout. This should +be in the 10s of thousands of seconds, depending on internet download speed. +Default value assumes largest SCANFI file is being requested, with download +speeds of 0.2 Mb/s.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{scanfi/} in the working +directory.} + +\item{progress}{Logical. Should progress bars be displayed?} +} +\value{ +A named list containing \verb{terra SpatRaster}s of all requested data. +Each list element represents the SCANFI snapshot year of the data, +with a named \verb{terra SpatRaster} for each requested variable. +} +\description{ +Downloads and loads into the environment all available variables from the +\href{https://open.canada.ca/data/en/dataset/07653869-f303-46c2-a04e-9ab479b73cbf}{SCANFI v2 dataset}. +All variables are available in snapshots every 5 years between 1985 and 2025 at +a 30 m resolution. Users should be aware that these are very large files (usually +1-5 Gb per snapshot per variable). +} +\details{ +One (or multiple) SCANFI variable(s) can be downloaded by specifying the following +values to the \code{covariates} argument: +\itemize{ +\item Forest age (years): \code{scanfi_age} +\item Forest biomass (tons/ha): \code{scanfi_biomass} +\item Crown closure (\% of pixel covered by tree canopy): \code{scanfi_closure} +\item Forest height (m): \code{scanfi_height} +\item National Forest Inventory land cover (NFILC) class: \code{scanfi_nfilc} +\item Balsam Fir cover (\% of pixel): \code{scanfi_balsamfir} +\item Black Spruce cover (\% of pixel): \code{scanfi_blackspruce} +\item Douglas Fir cover (\% of pixel): \code{scanfi_douglasfir} +\item Jack Pine cover (\% of pixel): \code{scanfi_jackpine} +\item Lodgepole Pine cover (\% of pixel): \code{scanfi_lodgepolepine} +\item Ponderosa Pine cover (\% of pixel): \code{scanfi_ponderosapine} +\item Tamarack cover (\% of pixel): \code{scanfi_tamarack} +\item White and Red Pine cover (\% of pixel): \code{scanfi_whiteredpine} +\item Broadleaf tree species cover (\% of pixel): \code{scanfi_broadleaf} +\item Other conifer species cover (\% of pixel): \code{scanfi_otherconifer} +} + +Downloads are facilitated by a call to \code{\link[utils:download.file]{utils::download.file()}}. +} +\examples{ +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Download SCANFI data - uses the dates in the data to determine which +# snapshot years to download. +output <- scanfi_download(data = bcch, + covariates = "scanfi_ponderosapine", + progress = FALSE) + +# We can also manually specify the snapshot years to download with no input +# data required like this: +output <- scanfi_download(covariates = "scanfi_ponderosapine", + use_date = FALSE, + snapshot_year = c(2015, 2020), + progress = FALSE) + + +} +\references{ +Guindon L., Correia D.L.P, Manka F. and Smiley B. 2026. SCANFI v2: Spatialized CAnadian National Forest Inventory data product v2. Natural Resources Canada, Canadian Forest Service, Laurentian Forestry Centre, Quebec, Canada. \url{https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf}. +} +\seealso{ +\code{\link[=scanfi_extract]{scanfi_extract()}} which can be used to extract data from loaded +SCANFI data files. +} diff --git a/man/scanfi_extract.Rd b/man/scanfi_extract.Rd new file mode 100644 index 00000000..2266095e --- /dev/null +++ b/man/scanfi_extract.Rd @@ -0,0 +1,124 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scanfi_extract.R +\name{scanfi_extract} +\alias{scanfi_extract} +\title{Extract Data from the Spatialized Canadian National Forest Inventory (SCANFI)} +\usage{ +scanfi_extract( + data, + scanfi_data, + covariates = "scanfi_height", + interpolate = FALSE, + site_name = NULL, + date_year = NULL, + dl_path = NULL, + retain = TRUE +) +} +\arguments{ +\item{data}{A sf\verb{'POINT' or 'POLYGON' object, or}terra\verb{'points' or 'polygons' object containing a column with observation years either named the BMDE default}survey_year\verb{or another name specified in argument}date_year`.} + +\item{scanfi_data}{Named \code{list} of \verb{terra SpatRaster}s. First index names should +be the snapshot years contained data is from, and second index names should be +variable names as in \code{\link[=nc_covariate_table]{nc_covariate_table()}}, with the "scanfi_" removed. +We recommend using \code{\link[=scanfi_download]{scanfi_download()}} to ensure that all data necessary to +match your input data are captured and that list formatting is correct. +Direct output of \code{\link[=scanfi_download]{scanfi_download()}} can be supplied here.} + +\item{covariates}{Character, vector if multiple SCANFI data types desired. By +default, downloads SCANFI forest height data.} + +\item{interpolate}{Logical. Should years in between snapshots be assigned the +nearest snapshot's value?} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{scanfi/} in the working +directory.} + +\item{retain}{Logical. Should SCANFI data files be kept after extraction? If +\code{FALSE}, files will be deleted.} +} +\value{ +For sf 'POINT' or terra 'points' input data, original data with +column(s) appended containing the SCANFI data value(s) at each point. + +For sf 'POLYGON' or terra 'polygons' input data, original data with column(s) +appended containing the mean SCANFI data value(s) within each polygon or, +if NFI Landcover requested, the proportion the polygon area covered by of +each land cover class. +} +\description{ +Extracts all available variables from the +\href{https://open.canada.ca/data/en/dataset/07653869-f303-46c2-a04e-9ab479b73cbf}{SCANFI v2 dataset}. +All variables are available in snapshots every 5 years between 1985 and 2025 at +a 30 m resolution. Necessary files can be downloaded and loaded with \code{\link[=scanfi_download]{scanfi_download()}}. +} +\details{ +One (or multiple) SCANFI variable(s) can be extracted by specifying the following +values to the \code{covariates} argument: +\itemize{ +\item Forest age (years): \code{scanfi_age} +\item Forest biomass (tons/ha): \code{scanfi_biomass} +\item Crown closure (\% of pixel covered by tree canopy): \code{scanfi_closure} +\item Forest height (m): \code{scanfi_height} +\item National Forest Inventory land cover (NFILC) class: \code{scanfi_nfilc} +\item Balsam Fir cover (\% of pixel): \code{scanfi_balsamfir} +\item Black Spruce cover (\% of pixel): \code{scanfi_blackspruce} +\item Douglas Fir cover (\% of pixel): \code{scanfi_douglasfir} +\item Jack Pine cover (\% of pixel): \code{scanfi_jackpine} +\item Lodgepole Pine cover (\% of pixel): \code{scanfi_lodgepolepine} +\item Ponderosa Pine cover (\% of pixel): \code{scanfi_ponderosapine} +\item Tamarack cover (\% of pixel): \code{scanfi_tamarack} +\item White and Red Pine cover (\% of pixel): \code{scanfi_whiteredpine} +\item Broadleaf tree species cover (\% of pixel): \code{scanfi_broadleaf} +\item Other conifer species cover (\% of pixel): \code{scanfi_otherconifer} +} +} +\examples{ +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Download SCANFI data - uses the dates in the data to determine which +# snapshot years to download. +scanfi <- scanfi_download(data = bcch, + covariates = "scanfi_ponderosapine", + progress = FALSE) + +# Create sf object to use in extraction. +bcch <- data_fmt(bcch) + +# Extract first only for the snapshot years. +output <- scanfi_extract(data = bcch, + scanfi_data = scanfi) + +# Extract with interpolation for interceding years. +output <- scanfi_extract(data = bcch, + scanfi_data = scanfi, + interpolate = TRUE) + +} +\references{ +Guindon L., Correia D.L.P, Manka F. and Smiley B. 2026. SCANFI v2: Spatialized CAnadian National Forest Inventory data product v2. Natural Resources Canada, Canadian Forest Service, Laurentian Forestry Centre, Quebec, Canada. \url{https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf}. +} +\seealso{ +\code{\link[=scanfi_download]{scanfi_download()}} which can be used to download data from SCANFI +data files and load them into the environment. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/man/vegetation_download.Rd b/man/vegetation_download.Rd new file mode 100644 index 00000000..701c8471 --- /dev/null +++ b/man/vegetation_download.Rd @@ -0,0 +1,112 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vegetation_download.R +\name{vegetation_download} +\alias{vegetation_download} +\title{Download MODIS NDVI/EVI Data} +\usage{ +vegetation_download( + data, + ed_email = NULL, + ed_transfer = TRUE, + site_name = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + dl_path = NULL, + progress = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{ed_email}{Character. The email address associated with your EarthData +account.} + +\item{ed_transfer}{Logical. Should data be downloaded from EarthData? +If \code{FALSE}, a vector containing the names of the files that would be +downloaded is returned.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day-of-month (i.e., a number from 1 to 31) data if not +contained within the BMDE column \code{survey_day}. Can be left \code{NULL} and still +function properly if originally specified in a call to \code{\link[=data_fmt]{data_fmt()}}.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{modis/} in the working +directory.} + +\item{progress}{Logical. Should progress bars for downloads be displayed?} +} +\value{ +If \code{ed_transfer = TRUE}, character vector containing +file-paths to downloaded MODIS landcover files. If \code{ed_transfer = FALSE}, character vector containing filenames of MODIS landcover files that +would be downloaded. +} +\description{ +Downloads \href{https://doi.org/10.5067/MODIS/MOD13A1.061}{16-day NDVI/EVI data} +derived from imagery from the MODIS Terra and Aqua satellites at +approximately 500 m spatial resolution. This data is retreived via the NASA +EarthData Archive, requiring an EarthData account to be made. This can be +done at the following link: \href{https://urs.earthdata.nasa.gov/users/new}{register for an EarthData account}. +} +\details{ +Both NDVI and EVI data are downloaded in a single file, and can be accessed +specifically by specifying \code{modis_ndvi} and/or \code{modis_evi} to the \code{covariates} +argument in a call to \code{vegetation_extract()}. + +Downloads are facilitated by a call to \code{\link[luna:getNASA]{luna::getNASA()}}. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Grab one year to reduce number of files to download +bcch <- dplyr::filter(bcch, survey_year == 2010) + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Get file names that would be downloaded. +output <- vegetation_download( + data = bcch, + ed_transfer = FALSE +) + +# Enter EarthData email +ed_email <- "your EarthData email" + +# Download MODIS data +#output <- vegetation_download( +# data = bcch, +# ed_email = ed_email +#) +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[luna:getNASA]{luna::getNASA()}} which this function wraps. + +\code{\link[=vegetation_extract]{vegetation_extract()}} which can be used to extract data from downloaded +vegetation data files. +} diff --git a/man/vegetation_extract.Rd b/man/vegetation_extract.Rd new file mode 100644 index 00000000..b7893b1c --- /dev/null +++ b/man/vegetation_extract.Rd @@ -0,0 +1,141 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vegetation_extract.R +\name{vegetation_extract} +\alias{vegetation_extract} +\title{Extract MODIS NDVI/EVI Data} +\usage{ +vegetation_extract( + data, + covariates = "modis_ndvi", + vegetation_files, + reliability = FALSE, + site_name = NULL, + date_year = NULL, + date_month = NULL, + date_day = NULL, + retain = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object.} + +\item{covariates}{Character, vector if both NDVI and EVI desired. By +default, extracts NDVI (\code{modis_ndvi}).} + +\item{vegetation_files}{Character, vector if multiple files. File-path(s) to +downloaded MODIS vegetation data file(s). We recommend using +\code{\link[=vegetation_download]{vegetation_download()}} to download MODIS files to ensure all files +necessary for your data are captured. Direct output of +\code{\link[=vegetation_download]{vegetation_download()}} can be supplied here.} + +\item{reliability}{Logical. Should pixel reliability information be extracted +at each site?} + +\item{site_name}{Character. Optional argument to provide name of the column +containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=vegetation_download]{vegetation_download()}}.} + +\item{date_year}{Character. Optional argument to provide the name of the +column containing year data if not contained within the BMDE column +\code{survey_year}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=vegetation_download]{vegetation_download()}}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=vegetation_download]{vegetation_download()}}.} + +\item{date_day}{Character. Optional argument to provide the name of the +column containing day-of-month (i.e., a number from 1 to 31) data if not +contained within the BMDE column \code{survey_day}. Can be left \code{NULL} and still +function properly if originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or +\code{\link[=vegetation_download]{vegetation_download()}}.} + +\item{retain}{Logical. Should MODIS data files be kept after extraction. If +\code{FALSE}, files will be deleted.} +} +\value{ +For \code{sf} 'POINT' or \code{terra} 'points' input data, original data with +numeric column(s) \code{ndvi} and/or \code{evi} appended containing the NDVI/EVI value +at that point. If reliability information requested, an additional +\code{vegetation_reliability} column is appended containing the reliability +assessment as defined in table 4 of the +\href{https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf}{product's user manual}. + +For \code{sf} 'POLYGON' or \code{terra} 'polygons' input data, original data with +numeric column(s) \code{ndvi} and/or \code{evi} appended containing the mean NDVI/EVI +value within each polygon. If reliability information requested, an additional +\code{vegetation_reliability} column is appended containing the percentage of +pixels overlapped by each polygon in each reliability assessment as defined in table 4 of the +\href{https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf}{product's user manual}. +} +\description{ +Extracts \href{https://doi.org/10.5067/MODIS/MOD13A1.061}{16-day NDVI/EVI data} +derived from imagery from the MODIS Terra and Aqua satellites at +approximately 500 m spatial resolution. This data can be downloaded using +\code{\link[=vegetation_download]{vegetation_download()}}. The user guide for these data can be found +\href{https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf}{here}. +} +\details{ +Both NDVI and EVI are available through this function and +can be accessed by supplying the following arguments to the \code{covariates} +argument: +\itemize{ +\item \code{modis_ndvi} - NDVI +\item \code{modis_evi} - EVI +} + +Details on the calculation of these indices can be found in the +\href{https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf}{MOD13 user guide}. + +NDVI/EVI calculations are sensitive to the presence of snow/ice and cloudiness. +So users can assess the quality of data extracted at each site, we have included +the option to extract pixel reliability assessments included in these NDVI/EVI +products by setting argument \code{reliability = TRUE}. The reliability scale is +as in the \href{https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf}{user manual}, +and is supplied to the user in the \code{vegetation_reliability} column if requested. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + +# Using the included, test data on black-capped chickadees +bcch # look at the data + +# Grab one year to reduce number of files to download +bcch <- dplyr::filter(bcch, survey_year == 2010) + +# Convert to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Enter EarthData email +ed_email <- readline(prompt = "Enter EarthData email: ") + +# Download MODIS data +modis_files <- vegetation_download( + bcch, + ed_email = ed_email +) + +# Extract vegetation data +output <- vegetation_extract( + data = bcch, + covariates = "modis_ndvi", + vegetation_files = modis_files, + retain = FALSE +) +\dontshow{\}) # examplesIf} +} +\seealso{ +\code{\link[=vegetation_download]{vegetation_download()}} which can be used to download data from +the MODIS Vegetation Indices database. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/man/worldclim_download.Rd b/man/worldclim_download.Rd new file mode 100644 index 00000000..731fa1b2 --- /dev/null +++ b/man/worldclim_download.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/worldclim_download.R +\name{worldclim_download} +\alias{worldclim_download} +\title{Load WorldClim Climate Data} +\usage{ +worldclim_download( + data = NULL, + covariates = "worldclim_tavg", + countries = NULL, + dl_path = NULL, + progress = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object. Not required if \code{countries} is specified, but must be +specified if \code{countries} is left unspecified.} + +\item{covariates}{Character, vector if multiple climate data types desired. By +default, downloads WorldClim average temperature data.} + +\item{countries}{Character, vector if multiple countries. Country names or +\href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3}{ISO3 country codes} for which +data should be downloaded. If left \code{NULL}, function will attempt to identify +countries needed based on locations in \code{data}.} + +\item{dl_path}{Character. Optional argument to provide path to download data +to. By default, data is downloaded to a subfolder \verb{WorldClim/} in the working +directory.} + +\item{progress}{Logical. Should progress bars and download messages be displayed?} +} +\value{ +A merged \verb{terra SpatRaster} containing all requested data. A \code{list} of +multiple \verb{terra SpatRaster} objects if multiple climate data types requested. +} +\description{ +Downloads monthly WorldClim Monthly Climate Norms, averaged over 1970-2000, +from \href{https://www.worldclim.org/data/worldclim21.html}{WorldClim version 2.1} +at a ~ 1 km^2 spatial resolution (Fick & Hijmans 2017). Several climate variables +are available in this dataset: minimum, maximum, and average temperature (°C), +precipitation (mm), solar radiation (kJ/m^2/day), and wind speed (m/s). +Users should note that these files are downloaded at the country-scale so +they can be quite large. +} +\details{ +One (or multiple) climate variable(s) can be downloaded by specifying the following +values to the \code{covariates} argument +\itemize{ +\item Minimum temperature: \code{worldclim_tmin} +\item Maximum temperature: \code{worldclim_tmax} +\item Average temperature: \code{worldclim_tavg} +\item Precipitation: \code{worldclim_prec} +\item Solar radiation: \code{wordclim_srad} +\item Wind speed: \code{worldclim_wind} +} + +Downloads are facilitated by a call to \code{\link[geodata:worldclim]{geodata::worldclim_country()}}. +} +\examples{ +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Load WorldClim data +output <- worldclim_download(data = bcch, + covariates = "worldclim_wind", + progress = FALSE) + +} +\references{ +Fick, S.E. and R.J. Hijmans, 2017. WorldClim 2: new 1km spatial resolution climate surfaces for global land areas. International Journal of Climatology 37 (12): 4302-4315. +} +\seealso{ +\code{\link[geodata:worldclim]{geodata::worldclim_country()}} which this function wraps. + +\code{\link[=worldclim_extract]{worldclim_extract()}} +which can be used to extract data from loaded WorldClim data files. +} diff --git a/man/worldclim_extract.Rd b/man/worldclim_extract.Rd new file mode 100644 index 00000000..4e04988f --- /dev/null +++ b/man/worldclim_extract.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/worldclim_extract.R +\name{worldclim_extract} +\alias{worldclim_extract} +\title{Extract WorldClim Climate Data} +\usage{ +worldclim_extract( + data, + worldclim_data, + covariates = "worldclim_tavg", + site_name = NULL, + date_month = NULL, + dl_path = NULL, + retain = TRUE +) +} +\arguments{ +\item{data}{An \code{sf} 'POINT' or 'POLYGON' object, or \code{terra} 'points' or +'polygons' object. Not required if \code{countries} is specified, but must be +specified if \code{countries} is left unspecified.} + +\item{worldclim_data}{\verb{terra SpatRaster} or \code{list} of \verb{terra SpatRaster}s if +extracting multiple climate variables. We recommend using +\code{\link[=worldclim_download]{worldclim_download()}} to ensure that all data necessary to match your +input data are captured. Direct output of \code{\link[=worldclim_download]{worldclim_download()}} can be +supplied here.} + +\item{covariates}{Character, vector if multiple climate data types desired. By +default, extracts WorldClim average temperature data.} + +\item{site_name}{Character. Optional argument to provide the name of the +column containing site names if not contained within the BMDE column +\code{SurveyAreaIdentifier}. Can be left \code{NULL} and still function properly if +originally specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=worldclim_download]{worldclim_download()}}.} + +\item{date_month}{Character. Optional argument to provide the name of the +column containing month data if not contained within the BMDE column +\code{survey_month}. Can be left \code{NULL} and still function properly if originally +specified in a call to \code{\link[=data_fmt]{data_fmt()}} or \code{\link[=worldclim_download]{worldclim_download()}}.} + +\item{dl_path}{Character. Path to downloaded files. Only needed if \code{retain = TRUE} +and custom download filepath used.} + +\item{retain}{Logical. Should WorldClim data files be kept after extraction? If +\code{FALSE}, files will be deleted.} +} +\value{ +For sf 'POINT' or terra 'points' input data, original data with +numeric column(s) appended containing the climate data value(s) at each point. + +For sf 'POLYGON' or terra 'polygons' input data, original data with numeric +column(s) appended containing the mean climate data value(s) within each polygon. +} +\description{ +Extracts monthly WorldClim Monthly Climate Norms, averaged over 1970-2000, +from downloaded \href{https://www.worldclim.org/data/worldclim21.html}{WorldClim version 2.1} +(Fick & Hijmans 2017). Several climate variables can be extracted with this +functions: minimum, maximum, and average temperature (°C), +precipitation (mm), solar radiation (kJ/m^2/day), and wind speed (m/s). +Data can be downloaded with \code{\link[=worldclim_download]{worldclim_download()}} +} +\details{ +One (or multiple) climate variable(s) can be extracted by specifying the following +values to the \code{covariates} argument +\itemize{ +\item Minimum temperature: \code{worldclim_tmin} +\item Maximum temperature: \code{worldclim_tmax} +\item Average temperature: \code{worldclim_tavg} +\item Precipitation: \code{worldclim_prec} +\item Solar radiation: \code{wordclim_srad} +\item Wind speed: \code{worldclim_wind} +} +} +\examples{ +# Convert included test data on black-capped chickadees to sf POINT object +bcch <- sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 +) + +# Load WorldClim data +tavg <- worldclim_download(data = bcch, + covariates = "worldclim_wind", + progress = FALSE) + +# Extract average temperature +output <- worldclim_extract(data = bcch, + worldclim_data = tavg, + covariates = "worldclim_wind", + retain = FALSE) + +} +\references{ +Fick, S.E. and R.J. Hijmans, 2017. WorldClim 2: new 1km spatial resolution climate surfaces for global land areas. International Journal of Climatology 37 (12): 4302-4315. +} +\seealso{ +\code{\link[=worldclim_download]{worldclim_download()}} which can be used to download WorldClim data files. + +\code{\link[=nc_covariates_merge]{nc_covariates_merge()}} to merge extracted +covariate data into data originally provided to the \code{data} argument of +\code{\link[=data_fmt]{data_fmt()}}. +} diff --git a/tests/testthat/test_13_covariate_formatting.R b/tests/testthat/test_13_covariate_formatting.R new file mode 100644 index 00000000..08ec3296 --- /dev/null +++ b/tests/testthat/test_13_covariate_formatting.R @@ -0,0 +1,1823 @@ +test_that("data_fmt() basic functionality with complete BMDE data.frame", { + expect_warning( + f <- suppressMessages(data_fmt(bcch)), + "\\[Data Formatting\\] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326." + ) + expect_s3_class(f, "sf") + expect_equal( + as.character(sf::st_geometry_type(f, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) +}) + +test_that("data_fmt() basic functionality with complete BMDE sf POINT", { + expect_silent( + f <- suppressMessages(data_fmt(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ))) + ) + expect_s3_class(f, "sf") + expect_equal( + as.character(sf::st_geometry_type(f, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) +}) + +test_that("data_fmt() basic functionality with complete BMDE terra points", { + expect_silent( + f <- suppressMessages(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))) + ) + expect_s4_class(f, "SpatVector") + expect_equal(terra::geomtype(f), "points") + expect_named( + f, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 6) + ) +}) + +test_that("data_fmt() basic functionality with complete BMDE sf POLYGON", { + expect_silent( + f <- suppressMessages(data_fmt(sf::st_buffer( + sf::st_as_sf(bcch, coords = c("longitude", "latitude"), crs = 4326), + 500 + ))) + ) + expect_s3_class(f, "sf") + expect_equal( + as.character(sf::st_geometry_type(f, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + f, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) +}) + +test_that("data_fmt() basic functionality with complete BMDE terra points", { + expect_silent( + f <- suppressMessages(data_fmt(terra::buffer( + terra::vect(bcch, crs = "epsg:4326", geom = c("longitude", "latitude")), + 500 + ))) + ) + expect_s4_class(f, "SpatVector") + expect_equal(terra::geomtype(f), "polygons") + expect_named( + f, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 6) + ) +}) + +test_that("data_fmt() accepts alternate column names in all data input formats", { + expect_silent( + f_df <- suppressMessages(data_fmt( + dplyr::rename( + bcch, + sites = SurveyAreaIdentifier, + lat = latitude, + lon = longitude, + yr = survey_year, + mth = survey_month, + dy = survey_day + ), + site_name = "sites", + coord_lon = "lon", + coord_lat = "lat", + date_year = "yr", + date_month = "mth", + date_day = "dy", + crs = 4326 + )) + ) + expect_s3_class(f_df, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_df, by_geometry = FALSE)), + "POINT" + ) + expect_named(f_df, c("sites", "lat", "lon", "yr", "mth", "dy", "geometry")) + expect_equal( + nrow(f_df), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_df)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_df, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + c( + attr(f_df, "site_name"), + attr(f_df, "coord_lon"), + attr(f_df, "coord_lat"), + attr(f_df, "date_year"), + attr(f_df, "date_month"), + attr(f_df, "date_day") + ), + c("sites", "lon", "lat", "yr", "mth", "dy") + ) + + expect_warning( + f_sf_pt <- suppressMessages(data_fmt( + sf::st_as_sf( + dplyr::rename( + bcch, + sites = SurveyAreaIdentifier, + lat = latitude, + lon = longitude, + yr = survey_year, + mth = survey_month, + dy = survey_day + ), + coords = c("lon", "lat"), + crs = 4326 + ), + site_name = "sites", + coord_lon = "lon", + coord_lat = "lat", + date_year = "yr", + date_month = "mth", + date_day = "dy" + )), + "\\[Data Formatting\\] sf or terra object provided as well as a lat/lon column name. lat/lon will be derived from the spatial data within the sf/terra object and specified lat/lon column will be ignored." + ) + expect_s3_class(f_sf_pt, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_pt, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f_sf_pt, + c("sites", "latitude", "longitude", "yr", "mth", "dy", "geometry") + ) + expect_equal( + nrow(f_sf_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_pt)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_pt, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + c( + attr(f_sf_pt, "site_name"), + attr(f_sf_pt, "coord_lon"), + attr(f_sf_pt, "coord_lat"), + attr(f_sf_pt, "date_year"), + attr(f_sf_pt, "date_month"), + attr(f_sf_pt, "date_day") + ), + c("sites", "yr", "mth", "dy") + ) + + expect_warning( + f_terra_pt <- suppressMessages(data_fmt( + terra::vect( + dplyr::rename( + bcch, + sites = SurveyAreaIdentifier, + lat = latitude, + lon = longitude, + yr = survey_year, + mth = survey_month, + dy = survey_day + ), + crs = "epsg:4326", + geom = c("lon", "lat") + ), + site_name = "sites", + coord_lon = "lon", + coord_lat = "lat", + date_year = "yr", + date_month = "mth", + date_day = "dy" + )), + "\\[Data Formatting\\] sf or terra object provided as well as a lat/lon column name. lat/lon will be derived from the spatial data within the sf/terra object and specified lat/lon column will be ignored." + ) + expect_s4_class(f_terra_pt, "SpatVector") + expect_equal(terra::geomtype(f_terra_pt), "points") + expect_named( + f_terra_pt, + c("sites", "latitude", "longitude", "yr", "mth", "dy") + ) + expect_equal( + nrow(f_terra_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_pt) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_pt), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 6) + ) + expect_equal( + c( + attr(f_terra_pt, "site_name"), + attr(f_terra_pt, "coord_lon"), + attr(f_terra_pt, "coord_lat"), + attr(f_terra_pt, "date_year"), + attr(f_terra_pt, "date_month"), + attr(f_terra_pt, "date_day") + ), + c("sites", "yr", "mth", "dy") + ) + + expect_warning( + f_sf_poly <- suppressMessages(data_fmt( + sf::st_buffer( + sf::st_as_sf( + dplyr::rename( + bcch, + sites = SurveyAreaIdentifier, + lat = latitude, + lon = longitude, + yr = survey_year, + mth = survey_month, + dy = survey_day + ), + coords = c("lon", "lat"), + crs = 4326, + remove = FALSE + ), + 500 + ), + site_name = "sites", + coord_lon = "lon", + coord_lat = "lat", + date_year = "yr", + date_month = "mth", + date_day = "dy" + )), + "\\[Data Formatting\\] sf or terra object provided as well as a lat/lon column name. lat/lon will be derived from the spatial data within the sf/terra object and specified lat/lon column will be ignored." + ) + expect_s3_class(f_sf_poly, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_poly, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + f_sf_poly, + c("sites", "latitude", "longitude", "yr", "mth", "dy", "geometry") + ) + expect_equal( + nrow(f_sf_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_poly)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_poly, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + c( + attr(f_sf_poly, "site_name"), + attr(f_sf_poly, "coord_lon"), + attr(f_sf_poly, "coord_lat"), + attr(f_sf_poly, "date_year"), + attr(f_sf_poly, "date_month"), + attr(f_sf_poly, "date_day") + ), + c("sites", "yr", "mth", "dy") + ) + + expect_warning( + f_terra_poly <- suppressMessages(data_fmt( + terra::buffer( + terra::vect( + dplyr::rename( + bcch, + sites = SurveyAreaIdentifier, + lat = latitude, + lon = longitude, + yr = survey_year, + mth = survey_month, + dy = survey_day + ), + crs = "epsg:4326", + geom = c("lon", "lat") + ), + 500 + ), + site_name = "sites", + coord_lon = "lon", + coord_lat = "lat", + date_year = "yr", + date_month = "mth", + date_day = "dy" + )), + "\\[Data Formatting\\] sf or terra object provided as well as a lat/lon column name. lat/lon will be derived from the spatial data within the sf/terra object and specified lat/lon column will be ignored." + ) + expect_s4_class(f_terra_poly, "SpatVector") + expect_equal(terra::geomtype(f_terra_poly), "polygons") + expect_named( + f_terra_poly, + c("sites", "latitude", "longitude", "yr", "mth", "dy") + ) + expect_equal( + nrow(f_terra_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_poly) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_poly), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 6) + ) + expect_equal( + c( + attr(f_terra_poly, "site_name"), + attr(f_terra_poly, "coord_lon"), + attr(f_terra_poly, "coord_lat"), + attr(f_terra_poly, "date_year"), + attr(f_terra_poly, "date_month"), + attr(f_terra_poly, "date_day") + ), + c("sites", "yr", "mth", "dy") + ) +}) + +test_that("data_fmt() date conversion from lubridate works in all input formats", { + expect_warning( + f_df <- suppressMessages(data_fmt( + dplyr::mutate( + bcch, + date = as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) + ), + date_lubridate = "date" + )), + "\\[Data Formatting\\] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326." + ) + expect_s3_class(f_df, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_df, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f_df, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "date", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_df), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_df)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_df, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + f_df$date %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal(f_df$survey_year, lubridate::year(f_df$date)) + expect_equal(f_df$survey_month, lubridate::month(f_df$date)) + expect_equal(f_df$survey_day, lubridate::day(f_df$date)) + expect_equal(attr(f_df, "date_lubridate"), "date") + + expect_silent( + f_sf_pt <- suppressMessages(data_fmt( + sf::st_as_sf( + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + ), + coords = c("longitude", "latitude"), + crs = 4326 + ), + date_lubridate = "date" + )) + ) + expect_s3_class(f_sf_pt, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_pt, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f_sf_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "date", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_sf_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_pt)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_pt, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + f_sf_pt$date %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal(f_sf_pt$survey_year, lubridate::year(f_sf_pt$date)) + expect_equal(f_sf_pt$survey_month, lubridate::month(f_sf_pt$date)) + expect_equal(f_sf_pt$survey_day, lubridate::day(f_sf_pt$date)) + expect_equal(attr(f_sf_pt, "date_lubridate"), "date") + + expect_silent( + f_terra_pt <- suppressMessages(data_fmt( + terra::vect( + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + ), + crs = "epsg:4326", + geom = c("longitude", "latitude") + ), + date_lubridate = "date" + )) + ) + expect_s4_class(f_terra_pt, "SpatVector") + expect_equal(terra::geomtype(f_terra_pt), "points") + expect_named( + f_terra_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "date", + "survey_year", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f_terra_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_pt) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_pt), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + all( + f_terra_pt$date %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal(f_terra_pt$survey_year, lubridate::year(f_terra_pt$date)) + expect_equal(f_terra_pt$survey_month, lubridate::month(f_terra_pt$date)) + expect_equal(f_terra_pt$survey_day, lubridate::day(f_terra_pt$date)) + expect_equal(attr(f_terra_pt, "date_lubridate"), "date") + + expect_silent( + f_sf_poly <- suppressMessages(data_fmt( + sf::st_buffer( + sf::st_as_sf( + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + ), + coords = c("longitude", "latitude"), + crs = 4326 + ), + 500 + ), + date_lubridate = "date" + )) + ) + expect_s3_class(f_sf_poly, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_poly, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + f_sf_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "date", + "survey_year", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_sf_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_poly)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_poly, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + f_sf_poly$date %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal(f_sf_poly$survey_year, lubridate::year(f_sf_poly$date)) + expect_equal(f_sf_poly$survey_month, lubridate::month(f_sf_poly$date)) + expect_equal(f_sf_poly$survey_day, lubridate::day(f_sf_poly$date)) + expect_equal(attr(f_sf_poly, "date_lubridate"), "date") + + expect_silent( + f_terra_poly <- suppressMessages(data_fmt( + terra::buffer( + terra::vect( + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + ), + crs = "epsg:4326", + geom = c("longitude", "latitude") + ), + 500 + ), + date_lubridate = "date" + )) + ) + expect_s4_class(f_terra_poly, "SpatVector") + expect_equal(terra::geomtype(f_terra_poly), "polygons") + expect_named( + f_terra_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "date", + "survey_year", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f_terra_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_poly) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_poly), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + all( + f_terra_poly$date %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal(f_terra_poly$survey_year, lubridate::year(f_terra_poly$date)) + expect_equal(f_terra_poly$survey_month, lubridate::month(f_terra_poly$date)) + expect_equal(f_terra_poly$survey_day, lubridate::day(f_terra_poly$date)) + expect_equal(attr(f_terra_poly, "date_lubridate"), "date") +}) + +test_that("data_fmt() date conversion from ordinal works in all input formats", { + expect_warning( + f_df <- suppressMessages(data_fmt( + dplyr::mutate( + bcch, + doy = as.numeric( + as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) - + as.Date(paste0(survey_year, "-01-01")) + + 1 + ) + ), + date_ordinal = "doy" + )), + "\\[Data Formatting\\] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326." + ) + expect_s3_class(f_df, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_df, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f_df, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "doy", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_df), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_df)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_df, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + as.Date(paste0( + f_df$survey_year, + "-", + f_df$survey_month, + "-", + f_df$survey_day + )) %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal( + f_df$survey_year, + lubridate::year(as.Date(paste0( + f_df$survey_year, + "-", + f_df$survey_month, + "-", + f_df$survey_day + ))) + ) + expect_equal( + f_df$survey_month, + lubridate::month(as.Date(paste0( + f_df$survey_year, + "-", + f_df$survey_month, + "-", + f_df$survey_day + ))) + ) + expect_equal( + f_df$survey_day, + lubridate::day(as.Date(paste0( + f_df$survey_year, + "-", + f_df$survey_month, + "-", + f_df$survey_day + ))) + ) + expect_equal(attr(f_df, "date_ordinal"), "doy") + + expect_silent( + f_sf_pt <- suppressMessages(data_fmt( + sf::st_as_sf( + dplyr::mutate( + bcch, + doy = as.numeric( + as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) - + as.Date(paste0(survey_year, "-01-01")) + + 1 + ) + ), + coords = c("longitude", "latitude"), + crs = 4326 + ), + date_ordinal = "doy" + )) + ) + expect_s3_class(f_sf_pt, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_pt, by_geometry = FALSE)), + "POINT" + ) + expect_named( + f_sf_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "doy", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_sf_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_pt)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_pt, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + as.Date(paste0( + f_sf_pt$survey_year, + "-", + f_sf_pt$survey_month, + "-", + f_sf_pt$survey_day + )) %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal( + f_sf_pt$survey_year, + lubridate::year(as.Date(paste0( + f_sf_pt$survey_year, + "-", + f_sf_pt$survey_month, + "-", + f_sf_pt$survey_day + ))) + ) + expect_equal( + f_sf_pt$survey_month, + lubridate::month(as.Date(paste0( + f_sf_pt$survey_year, + "-", + f_sf_pt$survey_month, + "-", + f_sf_pt$survey_day + ))) + ) + expect_equal( + f_sf_pt$survey_day, + lubridate::day(as.Date(paste0( + f_sf_pt$survey_year, + "-", + f_sf_pt$survey_month, + "-", + f_sf_pt$survey_day + ))) + ) + expect_equal(attr(f_sf_pt, "date_ordinal"), "doy") + + expect_silent( + f_terra_pt <- suppressMessages(data_fmt( + terra::vect( + dplyr::mutate( + bcch, + doy = as.numeric( + as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) - + as.Date(paste0(survey_year, "-01-01")) + + 1 + ) + ), + crs = "epsg:4326", + geom = c("longitude", "latitude") + ), + date_ordinal = "doy" + )) + ) + expect_s4_class(f_terra_pt, "SpatVector") + expect_equal(terra::geomtype(f_terra_pt), "points") + expect_named( + f_terra_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "doy", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f_terra_pt), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_pt) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_pt), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + all( + as.Date(paste0( + f_terra_pt$survey_year, + "-", + f_terra_pt$survey_month, + "-", + f_terra_pt$survey_day + )) %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal( + f_terra_pt$survey_year, + lubridate::year(as.Date(paste0( + f_terra_pt$survey_year, + "-", + f_terra_pt$survey_month, + "-", + f_terra_pt$survey_day + ))) + ) + expect_equal( + f_terra_pt$survey_month, + lubridate::month(as.Date(paste0( + f_terra_pt$survey_year, + "-", + f_terra_pt$survey_month, + "-", + f_terra_pt$survey_day + ))) + ) + expect_equal( + f_terra_pt$survey_day, + lubridate::day(as.Date(paste0( + f_terra_pt$survey_year, + "-", + f_terra_pt$survey_month, + "-", + f_terra_pt$survey_day + ))) + ) + expect_equal(attr(f_terra_pt, "date_ordinal"), "doy") + + expect_silent( + f_sf_poly <- suppressMessages(data_fmt( + sf::st_buffer( + sf::st_as_sf( + dplyr::mutate( + bcch, + doy = as.numeric( + as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) - + as.Date(paste0(survey_year, "-01-01")) + + 1 + ) + ), + coords = c("longitude", "latitude"), + crs = 4326 + ), + 500 + ), + date_ordinal = "doy" + )) + ) + expect_s3_class(f_sf_poly, "sf") + expect_equal( + as.character(sf::st_geometry_type(f_sf_poly, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + f_sf_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "doy", + "survey_month", + "survey_day", + "geometry" + ) + ) + expect_equal( + nrow(f_sf_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(format(sf::st_crs(f_sf_poly)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = f_sf_poly, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + expect_equal( + all( + as.Date(paste0( + f_sf_poly$survey_year, + "-", + f_sf_poly$survey_month, + "-", + f_sf_poly$survey_day + )) %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal( + f_sf_poly$survey_year, + lubridate::year(as.Date(paste0( + f_sf_poly$survey_year, + "-", + f_sf_poly$survey_month, + "-", + f_sf_poly$survey_day + ))) + ) + expect_equal( + f_sf_poly$survey_month, + lubridate::month(as.Date(paste0( + f_sf_poly$survey_year, + "-", + f_sf_poly$survey_month, + "-", + f_sf_poly$survey_day + ))) + ) + expect_equal( + f_sf_poly$survey_day, + lubridate::day(as.Date(paste0( + f_sf_poly$survey_year, + "-", + f_sf_poly$survey_month, + "-", + f_sf_poly$survey_day + ))) + ) + expect_equal(attr(f_sf_poly, "date_ordinal"), "doy") + + expect_silent( + f_terra_poly <- suppressMessages(data_fmt( + terra::buffer( + terra::vect( + dplyr::mutate( + bcch, + doy = as.numeric( + as.Date(paste0(survey_year, "-", survey_month, "-", survey_day)) - + as.Date(paste0(survey_year, "-01-01")) + + 1 + ) + ), + crs = "epsg:4326", + geom = c("longitude", "latitude") + ), + 500 + ), + date_ordinal = "doy" + )) + ) + expect_s4_class(f_terra_poly, "SpatVector") + expect_equal(terra::geomtype(f_terra_poly), "polygons") + expect_named( + f_terra_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "doy", + "survey_month", + "survey_day" + ) + ) + expect_equal( + nrow(f_terra_poly), + nrow(dplyr::distinct(dplyr::select( + bcch, + latitude, + longitude, + survey_year, + survey_month, + survey_day + ))) + ) + expect_equal(terra::crs(f_terra_poly) == terra::crs("ESRI:102001"), TRUE) + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = terra::values(f_terra_poly), MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 7) + ) + expect_equal( + all( + as.Date(paste0( + f_terra_poly$survey_year, + "-", + f_terra_poly$survey_month, + "-", + f_terra_poly$survey_day + )) %in% + dplyr::mutate( + bcch, + date = as.Date(paste0( + survey_year, + "-", + survey_month, + "-", + survey_day + )) + )$date + ), + TRUE + ) + expect_equal( + f_terra_poly$survey_year, + lubridate::year(as.Date(paste0( + f_terra_poly$survey_year, + "-", + f_terra_poly$survey_month, + "-", + f_terra_poly$survey_day + ))) + ) + expect_equal( + f_terra_poly$survey_month, + lubridate::month(as.Date(paste0( + f_terra_poly$survey_year, + "-", + f_terra_poly$survey_month, + "-", + f_terra_poly$survey_day + ))) + ) + expect_equal( + f_terra_poly$survey_day, + lubridate::day(as.Date(paste0( + f_terra_poly$survey_year, + "-", + f_terra_poly$survey_month, + "-", + f_terra_poly$survey_day + ))) + ) + expect_equal(attr(f_terra_poly, "date_ordinal"), "doy") +}) + +test_that("data_fmt() drops sites with missing coordinate data (only data.frame input will bring this on)", { + expect_warning( + f_df <- suppressMessages(data_fmt( + dplyr::mutate(bcch, latitude = c(bcch$latitude[1:nrow(bcch) - 1], NA)), + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "\\[Data Formatting\\] some rows missing coordinate data will be dropped." + ) +}) + +test_that("data_fmt() invalid input data formats return appropriate error", { + expect_error( + f_char <- suppressMessages(data_fmt("invalid")), + "\\[Data Formatting\\] invalid data format. Please provide data as either a dataframe, sf object with either `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + f_numeric <- suppressMessages(data_fmt(1)), + "\\[Data Formatting\\] invalid data format. Please provide data as either a dataframe, sf object with either `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + f_vector <- suppressMessages(data_fmt(c("invalid", 2, NA))), + "\\[Data Formatting\\] invalid data format. Please provide data as either a dataframe, sf object with either `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + f_SpatRaster <- suppressMessages(data_fmt(terra::rast( + nrows = 108, + ncols = 21, + xmin = 0, + xmax = 10 + ))), + "\\[Data Formatting\\] invalid data format. Please provide data as either a dataframe, sf object with either `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + f_lines <- suppressMessages(data_fmt(terra::as.lines(terra::vect( + data.frame(longitude = c(100, 110), latitude = c(45, 46)), + crs = "epsg:4326", + geom = c("longitude", "latitude") + )))), + "\\[Data Formatting\\] terra object provided, but not a set of points or polygons." + ) + + expect_error( + f_LINESTRING <- suppressMessages(data_fmt(sf::st_cast( + sf::st_as_sf( + data.frame(longitude = c(100, 110), latitude = c(45, 46)), + coords = c("longitude", "latitude"), + crs = 4326 + ), + "LINESTRING" + ))), + "\\[Data Formatting\\] sf object provided, but not a set of POINT or POLYGON geometries." + ) + + expect_error( + f_mixedgeoms <- suppressMessages(data_fmt(rbind( + sf::st_as_sf( + data.frame(x = 100, y = 45), + coords = c("x", "y"), + crs = 4326 + ), + sf::st_buffer( + sf::st_as_sf( + data.frame(x = 100, y = 45), + coords = c("x", "y"), + crs = 4326 + ), + 500 + ) + ))), + "\\[Data Formatting\\] mixed sf geometries detected. Please provide a set of only POINT geometries or only POLYGON geometries." + ) +}) + +test_that("data_fmt() invalid alternate column names return appropriate error", { + expect_error( + f <- suppressMessages( + data_fmt( + dplyr::rename(bcch, sites = SurveyAreaIdentifier), + site_name = "Sites", + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ) + ), + "\\[Data Formatting\\] some specified columns missing from the data: Sites. Use arguments to specify alternate column names if using data that diverges from NatureCounts default column names." + ) +}) + +test_that("data_fmt() invalid date data return appropriate errors", { + expect_error( + f <- suppressMessages( + data_fmt( + dplyr::mutate(bcch, date = "I'm not a date!"), + date_lubridate = "date", + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ) + ), + "\\[Data Formatting\\] column date expected to be in `Date` format, but is not." + ) +}) + +test_that("data_fmt() invalid CRSs return error", { + expect_error( + f_df <- suppressMessages( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = "I'm not a CRS!" + ) + ), + "\\[Data Formatting\\] the provided CRS is invalid. CRS must be a valid proj4string character, a valid epsg integer value, or a list containing named elements proj4string \\(character\\) and\\/or epsg \\(integer\\)." + ) +}) + +test_that("data_buff() basic functionality with BMDE sf POINT", { + expect_warning( + buffed <- suppressMessages(data_buff(data_fmt(bcch))), + "\\[Data Formatting\\] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326." + ) + expect_equal( + suppressWarnings(sf::st_centroid(buffed)), + suppressWarnings(sf::st_centroid(suppressWarnings(sf::st_buffer( + suppressMessages(data_fmt(bcch)), + 500 + )))) + ) + expect_equal( + sf::st_area(buffed), + sf::st_area(suppressWarnings(sf::st_buffer( + suppressMessages(data_fmt(bcch)), + 500 + ))) + ) + expect_s3_class(buffed, "sf") + expect_equal( + as.character(sf::st_geometry_type(buffed, by_geometry = FALSE)), + "POLYGON" + ) +}) + +test_that("data_buff() basic functionality with BMDE terra points", { + expect_silent( + buffed <- suppressMessages(data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )))) + ) + expect_equal( + suppressWarnings(terra::crds(terra::centroids(buffed))), + terra::crds(suppressWarnings(terra::centroids(suppressWarnings(terra::buffer( + suppressMessages(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + 500 + ))))) + ) + expect_equal( + terra::expanse(buffed), + terra::expanse(terra::buffer( + suppressMessages(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + 500 + )) + ) + expect_s4_class(buffed, "SpatVector") + expect_equal(terra::geomtype(buffed), "polygons") +}) + +test_that("data_buff() basic functionality with BMDE sf POLYGON", { + expect_warning( + buffed <- suppressMessages(data_buff(data_fmt(sf::st_buffer( + sf::st_as_sf(bcch, coords = c("longitude", "latitude"), crs = 4326), + 500 + )))), + "\\[Data Buffering\\] sf POLYGON geometry provided. Existing polygons will be buffered by an additional 500m." + ) + expect_equal( + suppressWarnings(sf::st_centroid(buffed)), + suppressWarnings(sf::st_centroid(suppressWarnings(sf::st_buffer( + suppressMessages(data_fmt(sf::st_buffer( + sf::st_as_sf(bcch, coords = c("longitude", "latitude"), crs = 4326), + 500 + ))), + 500 + )))) + ) + expect_equal( + sf::st_area(buffed), + sf::st_area(suppressWarnings(sf::st_buffer( + suppressMessages(data_fmt(sf::st_buffer( + sf::st_as_sf(bcch, coords = c("longitude", "latitude"), crs = 4326), + 500 + ))), + 500 + ))) + ) + expect_s3_class(buffed, "sf") + expect_equal( + as.character(sf::st_geometry_type(buffed, by_geometry = FALSE)), + "POLYGON" + ) +}) + +test_that("data_buff() basic functionality with BMDE terra polygons", { + expect_warning( + buffed <- suppressMessages(data_buff(data_fmt(terra::buffer( + terra::vect(bcch, crs = "epsg:4326", geom = c("longitude", "latitude")), + 500 + )))), + "\\[Data Buffering\\] terra polygons provided. Existing polygons will be buffered by an additional 500m." + ) + expect_equal( + suppressWarnings(terra::crds(terra::centroids(buffed))), + terra::crds(terra::centroids(terra::buffer( + suppressMessages(data_fmt(terra::buffer( + terra::vect(bcch, crs = "epsg:4326", geom = c("longitude", "latitude")), + 500 + ))), + 500 + ))) + ) + expect_equal( + terra::expanse(buffed), + terra::expanse(terra::buffer( + suppressMessages(data_fmt(terra::buffer( + terra::vect(bcch, crs = "epsg:4326", geom = c("longitude", "latitude")), + 500 + ))), + 500 + )) + ) + expect_s4_class(buffed, "SpatVector") + expect_equal(terra::geomtype(buffed), "polygons") +}) + +test_that("data_buff() rejects invalid data inputs with appropriate errors NOTE: this is different from the test at line 525 as error message is adjusted with a tryCatch to remove the suggestion that data.frame inputs are valid.", { + expect_error( + buff_char <- data_buff("invalid"), + "\\[Data Formatting\\] invalid data format. Please provide data as a sf object with `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + buff_numeric <- data_buff(1), + "\\[Data Formatting\\] invalid data format. Please provide data as a sf object with `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + buff_vector <- data_buff(c("invalid", 2, NA)), + "\\[Data Formatting\\] invalid data format. Please provide data as a sf object with `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + buff_SpatRaster <- data_buff(terra::rast( + nrows = 108, + ncols = 21, + xmin = 0, + xmax = 10 + )), + "\\[Data Formatting\\] invalid data format. Please provide data as a sf object with `POINT` or `POLYGON` geometry, or terra SpatVector object with `points` or `polygons` geometry." + ) + + expect_error( + buff_lines <- data_buff(terra::as.lines(terra::vect( + data.frame(longitude = c(100, 110), latitude = c(45, 46)), + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + "\\[Data Formatting\\] terra object provided, but not a set of points or polygons." + ) + + expect_error( + buff_LINESTRING <- data_buff(sf::st_cast( + sf::st_as_sf( + data.frame(longitude = c(100, 110), latitude = c(45, 46)), + coords = c("longitude", "latitude"), + crs = 4326 + ), + "LINESTRING" + )), + "\\[Data Formatting\\] sf object provided, but not a set of POINT or POLYGON geometries." + ) + + expect_error( + buff_mixedgeoms <- data_buff(rbind( + sf::st_as_sf( + data.frame(x = 100, y = 45), + coords = c("x", "y"), + crs = 4326 + ), + sf::st_buffer( + sf::st_as_sf( + data.frame(x = 100, y = 45), + coords = c("x", "y"), + crs = 4326 + ), + 500 + ) + )), + "\\[Data Formatting\\] mixed sf geometries detected. Please provide a set of only POINT geometries or only POLYGON geometries." + ) +}) + +test_that("data_buff() rejects invalid distance or units inputs.", { + expect_error( + data_buff( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + buffer_distance = "I'm not a number!", + buffer_units = "m" + ), + "\\[Data Buffering\\] 'buffer_distance' could not be converted to numeric. Please provide desired buffer distance as a numeric input." + ) + expect_error( + data_buff( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + buffer = "Not Logical!" + ), + "\\[Data Buffering\\] argument 'buffer' should be a boolean \\(i.e. TRUE or FALSE\\)." + ) + expect_error( + data_buff( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + buffer_distance = 500, + buffer_units = "Lego Pieces" + ), + "\\[Data Buffering\\] buffer units not recognized: please set buffer_units to one of 'm' \\[metres\\], 'km' \\[kilometers\\], 'ft' \\[feet\\], 'yd' \\[yards\\], 'mi' \\[miles\\], or 'naut_mi' \\[nautical miles\\]." + ) +}) diff --git a/tests/testthat/test_14_landcover.R b/tests/testthat/test_14_landcover.R new file mode 100644 index 00000000..f5083823 --- /dev/null +++ b/tests/testthat/test_14_landcover.R @@ -0,0 +1,1222 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +test_that("landcover_download() hits API with all expected inputs. May fail if filename structure is changed server-side.", { + expected_files <- c( + "MCD12Q1.A2001001.h12v04.061.2022146050354.hdf", + "MCD12Q1.A2002001.h12v04.061.2022147215712.hdf", + "MCD12Q1.A2003001.h12v04.061.2022151161906.hdf", + "MCD12Q1.A2004001.h12v04.061.2022152043252.hdf", + "MCD12Q1.A2005001.h12v04.061.2022152140219.hdf", + "MCD12Q1.A2006001.h12v04.061.2022202151028.hdf", + "MCD12Q1.A2007001.h12v04.061.2022153233438.hdf", + "MCD12Q1.A2008001.h12v04.061.2022158231134.hdf", + "MCD12Q1.A2009001.h12v04.061.2022159194525.hdf", + "MCD12Q1.A2010001.h12v04.061.2022160081327.hdf", + "MCD12Q1.A2011001.h12v04.061.2022161144809.hdf", + "MCD12Q1.A2012001.h12v04.061.2022162035938.hdf", + "MCD12Q1.A2013001.h12v04.061.2022164182417.hdf", + "MCD12Q1.A2014001.h12v04.061.2022165083049.hdf", + "MCD12Q1.A2015001.h12v04.061.2022165230140.hdf", + "MCD12Q1.A2017001.h12v04.061.2022168033428.hdf" + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + ))), + expected_files + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_buff(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + ed_transfer = FALSE + ))), + expected_files + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + ed_transfer = FALSE + ))), + expected_files + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + ed_transfer = FALSE + ))), + expected_files + ) +}) + +test_that("landcover_download() successfully downloads requested files with a test user, + and downloaded files contain all data years and cover all data areas.", { + expected_files <- c( + "./testdir/modis/MCD12Q1/MCD12Q1.A2001001.h12v04.061.2022146050354.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2002001.h12v04.061.2022147215712.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2003001.h12v04.061.2022151161906.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2004001.h12v04.061.2022152043252.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2005001.h12v04.061.2022152140219.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2006001.h12v04.061.2022202151028.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2007001.h12v04.061.2022153233438.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2008001.h12v04.061.2022158231134.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2009001.h12v04.061.2022159194525.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2010001.h12v04.061.2022160081327.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2011001.h12v04.061.2022161144809.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2012001.h12v04.061.2022162035938.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2013001.h12v04.061.2022164182417.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2014001.h12v04.061.2022165083049.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2015001.h12v04.061.2022165230140.hdf", + "./testdir/modis/MCD12Q1/MCD12Q1.A2017001.h12v04.061.2022168033428.hdf" + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))), + expected_files + ) + expect_true(dir.exists("./testdir/modis/MCD12Q1")) # Bonus test of custom file path specification + expect_equal( + list.files("./testdir/modis/MCD12Q1", full.names = TRUE), + expected_files + ) + files_years <- luna::modisDate(list.files("./testdir/modis/MCD12Q1")) + expect_true(all( + bcch$survey_year[ + bcch$survey_year %in% 2001:((lubridate::year(Sys.Date())) - 2) + ] %in% + files_years$year + )) + files_extent <- luna::modisExtent(list.files("./testdir/modis/MCD12Q1")) + bcch_spatial <- bcch %>% + sf::st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>% + sf::st_transform(terra::crs(terra::rast(list.files( + "./testdir/modis/MCD12Q1", + full.names = TRUE + )[1]))) %>% + sf::st_coordinates() + expect_true(all(bcch_spatial[, "X"] <= unique(files_extent[, "xmax"]))) + expect_true(all(bcch_spatial[, "X"] >= unique(files_extent[, "xmin"]))) + expect_true(all(bcch_spatial[, "Y"] <= unique(files_extent[, "ymax"]))) + expect_true(all(bcch_spatial[, "Y"] >= unique(files_extent[, "ymin"]))) +}) + +test_that("landcover_download() succeeds with alternate column names, either + passed through attributes or specified explicitly.", { + expected_files <- c( + "MCD12Q1.A2001001.h12v04.061.2022146050354.hdf", + "MCD12Q1.A2002001.h12v04.061.2022147215712.hdf", + "MCD12Q1.A2003001.h12v04.061.2022151161906.hdf", + "MCD12Q1.A2004001.h12v04.061.2022152043252.hdf", + "MCD12Q1.A2005001.h12v04.061.2022152140219.hdf", + "MCD12Q1.A2006001.h12v04.061.2022202151028.hdf", + "MCD12Q1.A2007001.h12v04.061.2022153233438.hdf", + "MCD12Q1.A2008001.h12v04.061.2022158231134.hdf", + "MCD12Q1.A2009001.h12v04.061.2022159194525.hdf", + "MCD12Q1.A2010001.h12v04.061.2022160081327.hdf", + "MCD12Q1.A2011001.h12v04.061.2022161144809.hdf", + "MCD12Q1.A2012001.h12v04.061.2022162035938.hdf", + "MCD12Q1.A2013001.h12v04.061.2022164182417.hdf", + "MCD12Q1.A2014001.h12v04.061.2022165083049.hdf", + "MCD12Q1.A2015001.h12v04.061.2022165230140.hdf", + "MCD12Q1.A2017001.h12v04.061.2022168033428.hdf" + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + ), + ed_transfer = FALSE + ))), + expected_files + ) + expect_equal( + suppressWarnings(suppressMessages(landcover_download( + dplyr::rename( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + site_name = "sites", + date_year = "yr", + ed_transfer = FALSE + ))), + expected_files + ) +}) + +test_that("landcover_download() fetches necessary nearest years for out of coverage dates.", { + outside_dates <- bcch[bcch$survey_year < 2001, ] + outside_dates$survey_year[1] <- lubridate::year(Sys.Date()) + + expect_true( + length(suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )))) == + 2 + ) + + expect_true( + "MCD12Q1.A2001001.h12v04.061.2022146050354.hdf" %in% + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + ))) + ) + + expect_true( + substr( + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )))[2], + start = 1, + stop = 13 + ) %in% + paste0( + "MCD12Q1.A", + c(lubridate::year(Sys.Date()) - 2, lubridate::year(Sys.Date()) - 1) + ) + ) + + expect_true( + length(suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + )))) == + 2 + ) + + expect_true( + "./testdir/modis/MCD12Q1/MCD12Q1.A2001001.h12v04.061.2022146050354.hdf" %in% + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + ) + + expect_true( + substr( + suppressWarnings(suppressMessages(landcover_download( + data_fmt( + outside_dates, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + )))[2], + start = 1, + stop = 37 + ) %in% + paste0( + "./testdir/modis/MCD12Q1/MCD12Q1.A", + c(lubridate::year(Sys.Date()) - 2, lubridate::year(Sys.Date()) - 1) + ) + ) +}) + +test_that("landcover_download() returns appropriate warnings for out of coverage dates.", { + before <- bcch[bcch$survey_year < 2001, ] + + after <- bcch[bcch$survey_year > 2001, ] + after$survey_year[1] <- lubridate::year(Sys.Date()) + + both <- bcch[bcch$survey_year < 2001, ] + both$survey_year[1] <- lubridate::year(Sys.Date()) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + before, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )), + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for all years before 2001. landcover_extract\\(\\) will extract landcover data from 2001 for these observations." + ) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + before, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org" + )), + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for all years before 2001. landcover_extract\\(\\) will extract landcover data from 2001 for these observations." + ) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + after, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )), + paste0( + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for ", + lubridate::year(Sys.Date()), + ". landcover_extract\\(\\) will extract landcover data from the nearest available year for these observations." + ) + ) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + after, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + )), + paste0( + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for ", + lubridate::year(Sys.Date()), + ". landcover_extract\\(\\) will extract landcover data from the nearest available year for these observations." + ) + ) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + both, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )), + paste0( + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for all years before 2001 as well as ", + lubridate::year(Sys.Date()), + ". landcover_extract\\(\\) will extract landcover data from 2001 or the nearest year for these observations." + ) + ) + + expect_warning( + suppressMessages(landcover_download( + data_fmt( + both, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = TRUE, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + )), + paste0( + "\\[MODIS Landcover Download\\] MODIS landcover data unavailable for all years before 2001 as well as ", + lubridate::year(Sys.Date()), + ". landcover_extract\\(\\) will extract landcover data from 2001 or the nearest year for these observations." + ) + ) +}) + +test_that("landcover_extract() throws appropriate error when empty vector provided to landcover_files.", { + expect_error( + landcover_extract( + suppressWarnings(suppressMessages(data_fmt(bcch))), + landcover_files = c() + ), + "\\[MODIS Landcover Extraction\\] no landcover files provided to extract from. Please provide a vector containing filepaths of all necessary MODIS files for your data. Data can be downloaded using landcover_download\\(\\)." + ) +}) + +test_that("landcover_extract() basic functionality with all expected data inputs.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch)))) + terra_pt <- terra::vect(sf_pt) + terra_poly <- terra::vect(sf_poly) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type1_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_poly, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_evergreen_needleleaf_forests", + "LC_Type1_evergreen_broadleaf_forests", + "LC_Type1_decidious_needleleaf_forests", + "LC_Type1_deciduous_broadleaf_forests", + "LC_Type1_mixed_forests", + "LC_Type1_closed_shrublands", + "LC_Type1_open_shrublands", + "LC_Type1_woody_savannas", + "LC_Type1_savannas", + "LC_Type1_grasslands", + "LC_Type1_permanent_wetlands", + "LC_Type1_croplands", + "LC_Type1_urban_builtup_lands", + "LC_Type1_cropland_natural_vegetation_mosaic", + "LC_Type1_permanent_snow_ice", + "LC_Type1_barren", + "LC_Type1_water_bodies", + "LC_Type1_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type1")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 25) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type1") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + terra_pt, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type1_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + terra_poly, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_evergreen_needleleaf_forests", + "LC_Type1_evergreen_broadleaf_forests", + "LC_Type1_decidious_needleleaf_forests", + "LC_Type1_deciduous_broadleaf_forests", + "LC_Type1_mixed_forests", + "LC_Type1_closed_shrublands", + "LC_Type1_open_shrublands", + "LC_Type1_woody_savannas", + "LC_Type1_savannas", + "LC_Type1_grasslands", + "LC_Type1_permanent_wetlands", + "LC_Type1_croplands", + "LC_Type1_urban_builtup_lands", + "LC_Type1_cropland_natural_vegetation_mosaic", + "LC_Type1_permanent_snow_ice", + "LC_Type1_barren", + "LC_Type1_water_bodies", + "LC_Type1_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type1")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 25) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type1") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% +}) + + +test_that("landcover_extract() succeeds with all landcover classification schema.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch)))) + + # Type 2 + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + covariates = "modis_lctype2", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type2_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type2_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_poly, + covariates = "modis_lctype2", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type2_water_bodies", + "LC_Type2_evergreen_needleleaf_forests", + "LC_Type2_evergreen_broadleaf_forests", + "LC_Type2_deciduous_needleleaf_forests", + "LC_Type2_deciduous_broadleaf_forests", + "LC_Type2_mixed_forests", + "LC_Type2_closed_shrublands", + "LC_Type2_open_shrublands", + "LC_Type2_woody_savannas", + "LC_Type2_savannas", + "LC_Type2_grasslands", + "LC_Type2_permanent_wetlands", + "LC_Type2_croplands", + "LC_Type2_urban_builtup_lands", + "LC_Type2_cropland_natural_vegetation_mosaic", + "LC_Type2_nonvegetated_lands", + "LC_Type2_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type2")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 24) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type2") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% + + # Type 3 + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + covariates = "modis_lctype3", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type3_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type3_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_poly, + covariates = "modis_lctype3", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type3_water_bodies", + "LC_Type3_grasslands", + "LC_Type3_shrublands", + "LC_Type3_broadleaf_croplands", + "LC_Type3_savannas", + "LC_Type3_evergreen_broadleaf_forests", + "LC_Type3_deciduous_broadleaf_forests", + "LC_Type3_evergreen_needleleaf_forests", + "LC_Type3_deciduous_needleleaf_forests", + "LC_Type3_nonvegetated_lands", + "LC_Type3_urban_builtup_lands", + "LC_Type3_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type3")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 19) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type3") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% + + # Type 4 + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + covariates = "modis_lctype4", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type4_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type4_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_poly, + covariates = "modis_lctype4", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type4_water_bodies", + "LC_Type4_evergreen_needleleaf_vegetation", + "LC_Type4_evergreen_broadleaf_vegetation", + "LC_Type4_deciduous_needleleaf_vegetation", + "LC_Type4_deciduous_broadleaf_vegetation", + "LC_Type4_annual_broadleaf_vegetation", + "LC_Type4_annual_grass_vegetation", + "LC_Type4_nonvegetated_lands", + "LC_Type4_urban_builtup_lands", + "LC_Type4_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type4")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 17) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type4") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% + + # Type 5 + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + covariates = "modis_lctype5", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type5_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type5_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_poly, + covariates = "modis_lctype5", + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "LC_Type5_water_bodies", + "LC_Type5_evergreen_needleleaf_trees", + "LC_Type5_evergreen_broadleaf_trees", + "LC_Type5_deciduous_needleleaf_trees", + "LC_Type5_deciduous_broadleaf_trees", + "LC_Type5_shrub", + "LC_Type5_grass", + "LC_Type5_cereal_croplands", + "LC_Type5_broadleaf_croplands", + "LC_Type5_urban_builtup_lands", + "LC_Type5_permanent_snow_ice", + "LC_Type5_barren", + "LC_Type5_unclassified" + ) + ) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("LC_Type5")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 20) + ) + expect_equal( + unique(round( + rowSums(sf::st_drop_geometry(dplyr::select( + extracted, + tidyselect::starts_with("LC_Type5") + ))), + 0 + )), + 100 + ) # Check that all rows sum to 100% +}) + + +test_that("landcover_extract() returns appropriate warnings for out of coverage points and dates.", { + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$latitude[1] <- 80 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(landcover_extract( + sf_pt, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + )), + "\\[MODIS Landcover Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the MODIS files provided. No value will be assigned." + ) + expect_true(is.na(extracted$LC_Type1_Class[1])) + + expect_warning( + extracted <- suppressMessages(landcover_extract( + sf_poly, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + )), + "\\[MODIS Landcover Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the MODIS files provided. No value will be assigned." + ) + expect_true(all(c(unname(is.na(sf::st_drop_geometry(dplyr::select( + extracted, + starts_with("LC_Type1") + ))[1, ]))))) + + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$survey_year[1] <- 1998 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(landcover_extract( + sf_pt, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + )), + "\\[MODIS Landcover Extraction\\]: MODIS data not available for 1998 - using data from nearest year\\(s\\) \\(2001\\)." + ) + expect_true(extracted$LC_Type1_Class[1] == "mixed_forests") + + expect_warning( + extracted <- suppressMessages(landcover_extract( + sf_poly, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + )), + "\\[MODIS Landcover Extraction\\]: MODIS data not available for 1998 - using data from nearest year\\(s\\) \\(2001\\)." + ) + expect_true(all( + round( + unlist(unname(sf::st_drop_geometry(dplyr::select( + extracted, + starts_with("LC_Type1") + ))[1, ])), + 2 + ) == + c(0, 0, 0, 50, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + )) +}) + +test_that("landcover_extract() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + sf_pt <- suppressMessages(data_fmt( + dplyr::rename(bcch, "sites" = "SurveyAreaIdentifier", "yr" = "survey_year"), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + )) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + landcover_files = list.files("./testdir/modis/MCD12Q1", full.names = TRUE) + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type1_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + sf_pt <- dplyr::rename( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(landcover_extract( + sf_pt, + landcover_files = list.files( + "./testdir/modis/MCD12Q1", + full.names = TRUE + ), + site_name = "sites", + date_year = "yr" + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "LC_Type1_Class" + ) + ) + expect_equal( + dplyr::select(extracted, -"LC_Type1_Class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) + +unlink("./testdir", recursive = TRUE) diff --git a/tests/testthat/test_15_vegetation.R b/tests/testthat/test_15_vegetation.R new file mode 100644 index 00000000..48ab4dd2 --- /dev/null +++ b/tests/testthat/test_15_vegetation.R @@ -0,0 +1,686 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +test_that("vegetation_download() hits API with all expected inputs. May fail if + filename structure is changed server-side.", { + expected_files <- c( + "MOD13A1.A2007337.h12v04.061.2021081224633.hdf", + "MOD13A1.A2007049.h12v04.061.2021055160007.hdf", + "MOD13A1.A2007097.h12v04.061.2021060063721.hdf", + "MOD13A1.A2007241.h12v04.061.2021073192515.hdf" + ) + + expect_equal( + suppressMessages(vegetation_download( + data_fmt( + bcch[bcch$survey_year == 2007, ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )), + expected_files + ) + expect_equal( + suppressMessages(vegetation_download( + data_buff(data_fmt( + bcch[bcch$survey_year == 2007, ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + ed_transfer = FALSE + )), + expected_files + ) + expect_equal( + suppressMessages(vegetation_download( + data_fmt(terra::vect( + bcch[bcch$survey_year == 2007, ], + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + ed_transfer = FALSE + )), + expected_files + ) + expect_equal( + suppressMessages(vegetation_download( + data_buff(data_fmt(terra::vect( + bcch[bcch$survey_year == 2007, ], + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + ed_transfer = FALSE + )), + expected_files + ) +}) + + +test_that("vegetation_download() successfully downloads requested files with a test user, + and downloaded files contain all data years and cover all data areas.", { + expected_files <- c( + "./testdir/modis/MOD13A1/MOD13A1.A2006337.h12v04.061.2020278214814.hdf", + "./testdir/modis/MOD13A1/MOD13A1.A2007337.h12v04.061.2021081224633.hdf", + "./testdir/modis/MOD13A1/MOD13A1.A2007049.h12v04.061.2021055160007.hdf", + "./testdir/modis/MOD13A1/MOD13A1.A2007097.h12v04.061.2021060063721.hdf", + "./testdir/modis/MOD13A1/MOD13A1.A2007241.h12v04.061.2021073192515.hdf" + ) + + expect_equal( + suppressMessages(vegetation_download( + data_fmt( + bcch[bcch$survey_year %in% c(2006:2007), ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_email = "rmacklin@birdscanada.org", + ed_transfer = TRUE, + dl_path = "./testdir", + progress = FALSE + )), + expected_files + ) + expect_true(dir.exists("./testdir/modis/MOD13A1")) # Bonus test of custom file path specification + expect_true(all( + list.files("./testdir/modis/MOD13A1", full.names = TRUE) %in% expected_files + )) + files_years <- luna::modisDate(list.files("./testdir/modis/MOD13A1")) + expect_true(all( + bcch$survey_year[bcch$survey_year %in% c(2006:2007)] %in% files_years$year + )) + files_extent <- luna::modisExtent(list.files("./testdir/modis/MOD13A1")) + bcch_spatial <- bcch %>% + dplyr::filter(survey_year %in% c(2006:2007)) %>% + sf::st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>% + sf::st_transform(terra::crs(terra::rast(list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + )[1]))) %>% + sf::st_coordinates() + expect_true(all(bcch_spatial[, "X"] <= unique(files_extent[, "xmax"]))) + expect_true(all(bcch_spatial[, "X"] >= unique(files_extent[, "xmin"]))) + expect_true(all(bcch_spatial[, "Y"] <= unique(files_extent[, "ymax"]))) + expect_true(all(bcch_spatial[, "Y"] >= unique(files_extent[, "ymin"]))) +}) + +test_that("vegetation_download() succeeds with alternate column names, either + passed through attributes or specified explicitly.", { + expected_files <- c( + "MOD13A1.A2007337.h12v04.061.2021081224633.hdf", + "MOD13A1.A2007049.h12v04.061.2021055160007.hdf", + "MOD13A1.A2007097.h12v04.061.2021060063721.hdf", + "MOD13A1.A2007241.h12v04.061.2021073192515.hdf" + ) + + expect_equal( + suppressMessages(vegetation_download( + data_fmt( + dplyr::rename( + bcch[bcch$survey_year == 2007, ], + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + ), + ed_transfer = FALSE + )), + expected_files + ) + expect_equal( + suppressMessages(vegetation_download( + dplyr::rename( + data_fmt( + bcch[bcch$survey_year == 2007, ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + site_name = "sites", + date_year = "yr", + ed_transfer = FALSE + )), + expected_files + ) +}) + +test_that("vegetation_download() returns correct warning with out of coverage dates.", { + expect_warning( + suppressMessages(vegetation_download( + data_fmt( + bcch[bcch$survey_year == 1998, ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_transfer = FALSE + )), + "Observation on date\\(s\\) 1998-12-19 could not be matched to a MODIS vegetation data file. Are they outside of the temporal coverage of the data \\(i.e., before 2000 or in the current year\\)\\?" + ) +}) + +test_that("vegetation_extract() throws appropriate error when empty vector provided to vegetation_files.", { + expect_error( + vegetation_extract( + suppressWarnings(suppressMessages(data_fmt(bcch))), + vegetation_files = c() + ), + "\\[MODIS NDVI\\/EVI Extraction\\] no vegetation files provided to extract from. Please provide a vector containing filepaths of all necessary MODIS files for your data. Data can be downloaded using vegetation_download\\(\\)." + ) +}) + +test_that("vegetation_extract() basic functionality with all expected data inputs.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch[ + bcch$survey_year == 2007, + ]))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch[ + bcch$survey_year == 2007, + ])))) + terra_pt <- terra::vect(sf_pt) + terra_poly <- terra::vect(sf_poly) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + covariates = c("modis_ndvi", "modis_evi") + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "evi", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"evi"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_true(all(extracted$ndvi < 1)) + expect_true(all(extracted$ndvi > -1)) + expect_true(all(extracted$evi < 1)) + expect_true(all(extracted$evi > -1)) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + covariates = c("modis_ndvi", "modis_evi") + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "evi", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"evi"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_true(all(extracted$ndvi < 1)) + expect_true(all(extracted$ndvi > -1)) + expect_true(all(extracted$evi < 1)) + expect_true(all(extracted$evi > -1)) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + terra_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + covariates = c("modis_ndvi", "modis_evi") + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "evi", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"evi"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_true(all(extracted$ndvi < 1)) + expect_true(all(extracted$ndvi > -1)) + expect_true(all(extracted$evi < 1)) + expect_true(all(extracted$evi > -1)) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + terra_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + covariates = c("modis_ndvi", "modis_evi") + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "evi", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"evi"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_true(all(extracted$ndvi < 1)) + expect_true(all(extracted$ndvi > -1)) + expect_true(all(extracted$evi < 1)) + expect_true(all(extracted$evi > -1)) +}) + +test_that("vegetation_extract() successfully returns reliability information.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch[ + bcch$survey_year == 2007, + ]))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch[ + bcch$survey_year == 2007, + ])))) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + reliability = TRUE + )) + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "vegetation_reliability", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"vegetation_reliability"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_true(all( + extracted$vegetation_reliability %in% + c("Fill/No Data", "Good Data", "Marginal Data", "Snow/Ice", "Cloudy") + )) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + reliability = TRUE + )) + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "ndvi", + "vegetation_reliability", + "geometry" + ) + ) + expect_equal( + dplyr::select(extracted, -"ndvi", -"vegetation_reliability"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 9) + ) + expect_equal( + stringr::str_flatten_comma(extracted$vegetation_reliability), + "Snow/Ice (100%), Snow/Ice (66.67%), Cloudy (33.33%), Good Data (100%), Good Data (100%)" + ) +}) + +test_that("vegetation_extract() returns appropriate warnings for out of coverage points and dates.", { + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year == 2007) + bcch_mod$latitude[1] <- 80 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ) + )), + "\\[MODIS NDVI\\/EVI Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the files provided. No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + reliability = TRUE + )), # bonus test of whether reliability is returned as NA. + "\\[MODIS NDVI\\/EVI Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the files provided. No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + expect_true(is.na(extracted$vegetation_reliability[1])) + + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year == 2007) + bcch_mod$survey_year[1] <- 1999 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ) + )), + "\\[MODIS NDVI/EVI Extraction\\] observations from year 1999 fall outside of the temporal extent of the files provided. Is it in a year where data is unavailable from this dataset\\? No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + reliability = TRUE + )), # bonus test of whether reliability is returned as NA. + "\\[MODIS NDVI/EVI Extraction\\] observations from year 1999 fall outside of the temporal extent of the files provided. Is it in a year where data is unavailable from this dataset\\? No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + expect_true(is.na(extracted$vegetation_reliability[1])) + + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year == 2007) + bcch_mod$survey_month[1] <- 1 + bcch_mod$survey_day[1] <- 10 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ) + )), + "\\[MODIS NDVI/EVI Extraction\\] observations on 2007-01-10 fall outside of the temporal extent of the files provided. You have provided data for this year but not this 16-day window. No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + + expect_warning( + extracted <- suppressMessages(vegetation_extract( + sf_poly, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + reliability = TRUE + )), # bonus test of whether reliability is returned as NA. + "\\[MODIS NDVI/EVI Extraction\\] observations on 2007-01-10 fall outside of the temporal extent of the files provided. You have provided data for this year but not this 16-day window. No value will be returned." + ) + expect_true(is.na(extracted$ndvi[1])) + expect_true(is.na(extracted$vegetation_reliability[1])) +}) + + +test_that("vegetation_extract() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + sf_pt <- suppressMessages(data_fmt( + dplyr::rename( + bcch[bcch$survey_year == 2007, ], + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + )) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ) + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "ndvi", + "geometry" + ) + ) + expect_equal(dplyr::select(extracted, -"ndvi"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + sf_pt <- dplyr::rename( + suppressMessages(data_fmt( + bcch[bcch$survey_year == 2007, ], + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ) + + expect_silent( + extracted <- suppressMessages(vegetation_extract( + sf_pt, + vegetation_files = list.files( + "./testdir/modis/MOD13A1", + full.names = TRUE + ), + site_name = "sites", + date_year = "yr" + )) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "ndvi", + "geometry" + ) + ) + expect_equal(dplyr::select(extracted, -"ndvi"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) diff --git a/tests/testthat/test_16_elevation.R b/tests/testthat/test_16_elevation.R new file mode 100644 index 00000000..686fe023 --- /dev/null +++ b/tests/testthat/test_16_elevation.R @@ -0,0 +1,482 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +test_that("elevation_download() hits API with all expected inputs.", { + expect_silent( + elev_sf_pt <<- suppressMessages(elevation_download( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + dl_path = "./testdir" + )) + ) + expect_silent( + elev_sf_poly <<- suppressMessages(elevation_download( + data_buff(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + dl_path = "./testdir" + )) + ) + expect_silent( + elev_terra_pt <<- suppressMessages(elevation_download( + data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + dl_path = "./testdir" + )) + ) + expect_silent( + elev_terra_poly <<- suppressMessages(elevation_download( + data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + dl_path = "./testdir" + )) + ) +}) + +test_that("Results downloaded from elevation_download() have expected features.", { + expect_true(dir.exists("./testdir/TerrainTiles")) # Bonus test of custom file path specification + expect_true(all( + file.size(list.files("./testdir/TerrainTiles", full.names = TRUE)) > 100000 + )) # Check files contain a reasonable amount of data + + expect_s4_class(elev_sf_pt, "SpatRaster") + expect_s4_class(elev_sf_poly, "SpatRaster") + expect_s4_class(elev_terra_pt, "SpatRaster") + expect_s4_class(elev_terra_poly, "SpatRaster") + + expect_true(terra::is.related( + elev_sf_pt, + terra::vect(suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ))), + "contains" + )) + expect_true(terra::is.related( + elev_sf_poly, + terra::vect(suppressMessages(data_buff(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )))), + "contains" + )) + expect_true(terra::is.related( + elev_terra_pt, + suppressMessages(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + "contains" + )) + expect_true(terra::is.related( + elev_terra_poly, + suppressMessages(data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )))), + "contains" + )) +}) + +test_that("elevation_download() succeeds with alternate column names, either + passed through attributes or specified explicitly.", { + expect_silent(suppressWarnings(suppressMessages(elevation_download(data_fmt( + dplyr::rename(bcch, "sites" = "SurveyAreaIdentifier", "yr" = "survey_year"), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + ))))) + expect_silent(suppressWarnings(suppressMessages(elevation_download( + dplyr::rename( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + site_name = "sites" + )))) +}) + +test_that("elevation_extract() throws appropriate error when inappropriate file provided to elevation_data or argument is missing.", { + expect_error( + elevation_extract(suppressWarnings(suppressMessages(data_fmt(bcch)))), + "\\[Elevation Extraction\\] no elevation data provided to extract from. Please provide a terra SpatRaster containing the necessary elevation data. Elevation data can be downloaded using elevation_download\\(\\)." + ) + + expect_error( + elevation_extract( + suppressWarnings(suppressMessages(data_fmt(bcch))), + elevation_data = suppressWarnings(suppressMessages(data_fmt(bcch))) + ), + "\\[Elevation Extraction\\] data provided to elevation_data argument is not a SpatRaster. Please provide a terra SpatRaster containing the necessary elevation data. Elevation data can be downloaded using elevation_download\\(\\)." + ) +}) + +test_that("elevation_extract() basic functionality with all expected data inputs.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch)))) + terra_pt <- terra::vect(sf_pt) + terra_poly <- terra::vect(sf_poly) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + sf_pt, + elevation_data = elev_sf_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + sf_poly, + elevation_data = elev_sf_poly + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + terra_pt, + elevation_data = elev_terra_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + terra_poly, + elevation_data = elev_terra_poly + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) + +test_that("elevation_extract() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + sf_pt <- suppressMessages(data_fmt( + dplyr::rename(bcch, "sites" = "SurveyAreaIdentifier", "yr" = "survey_year"), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + )) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + sf_pt, + elevation_data = elev_sf_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + sf_pt <- dplyr::rename( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(elevation_extract( + sf_pt, + elevation_data = elev_sf_pt, + site_name = "sites" + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "elevation" + ) + ) + expect_true(inherits(extracted$elevation, "numeric")) + expect_equal( + dplyr::select(extracted, -"elevation"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) + +test_that("elevation_extract() returns appropriate warnings for out of coverage points.", { + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$latitude[1] <- 80 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(elevation_extract( + sf_pt, + elevation_data = elev_sf_pt + )), + "\\[Elevation Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the elevation rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$elevation[1])) + + expect_warning( + extracted <- suppressMessages(elevation_extract( + sf_poly, + elevation_data = elev_sf_poly + )), + "\\[Elevation Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the elevation rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$elevation[1])) + + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$latitude[1] <- 47.25 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(elevation_extract( + sf_pt, + elevation_data = elev_sf_pt + )), + "\\[Elevation Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the elevation rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$elevation[1])) + + expect_warning( + extracted <- suppressMessages(elevation_extract( + sf_poly, + elevation_data = elev_sf_poly + )), + "\\[Elevation Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the elevation rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$elevation[1])) + + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$latitude[1] <- 47.045 + + sf_poly <- suppressWarnings(suppressMessages(data_buff( + data_fmt(bcch_mod), + buffer_distance = 5, + buffer_units = "km" + ))) + + expect_warning( + extracted <- suppressMessages(elevation_extract( + sf_poly, + elevation_data = elev_sf_poly + )), + "\\[Elevation Extraction\\] site FilledSurveyArea1\\'s buffered area is only partially contained by the spatial extent of the elevation rasters provided. Returned mean elevation value will be derived from the available values." + ) + expect_true(inherits(extracted$elevation[1], "numeric")) +}) + +unlink("./testdir", recursive = TRUE) diff --git a/tests/testthat/test_17_worldclim.R b/tests/testthat/test_17_worldclim.R new file mode 100644 index 00000000..73f694b8 --- /dev/null +++ b/tests/testthat/test_17_worldclim.R @@ -0,0 +1,486 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +test_that("worldclim_download() hits API with all expected inputs.", { + expect_silent( + tavg_sf_pt <<- suppressMessages(worldclim_download( + data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_sf_poly <<- suppressMessages(worldclim_download( + data_buff(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_terra_pt <<- suppressMessages(worldclim_download( + data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_terra_poly <<- suppressMessages(worldclim_download( + data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_countryname <<- suppressMessages(worldclim_download( + countries = "Canada", + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_countrycode <<- suppressMessages(worldclim_download( + countries = "CAN", + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + tavg_countries <<- suppressMessages(worldclim_download( + countries = c("Canada", "MDG"), + covariates = "worldclim_tavg", + dl_path = "./testdir", + progress = FALSE + )) + ) + expect_silent( + other_vars <<- suppressMessages(worldclim_download( + countries = "MDG", + covariates = c( + "worldclim_tmin", + "worldclim_tmax", + "worldclim_prec", + "worldclim_srad", + "worldclim_wind" + ), + dl_path = "./testdir", + progress = FALSE + )) + ) +}) + +test_that("Results downloaded from scanfi_download() have expected features.", { + expect_true(dir.exists("./testdir/worldclim")) # Bonus test of custom file path specification + expect_true(all( + file.size(list.files( + "./testdir/TerrainTiles/climate/wc2.1_country", + full.names = TRUE + )) > + 100000 + )) # Check files contain a reasonable amount of data + + expect_s4_class(tavg_sf_pt, "SpatRaster") + expect_s4_class(tavg_sf_poly, "SpatRaster") + expect_s4_class(tavg_terra_pt, "SpatRaster") + expect_s4_class(tavg_terra_poly, "SpatRaster") + expect_s4_class(tavg_countryname, "SpatRaster") + expect_s4_class(tavg_countrycode, "SpatRaster") + expect_s4_class(tavg_countries, "SpatRaster") + expect_true(inherits(other_vars, "list")) + expect_s4_class(other_vars$tmin, "SpatRaster") + expect_s4_class(other_vars$tmax, "SpatRaster") + expect_s4_class(other_vars$prec, "SpatRaster") + expect_s4_class(other_vars$srad, "SpatRaster") + expect_s4_class(other_vars$wind, "SpatRaster") + + expect_true(terra::is.related( + tavg_sf_pt, + terra::project( + terra::vect(suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ))), + terra::crs(tavg_sf_pt) + ), + "contains" + )) + expect_true(terra::is.related( + tavg_sf_poly, + terra::project( + terra::vect(suppressMessages(data_buff(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )))), + terra::crs(tavg_sf_poly) + ), + "contains" + )) + expect_true(terra::is.related( + tavg_terra_pt, + terra::project( + suppressMessages(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + terra::crs(tavg_terra_pt) + ), + "contains" + )) + expect_true(terra::is.related( + tavg_terra_poly, + terra::project( + suppressMessages(data_buff(data_fmt(terra::vect( + bcch, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )))), + terra::crs(tavg_terra_poly) + ), + "contains" + )) +}) + +test_that("worldclim_extract() throws appropriate error when inappropriate file provided to worldclim_data or argument is missing.", { + expect_error( + worldclim_extract(suppressWarnings(suppressMessages(data_fmt(bcch)))), + "\\[WorldClim Extraction\\] no WorldClim rasters provided to extract from. Please provide a list of the necessary rasters. Data can be downloaded using worldclim_download\\(\\)." + ) + + expect_error( + worldclim_extract( + suppressWarnings(suppressMessages(data_fmt(bcch))), + worldclim_data = suppressWarnings(suppressMessages(data_fmt(bcch))) + ), + "\\[WorldClim Extraction\\] no WorldClim rasters provided to extract from. Please provide a list of the necessary rasters. Data can be downloaded using worldclim_download\\(\\)." + ) +}) + +test_that("worldclim_extract() basic functionality with all expected data inputs.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch)))) + terra_pt <- terra::vect(sf_pt) + terra_poly <- terra::vect(sf_poly) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + sf_pt, + worldclim_data = tavg_sf_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + sf_poly, + worldclim_data = tavg_sf_poly + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_poly, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + terra_pt, + worldclim_data = tavg_terra_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + terra_poly, + worldclim_data = tavg_terra_poly + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_poly, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) + +test_that("worldclim_extract() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + sf_pt <- suppressMessages(data_fmt( + dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "mth" = "survey_month" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_month = "mth", + crs = 4326 + )) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + sf_pt, + worldclim_data = tavg_sf_pt + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "survey_year", + "mth", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) + + sf_pt <- dplyr::rename( + suppressMessages(data_fmt( + bcch, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "sites" = "SurveyAreaIdentifier", + "mth" = "survey_month" + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(worldclim_extract( + sf_pt, + worldclim_data = tavg_sf_pt, + site_name = "sites", + date_month = "mth" + ))) + ) + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "survey_year", + "mth", + "survey_day", + "geometry", + "tavg" + ) + ) + expect_true(inherits(extracted$tavg, "numeric")) + expect_equal(dplyr::select(extracted, -"tavg"), sf_pt, ignore_attr = TRUE) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_equal( + unname(apply( + X = apply(FUN = is.na, X = extracted, MARGIN = 1), + FUN = unique, + MARGIN = 1 + )), + rep(FALSE, times = 8) + ) +}) + +test_that("worldclim_extract() returns appropriate warnings for out of coverage points.", { + bcch_mod <- bcch + bcch_mod <- dplyr::filter(bcch_mod, .data$survey_year %in% 2005:2015) + bcch_mod$latitude[1] <- 80 + bcch_mod$longitude[1] <- -127 + + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_mod))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch_mod)))) + + expect_warning( + extracted <- suppressMessages(worldclim_extract( + sf_pt, + worldclim_data = tavg_sf_pt + )), + "\\[WorldClim \\(tavg\\) Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the WorldClim rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$tavg[1])) + + expect_warning( + extracted <- suppressMessages(worldclim_extract( + sf_poly, + worldclim_data = tavg_sf_poly + )), + "\\[WorldClim \\(tavg\\) Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the WorldClim rasters provided. No value will be returned." + ) + expect_true(is.na(extracted$tavg[1])) + + bcch_mod <- bcch[1, ] + bcch_mod$latitude[1] <- -19.04 + bcch_mod$longitude[1] <- 44.24 + + sf_poly <- suppressWarnings(suppressMessages(data_buff( + data_fmt(bcch_mod), + buffer_distance = 5, + buffer_units = "km" + ))) + + expect_warning( + extracted <- suppressMessages(worldclim_extract( + sf_poly, + covariates = "worldclim_tmin", + worldclim_data = other_vars[["tmin"]] + )), + "\\[WorldClim \\(tmin\\) Extraction\\] site FilledSurveyArea1\\'s buffered area is only partially contained by the spatial extent of the WorldClim rasters provided. Returned mean tmin value will be derived from the available values." + ) + expect_true(inherits(extracted$tmin[1], "numeric")) +}) + +unlink("./testdir", recursive = TRUE) diff --git a/tests/testthat/test_18_scanfi.R b/tests/testthat/test_18_scanfi.R new file mode 100644 index 00000000..7cb1cbaf --- /dev/null +++ b/tests/testthat/test_18_scanfi.R @@ -0,0 +1,984 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +bcch_restricted <- bcch[bcch$survey_year %in% c(2000:2007), ] + +test_that("scanfi_download() downloads correct files with all expected inputs.", { + expect_silent( + ponderosa_sf_pt <<- suppressMessages(scanfi_download( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) + + expect_silent( + ponderosa_sf_poly <<- suppressMessages(scanfi_download( + data_buff(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) + + expect_silent( + ponderosa_terra_pt <<- suppressMessages(scanfi_download( + data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) + + expect_silent( + ponderosa_terra_poly <<- suppressMessages(scanfi_download( + data_buff(data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) + + expect_silent( + ponderosa_manualyear <<- suppressMessages(scanfi_download( + use_date = FALSE, + snapshot_year = c(2000, 2005), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) +}) + +test_that("Results downloaded from scanfi_download() have expected features.", { + expect_true(dir.exists("./testdir/scanfi")) # Bonus test of custom file path specification + + expect_true(all(file.exists( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ))) + expect_true(all( + file.size( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) > + 50000000 + )) # Check files contain a reasonable amount of data + + expect_true(inherits(ponderosa_sf_pt, "list")) + expect_named(ponderosa_sf_pt, c("2000", "2005")) + expect_true(inherits(ponderosa_sf_pt$`2000`, "list")) + expect_named(ponderosa_sf_pt$`2000`, "ponderosapine") + expect_s4_class(ponderosa_sf_pt$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_sf_pt$`2005`, "list")) + expect_named(ponderosa_sf_pt$`2005`, "ponderosapine") + expect_s4_class(ponderosa_sf_pt$`2005`$ponderosapine, "SpatRaster") + + expect_true(inherits(ponderosa_sf_poly, "list")) + expect_named(ponderosa_sf_poly, c("2000", "2005")) + expect_true(inherits(ponderosa_sf_poly$`2000`, "list")) + expect_named(ponderosa_sf_poly$`2000`, "ponderosapine") + expect_s4_class(ponderosa_sf_poly$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_sf_poly$`2005`, "list")) + expect_named(ponderosa_sf_poly$`2005`, "ponderosapine") + expect_s4_class(ponderosa_sf_poly$`2005`$ponderosapine, "SpatRaster") + + expect_true(inherits(ponderosa_terra_pt, "list")) + expect_named(ponderosa_terra_pt, c("2000", "2005")) + expect_true(inherits(ponderosa_terra_pt$`2000`, "list")) + expect_named(ponderosa_terra_pt$`2000`, "ponderosapine") + expect_s4_class(ponderosa_terra_pt$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_terra_pt$`2005`, "list")) + expect_named(ponderosa_terra_pt$`2005`, "ponderosapine") + expect_s4_class(ponderosa_terra_pt$`2005`$ponderosapine, "SpatRaster") + + expect_true(inherits(ponderosa_terra_poly, "list")) + expect_named(ponderosa_terra_poly, c("2000", "2005")) + expect_true(inherits(ponderosa_terra_poly$`2000`, "list")) + expect_named(ponderosa_terra_poly$`2000`, "ponderosapine") + expect_s4_class(ponderosa_terra_poly$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_terra_poly$`2005`, "list")) + expect_named(ponderosa_terra_poly$`2005`, "ponderosapine") + expect_s4_class(ponderosa_terra_poly$`2005`$ponderosapine, "SpatRaster") + + expect_true(inherits(ponderosa_manualyear, "list")) + expect_named(ponderosa_manualyear, c("2000", "2005")) + expect_true(inherits(ponderosa_manualyear$`2000`, "list")) + expect_named(ponderosa_manualyear$`2000`, "ponderosapine") + expect_s4_class(ponderosa_manualyear$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_manualyear$`2005`, "list")) + expect_named(ponderosa_manualyear$`2005`, "ponderosapine") + expect_s4_class(ponderosa_manualyear$`2005`$ponderosapine, "SpatRaster") + + expect_true(terra::is.related( + ponderosa_manualyear$`2000`$ponderosapine, + terra::project( + terra::vect(suppressMessages(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ))), + terra::crs(ponderosa_manualyear$`2000`$ponderosapine) + ), + "contains" + )) + + expect_true(terra::is.related( + ponderosa_manualyear$`2005`$ponderosapine, + terra::project( + terra::vect(suppressMessages(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ))), + terra::crs(ponderosa_manualyear$`2005`$ponderosapine) + ), + "contains" + )) + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) +}) + +test_that("scanfi_download() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + expect_silent( + ponderosa_attr <- suppressMessages(scanfi_download( + data_fmt( + dplyr::rename(bcch_restricted, "yr" = "survey_year"), + coord_lon = "longitude", + coord_lat = "latitude", + date_year = "yr", + crs = 4326 + ), + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )) + ) + + expect_true(all(file.exists( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ))) + expect_true(all( + file.size( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) > + 50000000 + )) + + expect_true(inherits(ponderosa_attr, "list")) + expect_named(ponderosa_attr, c("2000", "2005")) + expect_true(inherits(ponderosa_attr$`2000`, "list")) + expect_named(ponderosa_attr$`2000`, "ponderosapine") + expect_s4_class(ponderosa_attr$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_attr$`2005`, "list")) + expect_named(ponderosa_attr$`2005`, "ponderosapine") + expect_s4_class(ponderosa_attr$`2005`$ponderosapine, "SpatRaster") + + file.remove( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) + + expect_silent( + ponderosa_attr <- suppressMessages(scanfi_download( + dplyr::rename( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + "yr" = "survey_year" + ), + covariates = "scanfi_ponderosapine", + date_year = "yr", + dl_path = "./testdir", + progress = FALSE + )) + ) + + expect_true(all(file.exists( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ))) + expect_true(all( + file.size( + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2000_v2_20260119.tif", + "./testdir/scanfi/SCANFI_spsCC_ponderosaPine_2005_v2_20260119.tif" + ) > + 50000000 + )) + + expect_true(inherits(ponderosa_attr, "list")) + expect_named(ponderosa_attr, c("2000", "2005")) + expect_true(inherits(ponderosa_attr$`2000`, "list")) + expect_named(ponderosa_attr$`2000`, "ponderosapine") + expect_s4_class(ponderosa_attr$`2000`$ponderosapine, "SpatRaster") + expect_true(inherits(ponderosa_attr$`2005`, "list")) + expect_named(ponderosa_attr$`2005`, "ponderosapine") + expect_s4_class(ponderosa_attr$`2005`$ponderosapine, "SpatRaster") +}) + +test_that("scanfi_download() returns appropriate warnings and errors for misspecifed arguments", { + expect_error( + suppressMessages(scanfi_download( + dplyr::select( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + -"survey_year" + ), + covariates = "scanfi_ponderosapine", + date_year = "yr", + dl_path = "./testdir", + progress = FALSE + )), + "\\[SCANFI Download\\] some specified columns missing from the data: yr. Use arguments to specify alternate column names if using data that diverges from naturecounts default column names." + ) + + expect_error( + suppressMessages(scanfi_download( + use_date = FALSE, + snapshot_year = 2007, + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )), + "\\[SCANFI Download\\] Invalid snapshot year\\(s\\) provided to snapshot_year argument: 2007. Valid snapshot years are 1985, 1990, 1995, 2000, 2005, 2010, 2015, 2020, 2025." + ) + + expect_warning( + suppressMessages(scanfi_download( + data = data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + use_date = TRUE, + snapshot_year = 2005, + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )), + "\\[SCANFI Download\\] Specific snapshot years requested but use_date set as TRUE, suggesting function should determine necessary snapshots to download from years in data argument. Overriding and proceeding to download snapshots requested in snapshot_year." + ) + + bcch_modified <- bcch_restricted + bcch_modified$survey_year[1] <- 1975 + + expect_warning( + suppressMessages(scanfi_download( + data = data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + use_date = TRUE, + covariates = "scanfi_ponderosapine", + dl_path = "./testdir", + progress = FALSE + )), + "\\[SCANFI Download\\] Data contains years more than 5 years away from nearest SCANFI snapshot \\(1975\\). No value will be returned for observations in these years." + ) +}) + +test_that("scanfi_extract() throws appropriate error when inappropriate object provided to scanfi_data or argument is missing.", { + expect_error( + scanfi_extract(suppressWarnings(suppressMessages(data_fmt(bcch)))), + "\\[SCANFI Extraction\\] no SCANFI rasters provided to extract from. Please provide a list containing one entry for every snapshot year, each containing one raster for each listed SCANFI covariate. Data can be downloaded using scanfi_download\\(\\)." + ) + + expect_error( + scanfi_extract( + suppressWarnings(suppressMessages(data_fmt(bcch))), + scanfi_data = suppressWarnings(suppressMessages(data_fmt(bcch))) + ), + "\\[SCANFI Extraction\\] no SCANFI rasters provided to extract from. Please provide a list containing one entry for every snapshot year, each containing one raster for each listed SCANFI covariate. Data can be downloaded using scanfi_download\\(\\)." + ) +}) + +test_that("scanfi_extract() basic functionality with all expected data inputs.", { + sf_pt <- suppressWarnings(suppressMessages(data_fmt(bcch_restricted))) + sf_poly <- suppressWarnings(suppressMessages(data_buff(data_fmt( + bcch_restricted + )))) + terra_pt <- terra::vect(sf_pt) + terra_poly <- terra::vect(sf_poly) + + # Basic test of sf_pt input + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt + ))) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "integer")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$scanfi_ponderosapine))) + expect_true( + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2002]) == + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2000]) + ) + + # Basic test of sf_poly + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_poly, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_poly + ))) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "numeric")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_poly, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_poly, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$scanfi_ponderosapine))) + expect_true( + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2002]) == + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2000]) + ) + + # Basic test of terra_pt + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + terra_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_terra_pt + ))) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "integer")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + terra_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_terra_pt, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$scanfi_ponderosapine))) + expect_true( + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2002]) == + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2000]) + ) + + # Basic test of terra_poly + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + terra_poly, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_terra_poly + ))) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "numeric")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + terra_poly, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_terra_poly, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$scanfi_ponderosapine))) + expect_true( + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2002]) == + unique(extracted$scanfi_ponderosapine[extracted$survey_year == 2000]) + ) +}) + + +test_that("scanfi_extract() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + sf_pt <- suppressMessages(data_fmt( + dplyr::rename( + bcch_restricted, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + crs = 4326 + )) + + expect_warning( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + scanfi_data = ponderosa_sf_pt + )), + "\\[SCANFI Extraction\\] no covariates specified in the covariates argument. Proceeding to extract the covariates found in scanfi_data layers: scanfi_ponderosapine." + ) # Bonus test of whether leaving covariates unspecified works + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "integer")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + sf_pt <- dplyr::rename( + suppressMessages(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year" + ) + + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_pt, + scanfi_data = ponderosa_sf_pt, + site_name = "sites", + date_year = "yr" + ))) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "sites", + "latitude", + "longitude", + "yr", + "survey_month", + "survey_day", + "geometry", + "scanfi_ponderosapine" + ) + ) + expect_true(inherits(extracted$scanfi_ponderosapine, "integer")) + expect_equal( + dplyr::select(extracted, -"scanfi_ponderosapine"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$scanfi_ponderosapine[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$scanfi_ponderosapine[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) +}) + +test_that("scanfi_extract() returns appropriate warnings for out of coverage points and dates.", { + bcch_modified <- bcch_restricted[ + bcch_restricted$survey_year %in% c(2000, 2005), + ] + bcch_modified$latitude[1] <- 35 + + sf_pt <- suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )) + + expect_warning( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt + )), + "\\[SCANFI \\(ponderosapine\\) Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the SCANFI rasters provided. No value will be returned." + ) + + expect_true(is.na(extracted$scanfi_ponderosapine[1])) + + bcch_modified <- bcch_restricted[ + bcch_restricted$survey_year %in% c(2000, 2005), + ] + + bcch_modified$latitude[1] <- 44.98126 + bcch_modified$longitude[1] <- -73.63115 + + sf_poly <- suppressMessages(data_buff( + data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + buffer_distance = 10, + buffer_units = "km" + )) + + expect_warning( + extracted <- suppressMessages(scanfi_extract( + sf_poly, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_poly + )), + "\\[SCANFI \\(ponderosapine\\) Extraction\\] site FilledSurveyArea1's buffered area is only partially contained by the spatial extent of the SCANFI rasters provided. Returned ponderosapine value will be derived from the available values." + ) + + bcch_modified <- bcch_restricted[ + bcch_restricted$survey_year %in% c(2000, 2005), + ] + bcch_modified$survey_year <- 1990 + + sf_pt <- suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )) + + expect_error( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt + )), + "\\[SCANFI Extraction\\] Data does not contain observations within the SCANFI snapshot years \\(2000, 2005\\) in scanfi_data. If wanting to match interceding years to snapshots, use interpolate \\= TRUE." + ) + + bcch_modified <- bcch_restricted[ + bcch_restricted$survey_year %in% c(2000, 2005), + ] + bcch_modified$survey_year[1] <- 1990 + + sf_pt <- suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )) + + expect_warning( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt, + interpolate = TRUE + )), + "\\[SCANFI Download\\] Data contains years more than 5 years away from nearest SCANFI snapshot \\(1990\\). No value will be returned for observations in these years. Nearby \\(< 5 years away\\) snapshots are available for some data years \\(1990\\), but were not provided via the scanfi_data argument. These can be downloaded with scanfi_download\\(\\)." + ) + + bcch_modified <- bcch_restricted[ + bcch_restricted$survey_year %in% c(2000, 2005), + ] + bcch_modified$survey_year[1] <- 1970 + + sf_pt <- suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )) + + expect_warning( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_ponderosapine", + scanfi_data = ponderosa_sf_pt, + interpolate = TRUE + )), + "\\[SCANFI Download\\] Data contains years more than 5 years away from nearest SCANFI snapshot \\(1970\\). No value will be returned for observations in these years." + ) +}) + +# Tests for NFI Landcover - only run locally due to large filesize. + +skip("local only") + +test_that("scanfi_extract() functionality with NFI landcover data.", { + scanfi_lc <- scanfi_download( + bcch_restricted, + covariates = "scanfi_nfilc", + dl_path = "./testdir" + ) + + sf_pt <- suppressMessages(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )) + + expect_silent( + extracted <- suppressMessages(scanfi_extract( + sf_pt, + scanfi_data = scanfi_lc, + covariates = "scanfi_nfilc", + interpolate = FALSE + )) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "nfilc_class" + ) + ) + expect_true(inherits(extracted$nfilc_class, "character")) + expect_equal( + dplyr::select(extracted, -"nfilc_class"), + sf_pt, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$nfilc_class[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$nfilc_class[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_pt, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_lc, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$nfilc_class))) + expect_true( + extracted$nfilc_class[ + extracted$survey_year == 2003 & + extracted$SurveyAreaIdentifier == "FilledSurveyArea8" + ] == + extracted$nfilc_class[ + extracted$survey_year == 2005 & + extracted$SurveyAreaIdentifier == "FilledSurveyArea8" + ] + ) + + sf_poly <- suppressMessages(data_buff(sf_pt)) + + expect_silent( + extracted <- suppressMessages(scanfi_extract( + sf_poly, + scanfi_data = scanfi_lc, + covariates = "scanfi_nfilc", + interpolate = FALSE + )) + ) + + expect_s3_class(extracted, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "geometry", + "nfilc_bryoid", + "nfilc_herbs", + "nfilc_rock", + "nfilc_shrub", + "nfilc_treed_broadleaf", + "nfilc_treed_conifer", + "nfilc_treed_mixed", + "nfilc_water" + ) + ) + expect_true(inherits(extracted$nfilc_bryoid, "numeric")) + expect_equal( + dplyr::select(extracted, -tidyselect::starts_with("nfilc_")), + sf_poly, + ignore_attr = TRUE + ) # Ignores attributes to confirm that data has not been otherwise modified. + expect_equal(format(sf::st_crs(extracted)), "Canada_Albers_Equal_Area_Conic") + expect_true(all(is.na(extracted$nfilc_bryoid[ + !(extracted$survey_year %in% c(2000, 2005)) + ]))) + expect_true(all( + !is.na(extracted$nfilc_bryoid[ + extracted$survey_year %in% c(2000, 2005) + ]) + )) + + # Test interpolation + expect_silent( + extracted <- suppressWarnings(suppressMessages(scanfi_extract( + sf_poly, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_lc, + interpolate = TRUE + ))) + ) + + expect_true(all(!is.na(extracted$nfilc_bryoid))) + expect_true( + extracted$nfilc_bryoid[ + extracted$survey_year == 2003 & + extracted$SurveyAreaIdentifier == "FilledSurveyArea8" + ] == + extracted$nfilc_bryoid[ + extracted$survey_year == 2005 & + extracted$SurveyAreaIdentifier == "FilledSurveyArea8" + ] + ) +}) + +unlink("./testdir", recursive = TRUE) diff --git a/tests/testthat/test_19_daymet.R b/tests/testthat/test_19_daymet.R new file mode 100644 index 00000000..84703052 --- /dev/null +++ b/tests/testthat/test_19_daymet.R @@ -0,0 +1,651 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +bcch_restricted <- bcch[ + bcch$survey_year == 2011 & bcch$survey_month %in% c(1:6), +] + +skip("local only") + +test_that("daymet_request() submits requests successfully with all expected inputs.", { + expect_silent( + requests_sf_pt <<- suppressMessages(daymet_request( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "sf_pt", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + expect_silent( + requests_sf_poly <<- suppressMessages(daymet_request( + data_buff(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "sf_poly", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + expect_silent( + requests_terra_pt <<- suppressMessages(daymet_request( + data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "terra_pt", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + expect_silent( + requests_terra_poly <<- suppressMessages(daymet_request( + data_buff(data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "terra_poly", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + expect_true(all( + inherits(requests_sf_pt, "data.frame"), + inherits(requests_sf_poly, "data.frame"), + inherits(requests_terra_pt, "data.frame"), + inherits(requests_terra_poly, "data.frame") + )) + + expect_named(requests_sf_pt, c("request_name", "request_id", "date")) + expect_named(requests_sf_poly, c("request_name", "request_id", "date")) + expect_named(requests_terra_pt, c("request_name", "request_id", "date")) + expect_named(requests_terra_poly, c("request_name", "request_id", "date")) + + dates <- sort(unique(paste0( + bcch_restricted$survey_year, + "-", + ifelse( + nchar(bcch_restricted$survey_month) == 1, + paste0(0, bcch_restricted$survey_month), + bcch_restricted$survey_month + ), + "-", + ifelse( + nchar(bcch_restricted$survey_day) == 1, + paste0(0, bcch_restricted$survey_day), + bcch_restricted$survey_day + ) + ))) + + expect_true(nrow(requests_sf_pt) == length(dates)) + expect_true(nrow(requests_sf_poly) == length(dates)) + expect_true(nrow(requests_terra_pt) == length(dates)) + expect_true(nrow(requests_terra_poly) == length(dates)) + + expect_true(all( + substr(requests_sf_pt$request_name, start = 1, stop = 5) == "sf_pt" + )) + expect_true(all( + substr( + requests_sf_pt$request_name, + start = nchar(requests_sf_pt$request_name) - 9, + stop = nchar(requests_sf_pt$request_name) + ) == + dates + )) + expect_true(all( + substr(requests_sf_poly$request_name, start = 1, stop = 7) == "sf_poly" + )) + expect_true(all( + substr( + requests_sf_poly$request_name, + start = nchar(requests_sf_poly$request_name) - 9, + stop = nchar(requests_sf_poly$request_name) + ) == + dates + )) + expect_true(all( + substr(requests_terra_pt$request_name, start = 1, stop = 8) == "terra_pt" + )) + expect_true(all( + substr( + requests_terra_pt$request_name, + start = nchar(requests_terra_pt$request_name) - 9, + stop = nchar(requests_terra_pt$request_name) + ) == + dates + )) + expect_true(all( + substr(requests_terra_poly$request_name, start = 1, stop = 10) == + "terra_poly" + )) + expect_true(all( + substr( + requests_terra_poly$request_name, + start = nchar(requests_terra_poly$request_name) - 9, + stop = nchar(requests_terra_poly$request_name) + ) == + dates + )) + + expect_true(all(dates %in% requests_sf_pt$date)) + expect_true(all(dates %in% requests_sf_poly$date)) + expect_true(all(dates %in% requests_terra_pt$date)) + expect_true(all(dates %in% requests_terra_poly$date)) +}) + +skip("local only") + +test_that("daymet_request() succeeds with alternate column names, either passed through attributes or specified explicitly.", { + expect_silent( + requests_attr <- suppressMessages(daymet_request( + data_fmt( + dplyr::rename( + bcch_restricted, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ), + coord_lon = "longitude", + coord_lat = "latitude", + site_name = "sites", + date_year = "yr", + date_month = "mth", + date_day = "dy", + crs = 4326 + ), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "colnames_attrs", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + expect_silent( + requests_explicit <- suppressMessages(daymet_request( + dplyr::rename( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "colnames_explicit", + site_name = "sites", + date_year = "yr", + date_month = "mth", + date_day = "dy", + dl_path = "./testdir", + save = TRUE, + verbose = FALSE + )) + ) +}) + +skip("local only") + +test_that("daymet_check() basic functionality", { + expect_silent( + status <- daymet_check( + daymet_reqs = requests_explicit, + ed_username = "rdjmacklin_bc", + verbose = FALSE + ) + ) + + expect_silent( + status_path <- daymet_check( + daymet_reqs = "./testdir/daymet/colnames_explicit.RDS", + ed_username = "rdjmacklin_bc", + verbose = FALSE + ) + ) + + expect_true(inherits(status, "data.frame")) + expect_named( + status, + c("request_name", "request_id", "date", "status", "expires_on") + ) + expect_true(identical(status, status_path)) + expect_true(all(requests_explicit$request_name %in% status$request_name)) +}) + +skip("local only") + +test_that("daymet_check() expected error messages", { + expect_error( + daymet_check( + daymet_reqs = "./fake/file/path.rds", + ed_username = "rdjmacklin_bc", + verbose = FALSE + ), + "\\[Daymet Request Checking\\] daymet_reqs in an unexpected format. Please provide either a data.frame with a column for the AppEEARS request name called request_name and a column for the AppEEARS request ID called request_id, or a filepath to a .rds file created by daymet_request\\(\\) containing such data." + ) + + expect_error( + daymet_check( + daymet_reqs = 27, + ed_username = "rdjmacklin_bc", + verbose = FALSE + ), + "\\[Daymet Request Checking\\] daymet_reqs in an unexpected format. Please provide either a data.frame with a column for the AppEEARS request name called request_name and a column for the AppEEARS request ID called request_id, or a filepath to a .rds file created by daymet_request\\(\\) containing such data." + ) + + bad_reqs <- requests_explicit + names(bad_reqs)[1] <- "rq_nm" + + expect_error( + daymet_check( + daymet_reqs = bad_reqs, + ed_username = "rdjmacklin_bc", + verbose = FALSE + ), + "\\[Daymet Request Checking\\] daymet_reqs in an unexpected format. Please provide either a data.frame with a column for the AppEEARS request name called request_name and a column for the AppEEARS request ID called request_id, or a filepath to a .rds file created by daymet_request\\(\\) containing such data." + ) + + bad_reqs <- requests_explicit + bad_reqs$request_id <- 1:nrow(requests_explicit) + + invisible(capture.output( + errmsg <- cat( + "\\[Daymet Request Checking\\] request(s) ", + stringr::str_flatten_comma(bad_reqs$request_name), + " provided in daymet_reqs are not registered under EarthData user rdjmacklin_bc. Are they more than a month old \\(i.e., expired\\), or entered incorrectly\\?" + ) + )) + + expect_error( + daymet_check( + daymet_reqs = bad_reqs, + ed_username = "rdjmacklin_bc", + verbose = FALSE + ), + errmsg + ) +}) + +skip("local only") + +test_that("daymet_download() successfully downloads files from completed requests.", { + expect_silent( + downloads_sf_pt <<- daymet_download( + daymet_reqs = requests_sf_pt, + ed_username = "rdjmacklin_bc", + dl_path = "./testdir", + verbose = FALSE + ) + ) + + expected_dirs <- paste0("./testdir/daymet/", requests_sf_pt$request_name) + expect_true(all(dir.exists(expected_dirs))) + expect_true(all(file.exists(paste0( + expected_dirs, + "/DAYMET-004-Statistics.csv" + )))) + + for (i in requests_sf_pt$request_name) { + daymet_stats <- readr::read_csv( + paste0("./testdir/daymet/", i, "/DAYMET-004-Statistics.csv"), + show_col_types = FALSE + ) + + filename <- gsub( + pattern = "DAYMET_", + replacement = "DAYMET.", + daymet_stats$`File Name`[ + daymet_stats$Date == + requests_sf_pt$date[requests_sf_pt$request_name == i] & + daymet_stats$Dataset == "prcp" + ] + ) + + expect_true(file.exists(paste0( + "./testdir/daymet/", + i, + "/", + filename, + ".tif" + ))) + expect_true( + file.size(paste0("./testdir/daymet/", i, "/", filename, ".tif")) > 2000 + ) + } +}) + +skip("local only") + +test_that("daymet_download() fails when a request is incomplete.", { + expect_silent( + requests_fresh <- suppressMessages(daymet_request( + data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + ed_username = "rdjmacklin_bc", + covariates = "daymet_prcp", + request_name = "fresh", + dl_path = "./testdir", + save = FALSE, + verbose = FALSE + )) + ) + + invisible(capture.output( + errmsg <- cat( + "\\[Daymet Download\\] some supplied Daymet requests are incomplete. Please wait for confirmation at the email address associated with your EarthData account 'rdjmacklin_bc' or use daymet_check\\(\\) to confirm that requests with the following request IDs are complete: ", + stringr::str_flatten_comma(requests_fresh$request_name), + "." + ) + )) + + expect_error( + downloads_sf_pt <- daymet_download( + daymet_reqs = requests_fresh, + ed_username = "rdjmacklin_bc", + dl_path = "./testdir", + verbose = FALSE + ), + errmsg + ) +}) + +skip("local only") + +test_that("daymet_extract() basic functionality with all expected inputs.", { + expect_silent( + downloads_sf_poly <<- daymet_download( + daymet_reqs = requests_sf_poly, + ed_username = "rdjmacklin_bc", + dl_path = "./testdir", + verbose = FALSE + ) + ) + + expect_silent( + downloads_terra_pt <<- daymet_download( + daymet_reqs = requests_terra_pt, + ed_username = "rdjmacklin_bc", + dl_path = "./testdir", + verbose = FALSE + ) + ) + + expect_silent( + downloads_terra_poly <<- daymet_download( + daymet_reqs = requests_terra_poly, + ed_username = "rdjmacklin_bc", + dl_path = "./testdir", + verbose = FALSE + ) + ) + + expect_output( + extracted_sf_pt <- daymet_extract( + data = suppressMessages(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + daymet_reqs = downloads_sf_pt, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\n" + ) + + expect_output( + extracted_sf_poly <- daymet_extract( + data = suppressMessages(data_buff(data_fmt( + bcch_restricted, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ))), + daymet_reqs = downloads_sf_poly, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\n" + ) + + expect_output( + extracted_terra_pt <- daymet_extract( + data = suppressMessages(data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + ))), + daymet_reqs = downloads_terra_pt, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\n" + ) + + expect_output( + extracted_terra_poly <- daymet_extract( + data = suppressMessages(data_buff(data_fmt(terra::vect( + bcch_restricted, + crs = "epsg:4326", + geom = c("longitude", "latitude") + )))), + daymet_reqs = downloads_terra_poly, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\n" + ) + + expect_s3_class(extracted_sf_pt, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted_sf_pt, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted_sf_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "prcp", + "geometry" + ) + ) + expect_true(inherits(extracted_sf_pt$prcp, "numeric")) + expect_equal( + format(sf::st_crs(extracted_sf_pt)), + "Canada_Albers_Equal_Area_Conic" + ) + expect_true(all(!is.na(extracted_sf_pt$prcp))) + + expect_s3_class(extracted_sf_poly, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted_sf_poly, by_geometry = FALSE)), + "POLYGON" + ) + expect_named( + extracted_sf_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "prcp", + "geometry" + ) + ) + expect_true(inherits(extracted_sf_poly$prcp, "numeric")) + expect_equal( + format(sf::st_crs(extracted_sf_poly)), + "Canada_Albers_Equal_Area_Conic" + ) + expect_true(all(!is.na(extracted_sf_poly$prcp))) + + expect_s3_class(extracted_terra_pt, "sf") + expect_equal( + as.character(sf::st_geometry_type(extracted_terra_pt, by_geometry = FALSE)), + "POINT" + ) + expect_named( + extracted_terra_pt, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "prcp", + "geometry" + ) + ) + expect_true(inherits(extracted_terra_pt$prcp, "numeric")) + expect_equal( + format(sf::st_crs(extracted_terra_pt)), + "Canada_Albers_Equal_Area_Conic" + ) + expect_true(all(!is.na(extracted_terra_pt$prcp))) + + expect_s3_class(extracted_terra_poly, "sf") + expect_equal( + as.character(sf::st_geometry_type( + extracted_terra_poly, + by_geometry = FALSE + )), + "POLYGON" + ) + expect_named( + extracted_terra_poly, + c( + "SurveyAreaIdentifier", + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "prcp", + "geometry" + ) + ) + expect_true(inherits(extracted_terra_poly$prcp, "numeric")) + expect_equal( + format(sf::st_crs(extracted_terra_poly)), + "Canada_Albers_Equal_Area_Conic" + ) + expect_true(all(!is.na(extracted_terra_poly$prcp))) +}) + +skip("local only") + +test_that("daymet_extract() returns warnings and errors for out of coverage dates and sites.", { + bcch_modified <- bcch_restricted + bcch_modified$survey_year[1] <- 2010 + + expect_warning( + extracted_sf_pt <- daymet_extract( + data = suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + daymet_reqs = downloads_sf_pt, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\\[Daymet Extraction\\] data has not been provided for some dates. These are: 2010-02-12. No value will be returned for these dates. Keep in mind that Daymet data for the current year may not be available yet." + ) + + bcch_modified <- bcch_restricted + bcch_modified$latitude[1] <- 80 + + expect_warning( + extracted_sf_pt <- daymet_extract( + data = suppressMessages(data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + )), + daymet_reqs = downloads_sf_pt, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\\[Daymet \\(prcp\\) Extraction\\] site FilledSurveyArea1 falls outside of the spatial extent of the DAYMET rasters provided. No value will be returned." + ) + + bcch_modified <- bcch_restricted + bcch_modified$latitude[1] <- 46.13 + + expect_warning( + extracted_sf_poly <- daymet_extract( + data = suppressMessages(data_buff( + data_fmt( + bcch_modified, + coord_lon = "longitude", + coord_lat = "latitude", + crs = 4326 + ), + buffer_distance = 5, + buffer_units = "km" + )), + daymet_reqs = downloads_sf_pt, + covariates = "daymet_prcp", + dl_path = "./testdir", + verbose = FALSE + ), + "\\[Daymet \\(prcp\\) Extraction\\] site FilledSurveyArea1's buffered area is only partially contained by the spatial extent of the DAYMET rasters provided. Returned prcp value will be derived from the available values." + ) +}) + +unlink("./testdir", recursive = TRUE) diff --git a/tests/testthat/test_20_covariate_merging.R b/tests/testthat/test_20_covariate_merging.R new file mode 100644 index 00000000..65e58732 --- /dev/null +++ b/tests/testthat/test_20_covariate_merging.R @@ -0,0 +1,935 @@ +if (!dir.exists("./testdir")) { + dir.create("./testdir") +} + +test_that("nc_covariates_merge() succeeds with data.frame, sf, and terra point inputs.", { + # Test with original_data = data.frame + formatted <- suppressWarnings(suppressMessages(data_fmt(bcch))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = bcch, + covariate_data = extracted + ) + ) + + expect_equal(c(names(bcch), "elevation", "ndvi"), names(merged)) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + # Test with original_data = sf POINT + formatted <- suppressWarnings(suppressMessages(data_fmt(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + )))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ), + covariate_data = extracted + ) + ) + + expect_equal( + c( + names(sf::st_drop_geometry(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ))), + "elevation", + "ndvi", + "geometry" + ), + names(merged) + ) + + original_match <- merged %>% + cbind(., sf::st_coordinates(.)) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") %>% + sf::st_drop_geometry() %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + # Test with original_data = terra point + formatted <- suppressWarnings(suppressMessages(data_fmt(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + )))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + ), + covariate_data = extracted + ) + ) + + expect_equal( + c( + names(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + )), + "elevation", + "ndvi" + ), + names(merged) + ) + + original_match <- merged %>% + cbind( + ., + terra::crds(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + )) + ) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") %>% + as.data.frame() %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) +}) + +test_that("nc_covariates_merge() succeeds with data.frame, sf, and terra polygon inputs.", { + formatted <- suppressWarnings(suppressMessages(data_buff(data_fmt(bcch)))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = bcch, + covariate_data = extracted + ) + ) + + expect_equal(c(names(bcch), "elevation", "ndvi"), names(merged)) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + # Test with original_data = sf POLYGON + formatted <- suppressWarnings(suppressMessages(data_fmt(data_buff(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ))))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = suppressMessages(data_buff(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ))), + covariate_data = extracted + ) + ) + + expect_equal( + c( + names(sf::st_drop_geometry(suppressMessages(data_buff(sf::st_as_sf( + bcch, + coords = c("longitude", "latitude"), + crs = 4326 + ))))), + "elevation", + "ndvi", + "geometry" + ), + names(merged) + ) + + original_match <- merged %>% + cbind(., sf::st_coordinates(suppressWarnings(sf::st_centroid(.)))) %>% + dplyr::rename("longitude" = "X", "latitude" = "Y") %>% + sf::st_drop_geometry() %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + # Test with original_data = terra polygons + formatted <- suppressWarnings(suppressMessages(data_fmt(data_buff(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + ))))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = suppressMessages(data_buff(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + ))), + covariate_data = extracted + ) + ) + + expect_equal( + c( + names(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + )), + "elevation", + "ndvi" + ), + names(merged) + ) + + original_match <- merged %>% + cbind( + ., + terra::crds(terra::centroids(suppressMessages(data_buff(terra::vect( + bcch, + geom = c("longitude", "latitude"), + crs = "epsg:4326" + ))))) + ) %>% + dplyr::rename("longitude" = "x", "latitude" = "y") %>% + as.data.frame() %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "survey_month", + "survey_day", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$survey_month, + .data$survey_day + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) +}) + +test_that("nc_covariates_merge() succeeds with alternate column names, either specified explicitly or passed through attributes.", { + formatted <- suppressWarnings(suppressMessages(data_fmt( + dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ), + site_name = "sites", + date_year = "yr", + date_month = "mth", + date_day = "dy" + ))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ), + covariate_data = extracted + ) + ) + + expect_equal( + c( + names(dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + )), + "elevation", + "ndvi" + ), + names(merged) + ) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "yr", + "mth", + "dy", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$yr, + .data$mth, + .data$dy + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "yr", + "mth", + "dy", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$yr, + .data$mth, + .data$dy + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + formatted <- suppressWarnings(suppressMessages(data_fmt(bcch))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + extracted <- dplyr::rename( + extracted, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ) + bcch <- dplyr::rename( + bcch, + "sites" = "SurveyAreaIdentifier", + "yr" = "survey_year", + "mth" = "survey_month", + "dy" = "survey_day" + ) + + expect_silent( + merged <- nc_covariates_merge( + original_data = bcch, + covariate_data = extracted, + site_name = "sites", + date_year = "yr", + date_month = "mth", + date_day = "dy" + ) + ) + + expect_equal(c(names(bcch), "elevation", "ndvi"), names(merged)) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "yr", + "mth", + "dy", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$yr, + .data$mth, + .data$dy + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "yr", + "mth", + "dy", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$yr, + .data$mth, + .data$dy + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) +}) + +test_that("nc_covariates_merge() succeeds with lubridate or ordinal dates.", { + bcch_lubridate <- bcch %>% + dplyr::mutate( + date = as.Date(paste0( + .data$survey_year, + "-", + .data$survey_month, + "-", + .data$survey_day + )), + .keep = "unused" + ) + + formatted <- suppressWarnings(suppressMessages(data_fmt( + bcch_lubridate, + date_lubridate = "date" + ))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = bcch_lubridate, + covariate_data = extracted, + date_lubridate = "date" + ) + ) + + expect_equal(c(names(bcch_lubridate), "elevation", "ndvi"), names(merged)) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "date", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$date + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "date", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$date + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) + + bcch_ordinal <- bcch_lubridate %>% + dplyr::mutate( + survey_year = lubridate::year(.data$date), + doy = lubridate::yday(.data$date), + .keep = "unused" + ) + + formatted <- suppressWarnings(suppressMessages(data_fmt( + bcch_ordinal, + date_ordinal = "doy" + ))) + + elev <- suppressMessages(elevation_download( + data = formatted, + dl_path = "./testdir", + progress = FALSE + )) + + extracted <- suppressMessages(elevation_extract( + data = formatted, + elevation_data = elev + )) + + vegetation <- suppressWarnings(suppressMessages(vegetation_download( + data = extracted, + ed_email = "rmacklin@birdscanada.org", + dl_path = "./testdir", + progress = FALSE + ))) + + extracted <- suppressWarnings(suppressMessages(vegetation_extract( + data = extracted, + covariates = "modis_ndvi", + vegetation_files = vegetation + ))) + + expect_silent( + merged <- nc_covariates_merge( + original_data = bcch_ordinal, + covariate_data = extracted, + date_ordinal = "doy" + ) + ) + + expect_equal(c(names(bcch_ordinal), "elevation", "ndvi"), names(merged)) + + original_match <- merged %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "doy", + "elevation", + "ndvi" + ) %>% + dplyr::distinct() %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$doy + ) + + covariate_match <- extracted %>% + dplyr::select( + "latitude", + "longitude", + "survey_year", + "doy", + "elevation", + "ndvi" + ) %>% + dplyr::arrange( + .data$latitude, + .data$longitude, + .data$survey_year, + .data$doy + ) %>% + sf::st_drop_geometry() + + expect_true(identical(original_match, covariate_match)) +}) diff --git a/vignettes/articles/4.1-CovariateFormatting.Rmd b/vignettes/articles/4.1-CovariateFormatting.Rmd new file mode 100644 index 00000000..c50e88b4 --- /dev/null +++ b/vignettes/articles/4.1-CovariateFormatting.Rmd @@ -0,0 +1,374 @@ +--- +title: "Chapter 1 - Formatting Data for Covariate Download and Extraction" +author: "Rory Macklin" +date: "2026-03-25" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 1 - Formatting Data for Covariate Download and Extraction} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + +# Chapter 1: Formatting Data for Covariate Download and Extraction + +##### Author: Rory Macklin + +> Satellite Earth Observation (SEO) data are an increasingly critical tool in ecological analysis, but can be difficult for end-users to access. With the functions we describe in this chapter, we aim to make several commonly used data types easy to download and attach to bird data downloaded from NatureCounts. The first step in this process is often formatting your bird data to prepare it for use in extracting data from covariate data sets. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. + +# 1.0 Learning Objectives + +By the end of **Chapter 1 - Formatting Data for Covariate Download and Extraction**, users will know how to: + +- Use `data_fmt()` to conform their data (whether it is from NatureCounts or not) to a standard format for covariate extraction: [Formatting with `data_fmt()`](#1.1formatting). +- Use `data_buff()` to create spatial buffers around their survey points to summarize environmental variables at larger scales: [Buffering with `data_buff()`](#1.2buffering). + +This R tutorial requires the following packages: + + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 1.1 Formatting with `data_fmt()`{#1.1formatting} + +Extracting environmental data usually requires a few data features, all of which are commonly collected during ecological surveys. These usually include: + +- The location where observations were made (usually a latitude/longitude coordinate). +- The date on which observations were made. + +However, these can often be collected and encoded in inconsistent formats. Here, we provide a function to standardize common data storage formats in R for spatial coordinates and date data. This function will return the input data in a spatial format necessary for extracting data from raster datasets, and with standardized sets of columns. + +This function accepts data in five formats: + +- A `data.frame` with columns containing the spatial X-coordinate (usually longitude), the spatial Y-coordinate (usually latitude), and date data. +- An `sf` object, in either `POINT` or `POLYGON` format with coordinate information stored in the `geometry` column inherent to all `sf` objects and column(s) containing date data. +- A `terra` object, in either `points` or `polygons` format with coordinate information stored in the object structure inherent to `terra` and column(s) containing date data. + +Date data can be supplied in a variety of formats also. These include: + +- Three columns: one for year, one for month (either month name or a number 1-12), and one for day of the month (1-31). +- In one column in the native R `Date` format often manipulated using the `lubridate` package. +- In two columns, one containing year data, and the other containing the day of the year (1-365), often referred to as Julian or Ordinal date. + +This function is designed to work most directly with data downloaded from NatureCounts in the BMDE format, but options have been included to allow great flexibility in input data. Let's run through an example using some data from NatureCounts, and demonstrate how other data inputs can be included. + + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() +#> latitude longitude survey_year survey_month survey_day +#> 1 45.51110 -77.50533 2011 2 12 +#> 2 45.63436 -77.07484 2010 7 3 +#> 3 45.82732 -77.12012 2010 6 19 +#> 4 45.48730 -77.74651 2011 5 5 +#> 5 45.61956 -77.23577 2010 6 16 +#> 6 45.82851 -77.11430 2011 10 2 + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day geometry +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 POINT (1444206 799722.4) +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 POINT (1473174 822088.3) +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 POINT (1463861 841469.8) +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 POINT (1426543 792053.4) +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 POINT (1461424 817010.6) +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 POINT (1464264 841722.6) +``` + +Running this call to `data_fmt()` has returned our processed data object with a warning! This warning is simply telling us that as we did not explicitly specify the coordinate reference system (CRS), the function has assumed it is in the [World Geodetic System 1984](https://epsg.io/4326) CRS, the standard latitude/longitude system used in many mapping operations. This is fine for us as this CRS is appropriate for our data! + +The outputted object `formatted` has been transformed into an `sf` object in a `POINT` geometry (as previously mentioned, in the WGS84 CRS). All of our original input columns (latitude, longitude, date data) have been left as they were as they are all columns we need down the road for the covariate download and extraction process, and were already in the standardized format we use therein. + +You will also notice that a column with site names has been added! In `bcch`, no site names are provided, and so for convenience, the function has created site names for each unique location in the dataset. In many BMDE datasets, site names will be provided in the `SurveyAreaIdentifier` column, or in columns under other names in non-BMDE data. These are often a more human-readable way of identifying the different locations in a dataset, but are not strictly necessary for our operations here. + +So, what if your data is a little less standard than this? + + +``` r +# Let's modify the bcch object to make a more "non-standard" dataset. +bcch_modified <- bcch %>% + st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>% + st_transform("ESRI:102001") # Change the CRS to Canada Albers Equal Area + # Conic + +# Extract the coordinates in this new CRS format. +coordinates <- st_coordinates(bcch_modified) + +# Convert our object back to a data.frame +bcch_modified <- st_drop_geometry(bcch_modified) + +# Join the new coordinate data to our original data +bcch_modified <- cbind(bcch_modified, coordinates) + +# Take a look! No more latitude/longitude column, only an X/Y column in a totally +# different coordinate format! +bcch_modified %>% + select(X, Y, survey_year, survey_month, survey_day) %>% + head() +#> X Y survey_year survey_month survey_day +#> 1 1444206 799722.4 2011 2 12 +#> 2 1473174 822088.3 2010 7 3 +#> 3 1463861 841469.8 2010 6 19 +#> 4 1426543 792053.4 2011 5 5 +#> 5 1461424 817010.6 2010 6 16 +#> 6 1464264 841722.6 2011 10 2 + +# Now, if we supply this to data_fmt(), it's assumption that the data is in WGS84 +# would be wrong, and it wouldn't know where to look to find the coordinate data! +# We can use special arguments to get around this! +formatted <- data_fmt(bcch_modified, + coord_lon = "X", # Here's the name of the column that + # contains our X-coordinate, + coord_lat = "Y", # Here's the name of the column that + # contains our Y-coordinate, + crs = "ESRI:102001") # Here's the alternate CRS code we used! +#> [Data Formatting] beginning formatting. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier Y X survey_year survey_month survey_day geometry +#> 1 FilledSurveyArea1 799722.4 1444206 2011 2 12 POINT (1444206 799722.4) +#> 2 FilledSurveyArea2 822088.3 1473174 2010 7 3 POINT (1473174 822088.3) +#> 3 FilledSurveyArea3 841469.8 1463861 2010 6 19 POINT (1463861 841469.8) +#> 4 FilledSurveyArea4 792053.4 1426543 2011 5 5 POINT (1426543 792053.4) +#> 5 FilledSurveyArea5 817010.6 1461424 2010 6 16 POINT (1461424 817010.6) +#> 6 FilledSurveyArea6 841722.6 1464264 2011 10 2 POINT (1464264 841722.6) +``` + +Phew, no errors! By telling the function where important information is stored, we can supply data in different formats and still prepare our data for use in covariate download and extraction. Let's see some other customization features we can use. + + +``` r +# What if we use non-BMDE column names with our data? We'll also add some more +# human-readable site names and ask data_fmt() to look in a non-BMDE column name +# for them. +bcch_renamed <- bcch %>% + rename(year = survey_year, + monthofyear = survey_month, + dayofmonth = survey_day, + lat = latitude, + lon = longitude) %>% + select(-SurveyAreaIdentifier) # Remove the standard site name column + +# Fetch all unique latitude/longitude combinations and give each one a name! +sitenames <- bcch_renamed %>% + select(lat, lon) %>% + distinct() + +sitenames$sitename <- paste0("Site", 1:nrow(sitenames)) + +# Reattach these to our renamed data +bcch_renamed <- left_join(bcch_renamed, sitenames, by = c("lat", "lon")) + +# Let's give our data to data_fmt() and customize the column names as needed +formatted <- data_fmt(bcch_renamed, + site_name = "sitename", + coord_lon = "lon", + coord_lat = "lat", + date_year = "year", + date_month = "monthofyear", + date_day = "dayofmonth") +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> sitename lat lon year monthofyear dayofmonth geometry +#> 1 Site1 45.51110 -77.50533 2011 2 12 POINT (1444206 799722.4) +#> 2 Site2 45.63436 -77.07484 2010 7 3 POINT (1473174 822088.3) +#> 3 Site3 45.82732 -77.12012 2010 6 19 POINT (1463861 841469.8) +#> 4 Site4 45.48730 -77.74651 2011 5 5 POINT (1426543 792053.4) +#> 5 Site5 45.61956 -77.23577 2010 6 16 POINT (1461424 817010.6) +#> 6 Site6 45.82851 -77.11430 2011 10 2 POINT (1464264 841722.6) +``` + +As we can see, the function has happily accepted our alternate columns and has used them appropriately! This flexibility allows even those working with data outside of standard BMDE formats present in NatureCounts make use of these functions and those down the line to download and extract covariate data. + +Finally, what if we are using an alternate date format? So far, all examples have used the three column approach - one for year, one for month, and one for day. Below, we demonstrate how other date formats can be accommodated in `data_fmt()`. + + +``` r + +# First, lets experiment with a column in date format. We'll make one below. +bcch_date <- bcch %>% + mutate(date = as.Date(paste0(survey_day, "-", survey_month, "-", survey_year), + format = "%d-%m-%Y")) + +head(bcch_date$date) +#> [1] "2011-02-12" "2010-07-03" "2010-06-19" "2011-05-05" "2010-06-16" "2011-10-02" + +# Feed into data_fmt() with the argument date_lubridate pointing the function to where date +# data is stored. + +formatted <- data_fmt(bcch_date, + date_lubridate = "date") +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude date survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011-02-12 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010-07-03 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010-06-19 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011-05-05 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010-06-16 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011-10-02 2011 10 2 +#> geometry +#> 1 POINT (1444206 799722.4) +#> 2 POINT (1473174 822088.3) +#> 3 POINT (1463861 841469.8) +#> 4 POINT (1426543 792053.4) +#> 5 POINT (1461424 817010.6) +#> 6 POINT (1464264 841722.6) + +# Now, lets try using ordinal date! +bcch_ordinal <- bcch_date %>% + mutate(dayofyear = yday(date)) + +# For ordinal date data, we need to provide the year and day-of-year column names. We'll let +# data_fmt() look for year data in the default BMDE column 'survey_year'. +formatted <- data_fmt(bcch_ordinal, + date_ordinal = "dayofyear") +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year dayofyear survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 43 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 184 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 170 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 125 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 167 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 275 10 2 +#> geometry +#> 1 POINT (1444206 799722.4) +#> 2 POINT (1473174 822088.3) +#> 3 POINT (1463861 841469.8) +#> 4 POINT (1426543 792053.4) +#> 5 POINT (1461424 817010.6) +#> 6 POINT (1464264 841722.6) +``` + +As we can see, in both cases date data is extracted from the supplied `Date` formatted column or ordinal date data, and is provided alongside the original input format in the output of `data_fmt()`. + +Finally, spatial data is commonly encoded using `sf` or `terra` objects in R. This function is adaptable to those formats, so long as `sf` objects are `POINTS` or `POLYGONS` geometries, or `terra` objects are `points` or `polygons` geometries. In these cases, `data_fmt()` will return the data in the spatial format it was provided in (i.e., if a `terra` object is provided, the final output data will also be a `terra` object). + +With these options all laid out, you should be able to use `data_fmt()` to standardize your data, whether it is from NatureCounts or not, and use it in later functions for covariate download and extraction. + +# 1.2 Buffering with `data_buff()`{#1.2buffering} + +When extracting covariate data, it is often desirable to summarize environmental covariates at different spatial scales. This can lead to interesting ecological insight into how birds respond to environmental conditions at different scales (Tozer et al. 2010). This is achieved by creating a spatial buffer of a given distance around an observation point, and examining all environmental variable values that fall within the buffered area. + +`data_buff()` accepts data in four formats: + +- An `sf` object with `POINT` or `POLYGON` geometry. +- A `terra` object with `point` or `polygons` geometry. + +Users with `data.frame` data may consider using `data_fmt()` to convert their data to the appropriate format for use in `data_buff()`. + +Buffers of a 500 meter radius are commonly applied to represent the breeding territory size of most small- to medium-sized birds (Lee et al. 2021), so we will demonstrate the application of one to our `bcch` data here. + + +``` r +# We will convert the bcch dataset to the appropriate data format using data_fmt() and will disregard the warning as EPSG:4326 is the appropriate CRS for these data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +# Now, we use data_buff() to apply a 500 m radius buffer around each point. + +buffered <- data_buff(formatted, + buffer_distance = 500, + buffer_units = "m") +#> [Data Buffering] buffering sites by 500m radius (default). + +head(buffered) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1426043 ymin: 791553.4 xmax: 1473674 ymax: 842222.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 +#> geometry +#> 1 POLYGON ((1444706 799722.4,... +#> 2 POLYGON ((1473674 822088.3,... +#> 3 POLYGON ((1464361 841469.8,... +#> 4 POLYGON ((1427043 792053.4,... +#> 5 POLYGON ((1461924 817010.6,... +#> 6 POLYGON ((1464764 841722.6,... + +# We can also specify different units to achieve the same outcome. + +buffered <- data_buff(formatted, + buffer_distance = 0.5, + buffer_units = "km") +#> [Data Buffering] buffering sites by 0.5km radius. + +head(buffered) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1426043 ymin: 791553.4 xmax: 1473674 ymax: 842222.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 +#> geometry +#> 1 POLYGON ((1444706 799722.4,... +#> 2 POLYGON ((1473674 822088.3,... +#> 3 POLYGON ((1464361 841469.8,... +#> 4 POLYGON ((1427043 792053.4,... +#> 5 POLYGON ((1461924 817010.6,... +#> 6 POLYGON ((1464764 841722.6,... +``` + +**Congratulations!** You have now learned how to use `data_fmt()` to standardize the format of your data for covariate download and extraction, and how to use `data_buff()` to buffer your data points to extract covariate data at different spatial scales. You can apply these concepts to download and extract landcover data in [**Chapter 2: Landcover Download and Extraction**](4.2-LandCover.html). diff --git a/vignettes/articles/4.1-CovariateFormatting.Rmd.orig b/vignettes/articles/4.1-CovariateFormatting.Rmd.orig new file mode 100644 index 00000000..a5986878 --- /dev/null +++ b/vignettes/articles/4.1-CovariateFormatting.Rmd.orig @@ -0,0 +1,235 @@ +--- +title: "Chapter 1 - Formatting Data for Covariate Download and Extraction" +author: "Rory Macklin" +date: "2026-03-25" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 1 - Formatting Data for Covariate Download and Extraction} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 1: Formatting Data for Covariate Download and Extraction + +##### Author: Rory Macklin + +> Satellite Earth Observation (SEO) data are an increasingly critical tool in ecological analysis, but can be difficult for end-users to access. With the functions we describe in this chapter, we aim to make several commonly used data types easy to download and attach to bird data downloaded from NatureCounts. The first step in this process is often formatting your bird data to prepare it for use in extracting data from covariate data sets. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. + +# 1.0 Learning Objectives + +By the end of **Chapter 1 - Formatting Data for Covariate Download and Extraction**, users will know how to: + +- Use `data_fmt()` to conform their data (whether it is from NatureCounts or not) to a standard format for covariate extraction: [Formatting with `data_fmt()`](#1.1formatting). +- Use `data_buff()` to create spatial buffers around their survey points to summarize environmental variables at larger scales: [Buffering with `data_buff()`](#1.2buffering). + +This R tutorial requires the following packages: + +``` {r, message = FALSE} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 1.1 Formatting with `data_fmt()`{#1.1formatting} + +Extracting environmental data usually requires a few data features, all of which are commonly collected during ecological surveys. These usually include: + +- The location where observations were made (usually a latitude/longitude coordinate). +- The date on which observations were made. + +However, these can often be collected and encoded in inconsistent formats. Here, we provide a function to standardize common data storage formats in R for spatial coordinates and date data. This function will return the input data in a spatial format necessary for extracting data from raster datasets, and with standardized sets of columns. + +This function accepts data in five formats: + +- A `data.frame` with columns containing the spatial X-coordinate (usually longitude), the spatial Y-coordinate (usually latitude), and date data. +- An `sf` object, in either `POINT` or `POLYGON` format with coordinate information stored in the `geometry` column inherent to all `sf` objects and column(s) containing date data. +- A `terra` object, in either `points` or `polygons` format with coordinate information stored in the object structure inherent to `terra` and column(s) containing date data. + +Date data can be supplied in a variety of formats also. These include: + +- Three columns: one for year, one for month (either month name or a number 1-12), and one for day of the month (1-31). +- In one column in the native R `Date` format often manipulated using the `lubridate` package. +- In two columns, one containing year data, and the other containing the day of the year (1-365), often referred to as Julian or Ordinal date. + +This function is designed to work most directly with data downloaded from NatureCounts in the BMDE format, but options have been included to allow great flexibility in input data. Let's run through an example using some data from NatureCounts, and demonstrate how other data inputs can be included. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. +formatted <- data_fmt(bcch) + +head(formatted) +``` + +Running this call to `data_fmt()` has returned our processed data object with a warning! This warning is simply telling us that as we did not explicitly specify the coordinate reference system (CRS), the function has assumed it is in the [World Geodetic System 1984](https://epsg.io/4326) CRS, the standard latitude/longitude system used in many mapping operations. This is fine for us as this CRS is appropriate for our data! + +The outputted object `formatted` has been transformed into an `sf` object in a `POINT` geometry (as previously mentioned, in the WGS84 CRS). All of our original input columns (latitude, longitude, date data) have been left as they were as they are all columns we need down the road for the covariate download and extraction process, and were already in the standardized format we use therein. + +You will also notice that a column with site names has been added! In `bcch`, no site names are provided, and so for convenience, the function has created site names for each unique location in the dataset. In many BMDE datasets, site names will be provided in the `SurveyAreaIdentifier` column, or in columns under other names in non-BMDE data. These are often a more human-readable way of identifying the different locations in a dataset, but are not strictly necessary for our operations here. + +So, what if your data is a little less standard than this? + +``` {r} +# Let's modify the bcch object to make a more "non-standard" dataset. +bcch_modified <- bcch %>% + st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>% + st_transform("ESRI:102001") # Change the CRS to Canada Albers Equal Area + # Conic + +# Extract the coordinates in this new CRS format. +coordinates <- st_coordinates(bcch_modified) + +# Convert our object back to a data.frame +bcch_modified <- st_drop_geometry(bcch_modified) + +# Join the new coordinate data to our original data +bcch_modified <- cbind(bcch_modified, coordinates) + +# Take a look! No more latitude/longitude column, only an X/Y column in a totally +# different coordinate format! +bcch_modified %>% + select(X, Y, survey_year, survey_month, survey_day) %>% + head() + +# Now, if we supply this to data_fmt(), it's assumption that the data is in WGS84 +# would be wrong, and it wouldn't know where to look to find the coordinate data! +# We can use special arguments to get around this! +formatted <- data_fmt(bcch_modified, + coord_lon = "X", # Here's the name of the column that + # contains our X-coordinate, + coord_lat = "Y", # Here's the name of the column that + # contains our Y-coordinate, + crs = "ESRI:102001") # Here's the alternate CRS code we used! + +head(formatted) + +``` + +Phew, no errors! By telling the function where important information is stored, we can supply data in different formats and still prepare our data for use in covariate download and extraction. Let's see some other customization features we can use. + +``` {r} +# What if we use non-BMDE column names with our data? We'll also add some more +# human-readable site names and ask data_fmt() to look in a non-BMDE column name +# for them. +bcch_renamed <- bcch %>% + rename(year = survey_year, + monthofyear = survey_month, + dayofmonth = survey_day, + lat = latitude, + lon = longitude) %>% + select(-SurveyAreaIdentifier) # Remove the standard site name column + +# Fetch all unique latitude/longitude combinations and give each one a name! +sitenames <- bcch_renamed %>% + select(lat, lon) %>% + distinct() + +sitenames$sitename <- paste0("Site", 1:nrow(sitenames)) + +# Reattach these to our renamed data +bcch_renamed <- left_join(bcch_renamed, sitenames, by = c("lat", "lon")) + +# Let's give our data to data_fmt() and customize the column names as needed +formatted <- data_fmt(bcch_renamed, + site_name = "sitename", + coord_lon = "lon", + coord_lat = "lat", + date_year = "year", + date_month = "monthofyear", + date_day = "dayofmonth") + +head(formatted) + +``` + +As we can see, the function has happily accepted our alternate columns and has used them appropriately! This flexibility allows even those working with data outside of standard BMDE formats present in NatureCounts make use of these functions and those down the line to download and extract covariate data. + +Finally, what if we are using an alternate date format? So far, all examples have used the three column approach - one for year, one for month, and one for day. Below, we demonstrate how other date formats can be accommodated in `data_fmt()`. + +``` {r} + +# First, lets experiment with a column in date format. We'll make one below. +bcch_date <- bcch %>% + mutate(date = as.Date(paste0(survey_day, "-", survey_month, "-", survey_year), + format = "%d-%m-%Y")) + +head(bcch_date$date) + +# Feed into data_fmt() with the argument date_lubridate pointing the function to where date +# data is stored. + +formatted <- data_fmt(bcch_date, + date_lubridate = "date") + +head(formatted) + +# Now, lets try using ordinal date! +bcch_ordinal <- bcch_date %>% + mutate(dayofyear = yday(date)) + +# For ordinal date data, we need to provide the year and day-of-year column names. We'll let +# data_fmt() look for year data in the default BMDE column 'survey_year'. +formatted <- data_fmt(bcch_ordinal, + date_ordinal = "dayofyear") + +head(formatted) +``` + +As we can see, in both cases date data is extracted from the supplied `Date` formatted column or ordinal date data, and is provided alongside the original input format in the output of `data_fmt()`. + +Finally, spatial data is commonly encoded using `sf` or `terra` objects in R. This function is adaptable to those formats, so long as `sf` objects are `POINTS` or `POLYGONS` geometries, or `terra` objects are `points` or `polygons` geometries. In these cases, `data_fmt()` will return the data in the spatial format it was provided in (i.e., if a `terra` object is provided, the final output data will also be a `terra` object). + +With these options all laid out, you should be able to use `data_fmt()` to standardize your data, whether it is from NatureCounts or not, and use it in later functions for covariate download and extraction. + +# 1.2 Buffering with `data_buff()`{#1.2buffering} + +When extracting covariate data, it is often desirable to summarize environmental covariates at different spatial scales. This can lead to interesting ecological insight into how birds respond to environmental conditions at different scales (Tozer et al. 2010). This is achieved by creating a spatial buffer of a given distance around an observation point, and examining all environmental variable values that fall within the buffered area. + +`data_buff()` accepts data in four formats: + +- An `sf` object with `POINT` or `POLYGON` geometry. +- A `terra` object with `point` or `polygons` geometry. + +Users with `data.frame` data may consider using `data_fmt()` to convert their data to the appropriate format for use in `data_buff()`. + +Buffers of a 500 meter radius are commonly applied to represent the breeding territory size of most small- to medium-sized birds (Lee et al. 2021), so we will demonstrate the application of one to our `bcch` data here. + +``` {r} +# We will convert the bcch dataset to the appropriate data format using data_fmt() and will disregard the warning as EPSG:4326 is the appropriate CRS for these data. +formatted <- data_fmt(bcch) + +# Now, we use data_buff() to apply a 500 m radius buffer around each point. + +buffered <- data_buff(formatted, + buffer_distance = 500, + buffer_units = "m") + +head(buffered) + +# We can also specify different units to achieve the same outcome. + +buffered <- data_buff(formatted, + buffer_distance = 0.5, + buffer_units = "km") + +head(buffered) +``` + +**Congratulations!** You have now learned how to use `data_fmt()` to standardize the format of your data for covariate download and extraction, and how to use `data_buff()` to buffer your data points to extract covariate data at different spatial scales. You can apply these concepts to download and extract landcover data in [**Chapter 2: Landcover Download and Extraction**](4.2-LandCover.html). diff --git a/vignettes/articles/4.2-LandCover.Rmd b/vignettes/articles/4.2-LandCover.Rmd new file mode 100644 index 00000000..6c2521b1 --- /dev/null +++ b/vignettes/articles/4.2-LandCover.Rmd @@ -0,0 +1,275 @@ +--- +title: "Chapter 2 - Downloading and Extracting Landcover Data" +author: "Rory Macklin" +date: "2026-04-01" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 2 - Downloading and Extracting Landcover Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +# Chapter 2: Downloading and Extracting Landcover Data + +##### Author: Rory Macklin + +> Animal communities are strongly responsive to the landcover composition of an area, as this often determines important factors such as prey availability, available habitat for foraging and breeding, and the presence of certain disturbance types. Landcover data is, however, difficult to summarize from on-the-ground observation, especially at larger spatial scales. Luckily, SEO products are available that summarize land cover composition across the globe. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in landcover download and extraction functions. + +# 2.0 Learning Objectives + +By the end of **Chapter 2 - Downloading and Extracting Landcover Data**, users will know how to: + +- Have a basic understanding of the MODIS Terra/Aqua Landcover product accessed through `landcover_download()` and `landcover_extract()`: [MODIS Terra/Aqua Landcover Data](#2.1modis) +- Use `landcover_download()` to download MODIS Landcover data ready to match to observations in your data: [Downloading landcover data with `landcover_download()`](#2.2download). +- Use `landcover_extract()` to extract and summarize landcover data for each observation in their data: [Extracting landcover data with `landcover_extract()`](#2.3extract). + +This R tutorial requires the following packages: + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 2.1 MODIS Terra/Aqua Landcover Data {#2.1modis} + +The [MODIS MCD12Q1 Landcover product](https://ladsweb.modaps.eosdis.nasa.gov/missions-and-measurements/products/MCD12Q1) is a long-running, global dataset of gridded landcover type data. Each grid cell is approximately 500 m x 500 m and the data has an annual resolution. This massive spatial and temporal coverage makes this dataset one of the primary resources for landcover data, being widely incorporated into ecological analyses, including important products such as [eBird Status and Trends estimates](https://science.ebird.org/en/status-and-trends). + +The raw spectral data from the MODIS Terra and Aqua satellites are processed to assign each grid cell to a landcover category. There are five available landcover classification schema: + +- International Geosphere-Biosphere Program (IGBP) scheme: a 17-class scheme with 11 natural vegetation classes, three human-altered classes, and three non-vegetated classes. +- University of Maryland (UMD) scheme: a 16-class scheme with 11 natural vegetation classes, three human-altered classes, and two non-vegetated classes. Differs from IGBP by combining barren and permanent snow and ice classes into one non-vegetated lands class. +- Leaf Area Index (LAI) scheme: a 11-class scheme with eight vegetated classes (which describe natural vegetation as well as cropland), one human-altered class (focusing only on impervious surfaces), and two non-vegetated classes. +- BIOME-Biogeochemical Cycles (BGC) scheme: a 9-class scheme with six vegetation classes (which describe natural vegetation as well as cropland), one human-altered class (focusing only on impervious surfaces), and two non-vegetated classes. +- Plant Functional Type (PFT) scheme: a 12-class scheme, with six natural vegetation classes, three human-altered classes (with separation between cereal and broadleaf croplands), and three non-vegetated classes. + +Users should consider which scheme and level of detail best suits their research question/study system before proceeding to using these data. This may mean considering the level of landcover detail they wish to understand a study species' response to (*"do I care whether my species responds to needleleaf or broadleaf trees differently?"*), ensuring a particular habitat type is described by their selected scheme (*"I am studying the effect of croplands on my species, so I should make sure to choose a scheme with the appropriate cropland category."*), or trying multiple schema and checking whether any categories are poorly represented in their study area (*"Hm, not much representation of barren or snow and ice landcover, maybe I'll choose a scheme that lumps those into a larger, more represented category."*) + +# 2.2 Downloading landcover data with `landcover_download()` {#2.2download} + +Rather than delivering one file covering the entire globe in a given year, MODIS landcover data is broken up into large tiles that cover a section of the globe, with one file for each tile per year. This means that a user would typically have to identify which tile(s) their study region falls within and manually download the appropriate files for each study year. This can be a complex and error-prone process, ultimately taking the researcher's time away from doing the research they aim to do. + +Identifying this issue, R packages such as [`luna`](https://github.com/rspatial/luna/) have emerged to automate this process. In `landcover_download()`, we employ functions from `luna` and add quality of life features to further automate the downloading of MODIS landcover data. + +First, lets prep some data from NatureCounts for use in downloading MODIS data using `data_fmt()`. `landcover_download()` requires input data in either `sf` or `terra` spatial format with information on observation year stored in its own column. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! We'll need to to convert it into an sf object for use in landcover_download(). +bcch %>% + select(latitude, longitude, survey_year) %>% + head() +#> latitude longitude survey_year +#> 1 45.51110 -77.50533 2011 +#> 2 45.63436 -77.07484 2010 +#> 3 45.82732 -77.12012 2010 +#> 4 45.48730 -77.74651 2011 +#> 5 45.61956 -77.23577 2010 +#> 6 45.82851 -77.11430 2011 + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be +#> EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 +#> geometry +#> 1 POINT (1444206 799722.4) +#> 2 POINT (1473174 822088.3) +#> 3 POINT (1463861 841469.8) +#> 4 POINT (1426543 792053.4) +#> 5 POINT (1461424 817010.6) +#> 6 POINT (1464264 841722.6) +``` + +The only other prerequisite here is an [EarthData](https://urs.earthdata.nasa.gov/users/new) account, which is necessary to access MODIS data stored in the NASA EarthData Archive. Users can register at the link above. + +Supplying our formatted data and EarthData account email to `landcover_download()` will begin the download process. If the user wishes to just see which files would be downloaded without executing the download, they can do so by setting `ed_transfer` to `FALSE`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +``` r +# Let's see which files would be downloaded for our data + +files <- landcover_download(data = formatted, + ed_transfer = FALSE, + progress = FALSE) +#> [MODIS Landcover Download] fetching data filenames. +#> Warning: [MODIS Landcover Download] MODIS landcover data unavailable for all years before 2001. +#> landcover_extract() will extract landcover data from 2001 for these observations. + +head(files) +#> [1] "MCD12Q1.A2001001.h12v04.061.2022146050354.hdf" "MCD12Q1.A2002001.h12v04.061.2022147215712.hdf" +#> [3] "MCD12Q1.A2003001.h12v04.061.2022151161906.hdf" "MCD12Q1.A2004001.h12v04.061.2022152043252.hdf" +#> [5] "MCD12Q1.A2005001.h12v04.061.2022152140219.hdf" "MCD12Q1.A2006001.h12v04.061.2022202151028.hdf" + +# Now, by providing an EarthData login email, we can execute the download. Files will be downloaded into a 'modis/' subdirectory in your current working directory. + +ed_email <- "your EarthData email" + +files <- landcover_download(data = formatted, + ed_email = ed_email, + progress = FALSE, + ed_transfer = TRUE) # We don't need to specify this as + # TRUE is the default, but we have + # done so for clarity. +#> [MODIS Landcover Download] downloading data. +#> Warning: [MODIS Landcover Download] MODIS landcover data unavailable for all years before 2001. +#> landcover_extract() will extract landcover data from 2001 for these observations. + +head(files) +#> [1] "./modis/MCD12Q1/MCD12Q1.A2001001.h12v04.061.2022146050354.hdf" +#> [2] "./modis/MCD12Q1/MCD12Q1.A2002001.h12v04.061.2022147215712.hdf" +#> [3] "./modis/MCD12Q1/MCD12Q1.A2003001.h12v04.061.2022151161906.hdf" +#> [4] "./modis/MCD12Q1/MCD12Q1.A2004001.h12v04.061.2022152043252.hdf" +#> [5] "./modis/MCD12Q1/MCD12Q1.A2005001.h12v04.061.2022152140219.hdf" +#> [6] "./modis/MCD12Q1/MCD12Q1.A2006001.h12v04.061.2022202151028.hdf" +``` + +Examining the `files` object, we can see it is a character vector containing the paths to all downloaded files. All downloaded files can be found at the path specified using the argument `dl_path` and are in .hdf format, each file containing raster data for one MODIS tile for one of each requested year. These files can be brought into R using `terra::rast()` to examine, but we will use `landcover_extract()` to manage the extraction process. + +# 2.3 Extracting landcover data with `landcover_extract()` {#2.3extract} + +Once we have gathered the appropriate MODIS landcover data files, using `landcover_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile and year. Again, this would take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `landcover_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the landcover category that each site point falls within in a column named `LC_TypeX_Class` (where X is the number associated with the selected landcover classification scheme). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the percent of the polygon (for buffered points this means the proportion of the buffered area) that each landcover category takes up with a column for each class named `LC_TypeX_[Class Name]`. This is carried out via a call to `landscapemetrics::calculate_lsm()` + +To execute these extractions, we need to select which scheme we want to use, and specify it in the `covariates` argument. The appropriate covariate codes can be found in the `covariate_name` column of the table called with `nc_covariate_table()`. We will use the Leaf Area Index scheme, which is called by setting `covariates = "modis_lctype3"`. We will need to point `landcover_extract()` to where our MODIS data files are stored by providing a character vector with the filepaths of all applicable files to the argument `landcover_files`. Conveniently, this is exactly the output of `landcover_download()` that we stored in our `files` object. + +``` r +# We will start by fetching the landcover data for our point dataset created above. +output <- landcover_extract(data = formatted, + covariates = "modis_lctype3", + landcover_files = files) +#> Warning: [MODIS Landcover Extraction]: MODIS data not available for 1978, 1979, 1980, 1981, 1982, +#> 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +#> 1999, 2000 - using data from nearest year(s) (2001). +#> [MODIS Landcover Extraction] calculating MODIS LC Type3. +``` + +Woah! That's a lot of warnings. These warnings are ultimately harmless but are important to consider. The MODIS Landcover dataset only extends back to 2001, and our data contains observations from before 2001. So, the function has grabbed the closest data point in time it can to those pre-2001 observations (the landcover category from 2001) and provides that instead. If we don't want this behaviour, we could go into our output data and manually set them to `NA` after running `landcover_extract()` using `output$LC_Type3_Class[output$survey_year < 2001] <- NA` . For this demonstration, we will leave it as is. This could also happen for observations in the current year (at the time of writing, 2026) as the MODIS landcover data available in a given year usually ends at the previous calendar year. In this case, the function would fetch the landcover category from the previous year and warn the user. + +Let's take a look at what the function has returned for us! + +``` r +head(output) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1473174 ymax: 841722.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 +#> geometry LC_Type3_Class +#> 1 POINT (1444206 799722.4) deciduous_broadleaf_forests +#> 2 POINT (1473174 822088.3) savannas +#> 3 POINT (1463861 841469.8) urban_builtup_lands +#> 4 POINT (1426543 792053.4) deciduous_broadleaf_forests +#> 5 POINT (1461424 817010.6) deciduous_broadleaf_forests +#> 6 POINT (1464264 841722.6) urban_builtup_lands + +table(output$LC_Type3_Class) +#> +#> deciduous_broadleaf_forests evergreen_needleleaf_forests grasslands +#> 43 2 5 +#> savannas urban_builtup_lands water_bodies +#> 87 16 4 +``` + +Now let's give it a go with polygon input data. We'll buffer our points to summarize landcover within a 500 m radius of each observation. We will expect and ignore the same warnings as in the previous example. + +``` r +buffered <- data_buff(data = formatted) +#> [Data Buffering] buffering sites by 500m radius (default). + +output <- landcover_extract(data = buffered, + covariates = "modis_lctype3", + landcover_files = files) +#> Warning: [MODIS Landcover Extraction]: MODIS data not available for 1978, 1979, 1980, 1981, 1982, +#> 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +#> 1999, 2000 - using data from nearest year(s) (2001). +#> [MODIS Landcover Extraction] calculating MODIS LC Type3. + +head(output) +#> Simple feature collection with 6 features and 18 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1426043 ymin: 791553.4 xmax: 1473674 ymax: 842222.6 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 +#> 2 FilledSurveyArea2 45.63436 -77.07484 2010 7 3 +#> 3 FilledSurveyArea3 45.82732 -77.12012 2010 6 19 +#> 4 FilledSurveyArea4 45.48730 -77.74651 2011 5 5 +#> 5 FilledSurveyArea5 45.61956 -77.23577 2010 6 16 +#> 6 FilledSurveyArea6 45.82851 -77.11430 2011 10 2 +#> geometry LC_Type3_water_bodies LC_Type3_grasslands LC_Type3_shrublands +#> 1 POLYGON ((1444706 799722.4,... 0.00000 0 0 +#> 2 POLYGON ((1473674 822088.3,... 0.00000 0 0 +#> 3 POLYGON ((1464361 841469.8,... 22.22222 0 0 +#> 4 POLYGON ((1427043 792053.4,... 0.00000 0 0 +#> 5 POLYGON ((1461924 817010.6,... 0.00000 0 0 +#> 6 POLYGON ((1464764 841722.6,... 33.33333 0 0 +#> LC_Type3_broadleaf_croplands LC_Type3_savannas LC_Type3_evergreen_broadleaf_forests +#> 1 0 0.00000 0 +#> 2 0 50.00000 0 +#> 3 0 11.11111 0 +#> 4 0 0.00000 0 +#> 5 0 0.00000 0 +#> 6 0 0.00000 0 +#> LC_Type3_deciduous_broadleaf_forests LC_Type3_evergreen_needleleaf_forests +#> 1 100.00000 0.00000 +#> 2 50.00000 0.00000 +#> 3 0.00000 0.00000 +#> 4 66.66667 33.33333 +#> 5 100.00000 0.00000 +#> 6 0.00000 0.00000 +#> LC_Type3_deciduous_needleleaf_forests LC_Type3_nonvegetated_lands LC_Type3_urban_builtup_lands +#> 1 0 0.00000 0.00000 +#> 2 0 0.00000 0.00000 +#> 3 0 0.00000 66.66667 +#> 4 0 0.00000 0.00000 +#> 5 0 0.00000 0.00000 +#> 6 0 16.66667 50.00000 +#> LC_Type3_unclassified +#> 1 0 +#> 2 0 +#> 3 0 +#> 4 0 +#> 5 0 +#> 6 0 +``` + +We can see that we have gained a number of columns, each with the percentage of the buffered area that is taken up by each particular class. + +# 2.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year data can be provided directly to `landcover_download()` and `landcover_extract()` via the `site_name` and `date_year` columns. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either landcover function, you do not need to specify this information again. + +By default, the MODIS files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `landcover_extract()`. + +Once you've extracted your landcover data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate landcover data for your observation data using `landcover_download()` and `landcover_extract()`. diff --git a/vignettes/articles/4.2-LandCover.Rmd.orig b/vignettes/articles/4.2-LandCover.Rmd.orig new file mode 100644 index 00000000..3af576c2 --- /dev/null +++ b/vignettes/articles/4.2-LandCover.Rmd.orig @@ -0,0 +1,159 @@ +--- +title: "Chapter 2 - Downloading and Extracting Landcover Data" +author: "Rory Macklin" +date: "2026-04-01" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 2 - Downloading and Extracting Landcover Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 2: Downloading and Extracting Landcover Data + +##### Author: Rory Macklin + +> Animal communities are strongly responsive to the landcover composition of an area, as this often determines important factors such as prey availability, available habitat for foraging and breeding, and the presence of certain disturbance types. Landcover data is, however, difficult to summarize from on-the-ground observation, especially at larger spatial scales. Luckily, SEO products are available that summarize land cover composition across the globe. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in landcover download and extraction functions. + +# 2.0 Learning Objectives + +By the end of **Chapter 2 - Downloading and Extracting Landcover Data**, users will know how to: + +- Have a basic understanding of the MODIS Terra/Aqua Landcover product accessed through `landcover_download()` and `landcover_extract()`: [MODIS Terra/Aqua Landcover Data](#2.1modis) +- Use `landcover_download()` to download MODIS Landcover data ready to match to observations in your data: [Downloading landcover data with `landcover_download()`](#2.2download). +- Use `landcover_extract()` to extract and summarize landcover data for each observation in their data: [Extracting landcover data with `landcover_extract()`](#2.3extract). + +This R tutorial requires the following packages: + +``` {r, message = FALSE} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 2.1 MODIS Terra/Aqua Landcover Data {#2.1modis} + +The [MODIS MCD12Q1 Landcover product](https://ladsweb.modaps.eosdis.nasa.gov/missions-and-measurements/products/MCD12Q1) is a long-running, global dataset of gridded landcover type data. Each grid cell is approximately 500 m x 500 m and the data has an annual resolution. This massive spatial and temporal coverage makes this dataset one of the primary resources for landcover data, being widely incorporated into ecological analyses, including important products such as [eBird Status and Trends estimates](https://science.ebird.org/en/status-and-trends). + +The raw spectral data from the MODIS Terra and Aqua satellites are processed to assign each grid cell to a landcover category. There are five available landcover classification schema: + +- International Geosphere-Biosphere Program (IGBP) scheme: a 17-class scheme with 11 natural vegetation classes, three human-altered classes, and three non-vegetated classes. +- University of Maryland (UMD) scheme: a 16-class scheme with 11 natural vegetation classes, three human-altered classes, and two non-vegetated classes. Differs from IGBP by combining barren and permanent snow and ice classes into one non-vegetated lands class. +- Leaf Area Index (LAI) scheme: a 11-class scheme with eight vegetated classes (which describe natural vegetation as well as cropland), one human-altered class (focusing only on impervious surfaces), and two non-vegetated classes. +- BIOME-Biogeochemical Cycles (BGC) scheme: a 9-class scheme with six vegetation classes (which describe natural vegetation as well as cropland), one human-altered class (focusing only on impervious surfaces), and two non-vegetated classes. +- Plant Functional Type (PFT) scheme: a 12-class scheme, with six natural vegetation classes, three human-altered classes (with separation between cereal and broadleaf croplands), and three non-vegetated classes. + +Users should consider which scheme and level of detail best suits their research question/study system before proceeding to using these data. This may mean considering the level of landcover detail they wish to understand a study species' response to (*"do I care whether my species responds to needleleaf or broadleaf trees differently?"*), ensuring a particular habitat type is described by their selected scheme (*"I am studying the effect of croplands on my species, so I should make sure to choose a scheme with the appropriate cropland category."*), or trying multiple schema and checking whether any categories are poorly represented in their study area (*"Hm, not much representation of barren or snow and ice landcover, maybe I'll choose a scheme that lumps those into a larger, more represented category."*) + +# 2.2 Downloading landcover data with `landcover_download()` {#2.2download} + +Rather than delivering one file covering the entire globe in a given year, MODIS landcover data is broken up into large tiles that cover a section of the globe, with one file for each tile per year. This means that a user would typically have to identify which tile(s) their study region falls within and manually download the appropriate files for each study year. This can be a complex and error-prone process, ultimately taking the researcher's time away from doing the research they aim to do. + +Identifying this issue, R packages such as [`luna`](https://github.com/rspatial/luna/) have emerged to automate this process. In `landcover_download()`, we employ functions from `luna` and add quality of life features to further automate the downloading of MODIS landcover data. + +First, lets prep some data from NatureCounts for use in downloading MODIS data using `data_fmt()`. `landcover_download()` requires input data in either `sf` or `terra` spatial format with information on observation year stored in its own column. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! We'll need to to convert it into an sf object for use in landcover_download(). +bcch %>% + select(latitude, longitude, survey_year) %>% + head() + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` + +The only other prerequisite here is an [EarthData](https://urs.earthdata.nasa.gov/users/new) account, which is necessary to access MODIS data stored in the NASA EarthData Archive. Users can register at the link above. + +Supplying our formatted data and EarthData account email to `landcover_download()` will begin the download process. If the user wishes to just see which files would be downloaded without executing the download, they can do so by setting `ed_transfer` to `FALSE`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +``` {r} +# Let's see which files would be downloaded for our data + +files <- landcover_download(data = formatted, + ed_transfer = FALSE, + progress = FALSE) + +head(files) + +# Now, by providing an EarthData login email, we can execute the download. Files will be downloaded into a 'modis/' subdirectory in your current working directory. + +ed_email <- "rmacklin@birdscanada.org" + +files <- landcover_download(data = formatted, + ed_email = ed_email, + progress = FALSE, + ed_transfer = TRUE) # We don't need to specify this as + # TRUE is the default, but we have + # done so for clarity. + +head(files) +``` + +Examining the `files` object, we can see it is a character vector containing the paths to all downloaded files. All downloaded files can be found at the path specified using the argument `dl_path` and are in .hdf format, each file containing raster data for one MODIS tile for one of each requested year. These files can be brought into R using `terra::rast()` to examine, but we will use `landcover_extract()` to manage the extraction process. + +# 2.3 Extracting landcover data with `landcover_extract()` {#2.3extract} + +Once we have gathered the appropriate MODIS landcover data files, using `landcover_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile and year. Again, this would take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `landcover_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the landcover category that each site point falls within in a column named `LC_TypeX_Class` (where X is the number associated with the selected landcover classification scheme). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the percent of the polygon (for buffered points this means the proportion of the buffered area) that each landcover category takes up with a column for each class named `LC_TypeX_[Class Name]`. This is carried out via a call to `landscapemetrics::calculate_lsm()` + +To execute these extractions, we need to select which scheme we want to use, and specify it in the `covariates` argument. The appropriate covariate codes can be found in the `covariate_name` column of the table called with `nc_covariate_table()`. We will use the Leaf Area Index scheme, which is called by setting `covariates = "modis_lctype3"`. We will need to point `landcover_extract()` to where our MODIS data files are stored by providing a character vector with the filepaths of all applicable files to the argument `landcover_files`. Conveniently, this is exactly the output of `landcover_download()` that we stored in our `files` object. + +``` {r} +# We will start by fetching the landcover data for our point dataset created above. +output <- landcover_extract(data = formatted, + covariates = "modis_lctype3", + landcover_files = files) + +``` + +Woah! That's a lot of warnings. These warnings are ultimately harmless but are important to consider. The MODIS Landcover dataset only extends back to 2001, and our data contains observations from before 2001. So, the function has grabbed the closest data point in time it can to those pre-2001 observations (the landcover category from 2001) and provides that instead. If we don't want this behaviour, we could go into our output data and manually set them to `NA` after running `landcover_extract()` using `output$LC_Type3_Class[output$survey_year < 2001] <- NA` . For this demonstration, we will leave it as is. This could also happen for observations in the current year (at the time of writing, 2026) as the MODIS landcover data available in a given year usually ends at the previous calendar year. In this case, the function would fetch the landcover category from the previous year and warn the user. + +Let's take a look at what the function has returned for us! + +``` {r} +head(output) + +table(output$LC_Type3_Class) +``` + +Now let's give it a go with polygon input data. We'll buffer our points to summarize landcover within a 500 m radius of each observation. We will expect and ignore the same warnings as in the previous example. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- landcover_extract(data = buffered, + covariates = "modis_lctype3", + landcover_files = files) + +head(output) +``` + +We can see that we have gained a number of columns, each with the percentage of the buffered area that is taken up by each particular class. + +# 2.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year data can be provided directly to `landcover_download()` and `landcover_extract()` via the `site_name` and `date_year` columns. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either landcover function, you do not need to specify this information again. + +By default, the MODIS files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `landcover_extract()`. + +Once you've extracted your landcover data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate landcover data for your observation data using `landcover_download()` and `landcover_extract()`. diff --git a/vignettes/articles/4.3-Vegetation.Rmd b/vignettes/articles/4.3-Vegetation.Rmd new file mode 100644 index 00000000..315bbf28 --- /dev/null +++ b/vignettes/articles/4.3-Vegetation.Rmd @@ -0,0 +1,278 @@ +--- +title: "Chapter 3 - Downloading and Extracting Vegetation Indices" +author: "Rory Macklin" +date: "2026-05-30" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 3 - Downloading and Extracting Vegetation Indices} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +# Chapter 3: Downloading and Extracting Vegetation Indicies + +##### Author: Rory Macklin + +> As vegetation amount is a key factor in habitat structure and resource availability to animals, it can be a strong predictor of animal presence. With globally available indices of "greenness" like the Normalized Difference Vegetation Index (NDVI) having supported a variety of ecological research for decades (Pettorelli et al. 2011), researchers may consider these metrics an tool worth considering in analyses. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in vegetation index download and extraction functions. + +# 3.0 Learning Objectives + +By the end of **Chapter 3 - Downloading and Extracting Vegetation Data**, users will know how to: + +- Have a basic understanding of the MODIS NDVI/EVI product accessed through `vegetation_download()` and `vegetation_extract()`: [MODIS NDVI/EVI Data](#3.1modis) +- Use `vegetation_download()` to download MODIS NDVI/EVI data ready to match to observations in your data: [Downloading vegetation indices with `vegetation_download()`](#3.2download). +- Use `vegetation_extract()` to extract and summarize vegetation indices for each observation in their data: [Extracting vegetation indices with `vegetation_extract()`](#3.3extract). + +This R tutorial requires the following packages: + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 3.1 MODIS NDVI/EVI Data {#3.1modis} + +The [MODIS MOD13A1 Vegetation Indices product](https://ladsweb.modaps.eosdis.nasa.gov/missions-and-measurements/products/MOD13A1) is a long-running, global dataset of gridded vegetation index data. Each grid cell is approximately 500 m x 500 m and the data has a 16-day resolution. The massive coverage and fine temporal resolution of these data make them ideal candidates for generalizable use in ecological research, being able to inform a wide variety of ecological questions (Pettorelli et al. 2011). + +Two indices are available, derived from raw spectral data collected by the MODIS Terra satellites: the Normalized Difference Vegetation Index (NDVI) and the Enhanced Vegetation Index (EVI). These indices are derived from satellite measurements of reflected light energy, and are calculated using the typical reflective properties of green leaves. This results in indices that are highly correlated to many ground-truthed measures of vegetation activity (Pettorelli et al. 2011). While NDVI is a more standard and widely used metric, the EVI builds upon the foundations of the NDVI to perform better in areas of high vegetative activity and better correct for atmospheric influence. More in-depth information on the calculation of these metrics can be found in the [MOD13 User Guide](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). + +Both of these metrics hold values between -1 and 1, with negative values typically being associated with water, values close to zero being associated with bare soil, cloud, snow, or concrete, and positive values with green leaves (Pettorelli et al. 2011). In temperate areas, such as Canada, winter measurements of NDVI and EVI (i.e., when deciduous trees have dropped their leaves) will be lower than in the spring a summer (i.e., when deciduous trees have leafed out). Users should be careful to remember that NDVI and EVI are thus not perfect measures of plant presence/absence as a plant may still be present without green leaves, but are instead measures of vegetative (i.e., green leaf) activity. + +# 3.2 Downloading vegetation indices with `vegetation_download()` {#3.2download} + +Rather than delivering one file covering the entire globe in a given year, MODIS vegetation data is broken up into large tiles that cover a section of the globe, with one file for each tile per 16-day period. This means that a user would typically have to identify which tile(s) their study region falls within and manually download the appropriate files for each 16-day period. This can be a complex and error-prone process, ultimately taking the researcher's time away from doing the research they aim to do. + +Identifying this issue, R packages such as [`luna`](https://github.com/rspatial/luna/) have emerged to automate this process. In `vegetation_download()`, we employ functions from `luna` and add quality of life features to further automate the downloading of MODIS vegetation indices. + +First, lets prep some data from NatureCounts for use in downloading MODIS data using `data_fmt()`. `vegetation_download()` requires input data in either `sf` or `terra` spatial format with information on observation year, month, and day each stpred in their own column. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! +# We'll need to to convert it into an sf object for use in vegetation_download(). +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() +#> latitude longitude survey_year survey_month survey_day +#> 1 45.51110 -77.50533 2011 2 12 +#> 2 45.63436 -77.07484 2010 7 3 +#> 3 45.82732 -77.12012 2010 6 19 +#> 4 45.48730 -77.74651 2011 5 5 +#> 5 45.61956 -77.23577 2010 6 16 +#> 6 45.82851 -77.11430 2011 10 2 + +# As 16-day resolution vegetation can result in the downloading of a lot of data, we will restrict our data to the years 1999-2000. + +bcch <- filter(bcch, survey_year %in% c(1999, 2000)) + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be +#> EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry +#> 1 POINT (1462530 839736.7) +#> 2 POINT (1462530 839736.7) +#> 3 POINT (1449503 806527.6) +#> 4 POINT (1449503 806527.6) +#> 5 POINT (1481359 842474.9) +#> 6 POINT (1481359 842474.9) +``` + +The only other prerequisite here is an [EarthData](https://urs.earthdata.nasa.gov/users/new) account, which is necessary to access MODIS data stored in the NASA EarthData Archive. Users can register at the link above. + +Supplying our formatted data and EarthData account email to `vegetation_download()` will begin the download process. If the user wishes to just see which files would be downloaded without executing the download, they can do so by setting `ed_transfer` to `FALSE`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +``` r +# Let's see which files would be downloaded for our data + +files <- vegetation_download(data = formatted, + ed_transfer = FALSE, + progress = FALSE) +#> [MODIS NDVI/EVI Download] fetching data filenames. +#> Warning: Observation on date(s) 1999-11-18, 1999-12-19, 1999-4-17, 1999-5-16 could not be matched +#> to a MODIS vegetation data file. Are they outside of the temporal coverage of the data (i.e., +#> before 2000 or in the current year)? + +files +#> [1] "MOD13A1.A2000337.h12v04.061.2020057055433.hdf" "MOD13A1.A2000353.h12v04.061.2020058160551.hdf" +#> [3] "MOD13A1.A2000097.h12v04.061.2020041112856.hdf" + +# Now, by providing an EarthData login email, we can execute the download. Files will be downloaded into a 'modis/' subdirectory in your current working directory. + +ed_email <- "your EarthData email" + +files <- vegetation_download(data = formatted, + ed_email = ed_email, + progress = FALSE, + ed_transfer = TRUE) # We don't need to specify this # as TRUE is the default, but we + # have done so for clarity. +#> Warning: Observation on date(s) 1999-11-18, 1999-12-19, 1999-4-17, 1999-5-16 could not be matched +#> to a MODIS vegetation data file. Are they outside of the temporal coverage of the data (i.e., +#> before 2000 or in the current year)? +#> [MODIS NDVI/EVI Download] data products are at a 16 day resolution, resulting in 3 files to download for your data. This may take some time. +#> [MODIS NDVI/EVI Download] downloading data. + +files +#> [1] "./modis/MOD13A1/MOD13A1.A2000337.h12v04.061.2020057055433.hdf" +#> [2] "./modis/MOD13A1/MOD13A1.A2000353.h12v04.061.2020058160551.hdf" +#> [3] "./modis/MOD13A1/MOD13A1.A2000097.h12v04.061.2020041112856.hdf" +``` + +Examining the `files` object, we can see it is a character vector containing the paths to all downloaded files. All downloaded files can be found by default in the created `./modis` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .hdf format, with each file containing raster data for one MODIS tile for one of each requested 16-day period. These files can be brought into R using `terra::rast()` to examine, but we will use `vegetation_extract()` to manage the extraction process. + +We also note that several warnings arose in the process! They are informing us that MODIS vegetation data files could not be found for some of our observation dates. All of these dates fall in 1999 - before the beginning of this dataset in 2000. Thus, only files associated with observations in the year 2000 were downloaded. + +# 3.3 Extracting vegetation indices with `vegetation_extract()` {#3.3extract} + +Once we have gathered the appropriate MODIS vegetation data files, using `vegetation_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile and year. Again, this would take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `vegetation_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the NDVI or EVI value of the raster grid cell that each site point falls within in a column named `ndvi` or `evi` respectively. This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean NDVI or EVI of cells overlapped by each polygon, again in a column called `ndvi` or `evi`. This is carried out via a call to `exactextractr::exact_extract()` + +To execute these extractions, we need to select which index we want to use, and specify it in the `covariates` argument. The appropriate covariate codes can be found in the `covariate_name` column of the table called with `nc_covariate_table()`. We will extract NDVI, which is called by setting `covariates = "modis_ndvi"`. We will need to point `vegetation_extract()` to where our MODIS data files are stored by providing a character vector with the filepaths of all applicable files to the argument `vegetation_files`. Conveniently, this is exactly the output of `vegetation_download()` that we stored in our `files` object. + +``` r +# We will start by fetching the vegetation data for our point dataset created above. +output <- vegetation_extract(data = formatted, + covariates = "modis_ndvi", + vegetation_files = files) +#> Warning: [MODIS NDVI/EVI Extraction] observations from year 1999 fall outside of the temporal +#> extent of the files provided. Is it in a year where data is unavailable from this dataset? No +#> value will be returned. +#> [MODIS NDVI/EVI Extraction] calculating MODIS NDVI. + +head(output) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day ndvi +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 NA +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 0.4056 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 NA +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 0.1020 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 0.5078 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 NA +#> geometry +#> 1 POINT (1462530 839736.7) +#> 2 POINT (1462530 839736.7) +#> 3 POINT (1449503 806527.6) +#> 4 POINT (1449503 806527.6) +#> 5 POINT (1481359 842474.9) +#> 6 POINT (1481359 842474.9) +``` + +We have again been warned that some of the observations in our data are from years that are covered by the MODIS vegetation data. Other than that, there are no errors or warnings, so we can take a look at what the function has returned for us! NDVI values have been added for the observations in the year 2000 in the `ndvi` column, while the values for observations in 1999 have been left as NAs. + +We can gain additional information about the reliability of the NDVI observations that `vegetation_extract()` returns by setting the argument `reliability = TRUE`. This will extract the reliability value for each site, derived from the grid cell it falls within, giving us a quick-look at whether low NDVI values are driven by confounding factors such as snow, ice, or cloud, or are simply areas of little vegetation. These values will be added in a new column called `vegetation_reliability` and apply to both the NDVI and EVI measurements for that grid cell. + +``` r +# Lets try our call again with reliability = TRUE. +output <- vegetation_extract(data = formatted, + covariates = "modis_ndvi", + vegetation_files = files, + reliability = TRUE) +#> Warning: [MODIS NDVI/EVI Extraction] observations from year 1999 fall outside of the temporal +#> extent of the files provided. Is it in a year where data is unavailable from this dataset? No +#> value will be returned. +#> [MODIS NDVI/EVI Extraction] calculating MODIS NDVI. + +head(output) +#> Simple feature collection with 6 features and 8 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day ndvi +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 NA +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 0.4056 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 NA +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 0.1020 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 0.5078 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 NA +#> vegetation_reliability geometry +#> 1 POINT (1462530 839736.7) +#> 2 Good Data POINT (1462530 839736.7) +#> 3 POINT (1449503 806527.6) +#> 4 Snow/Ice POINT (1449503 806527.6) +#> 5 Good Data POINT (1481359 842474.9) +#> 6 POINT (1481359 842474.9) +``` + +For the observations in the year 2000, we can see that two observations NDVI values are from grid cells with good data, while one is from an area where snow/ice has interfered with NDVI measurement. More information on these quality assessments is available in the [MOD13A1 User Guide](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean of our selected vegetation index (we'll calculate both NDVI and EVI this time) within a 500 m radius of each observation, as well as reliability information. We will expect and ignore the same warnings as in the previous example. + +``` r +buffered <- data_buff(data = formatted) +#> [Data Buffering] buffering sites by 500m radius (default). + +output <- vegetation_extract(data = buffered, + covariates = c("modis_ndvi", "modis_evi"), + vegetation_files = files, + reliability = TRUE) +#> Warning: [MODIS NDVI/EVI Extraction] observations from year 1999 fall outside of the temporal +#> extent of the files provided. Is it in a year where data is unavailable from this dataset? No +#> value will be returned. +#> [MODIS NDVI/EVI Extraction] calculating MODIS NDVI. +#> [MODIS NDVI/EVI Extraction] calculating MODIS EVI. + +head(output) +#> Simple feature collection with 6 features and 9 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1449003 ymin: 806027.6 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day ndvi +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 NA +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 0.3645081 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 NA +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 0.0888040 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 0.3923654 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 NA +#> vegetation_reliability evi geometry +#> 1 NA POLYGON ((1463030 839736.7,... +#> 2 Good Data (100%) 0.21148738 POLYGON ((1463030 839736.7,... +#> 3 NA POLYGON ((1450003 806527.6,... +#> 4 Snow/Ice (66.67%), Cloudy (33.33%) 0.07843998 POLYGON ((1450003 806527.6,... +#> 5 Good Data (100%) 0.13573586 POLYGON ((1481859 842474.9,... +#> 6 NA POLYGON ((1481859 842474.9,... +``` + +We can see that the mean NDVI and EVI values have been added in the `ndvi` and `evi` columns respectively. This time, the `vegetation_reliability` column contains a string containing the percentage of all cells overlapped by each observation polygon in each reliability category. Here, we can see that not only has snow interfered with our NDVI and EVI measurements for one of our observations, but clouds have also interfered as well. This information provides users with important decision-making tools to assure the quality of NDVI/EVI data is considered in their analyses. + +# 3.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year, month, and day data can be provided directly to `vegetation_download()` and `vegetation_extract()` via the `site_name`, `date_year`, `date_month`, and `date_day` columns respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `vegetation_` function, you do not need to specify this information again. + +By default, the MODIS files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `vegetation_extract()`. + +Once you've extracted your vegetation index data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate vegetation index data for your observation data using `vegetation_download()` and `vegetation_extract()`. + +# 3.5 References + +Pettorelli, Nathalie & Ryan, Sadie & Mueller, Thomas & Bunnefeld, Nils & Jedrzejewsk, Bogumila & Lima, Mauricio & Kausrud, Kyrre. (2011). The Normalized Difference Vegetation Index (NDVI): Unforeseen successes in animal ecology. Climate Research. 46. 15-27. 10.3354/cr00936. diff --git a/vignettes/articles/4.3-Vegetation.Rmd.orig b/vignettes/articles/4.3-Vegetation.Rmd.orig new file mode 100644 index 00000000..b540908f --- /dev/null +++ b/vignettes/articles/4.3-Vegetation.Rmd.orig @@ -0,0 +1,171 @@ +--- +title: "Chapter 3 - Downloading and Extracting Vegetation Indices" +author: "Rory Macklin" +date: "2026-05-30" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 3 - Downloading and Extracting Vegetation Indices} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 3: Downloading and Extracting Vegetation Indicies + +##### Author: Rory Macklin + +> As vegetation amount is a key factor in habitat structure and resource availability to animals, it can be a strong predictor of animal presence. With globally available indices of "greenness" like the Normalized Difference Vegetation Index (NDVI) having supported a variety of ecological research for decades (Pettorelli et al. 2011), researchers may consider these metrics an tool worth considering in analyses. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in vegetation index download and extraction functions. + +# 3.0 Learning Objectives + +By the end of **Chapter 3 - Downloading and Extracting Vegetation Data**, users will know how to: + +- Have a basic understanding of the MODIS NDVI/EVI product accessed through `vegetation_download()` and `vegetation_extract()`: [MODIS NDVI/EVI Data](#3.1modis) +- Use `vegetation_download()` to download MODIS NDVI/EVI data ready to match to observations in your data: [Downloading vegetation indices with `vegetation_download()`](#3.2download). +- Use `vegetation_extract()` to extract and summarize vegetation indices for each observation in their data: [Extracting vegetation indices with `vegetation_extract()`](#3.3extract). + +This R tutorial requires the following packages: + +``` {r} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 3.1 MODIS NDVI/EVI Data {#3.1modis} + +The [MODIS MOD13A1 Vegetation Indices product](https://ladsweb.modaps.eosdis.nasa.gov/missions-and-measurements/products/MOD13A1) is a long-running, global dataset of gridded vegetation index data. Each grid cell is approximately 500 m x 500 m and the data has a 16-day resolution. The massive coverage and fine temporal resolution of these data make them ideal candidates for generalizable use in ecological research, being able to inform a wide variety of ecological questions (Pettorelli et al. 2011). + +Two indices are available, derived from raw spectral data collected by the MODIS Terra satellites: the Normalized Difference Vegetation Index (NDVI) and the Enhanced Vegetation Index (EVI). These indices are derived from satellite measurements of reflected light energy, and are calculated using the typical reflective properties of green leaves. This results in indices that are highly correlated to many ground-truthed measures of vegetation activity (Pettorelli et al. 2011). While NDVI is a more standard and widely used metric, the EVI builds upon the foundations of the NDVI to perform better in areas of high vegetative activity and better correct for atmospheric influence. More in-depth information on the calculation of these metrics can be found in the [MOD13 User Guide](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). + +Both of these metrics hold values between -1 and 1, with negative values typically being associated with water, values close to zero being associated with bare soil, cloud, snow, or concrete, and positive values with green leaves (Pettorelli et al. 2011). In temperate areas, such as Canada, winter measurements of NDVI and EVI (i.e., when deciduous trees have dropped their leaves) will be lower than in the spring a summer (i.e., when deciduous trees have leafed out). Users should be careful to remember that NDVI and EVI are thus not perfect measures of plant presence/absence as a plant may still be present without green leaves, but are instead measures of vegetative (i.e., green leaf) activity. + +# 3.2 Downloading vegetation indices with `vegetation_download()` {#3.2download} + +Rather than delivering one file covering the entire globe in a given year, MODIS vegetation data is broken up into large tiles that cover a section of the globe, with one file for each tile per 16-day period. This means that a user would typically have to identify which tile(s) their study region falls within and manually download the appropriate files for each 16-day period. This can be a complex and error-prone process, ultimately taking the researcher's time away from doing the research they aim to do. + +Identifying this issue, R packages such as [`luna`](https://github.com/rspatial/luna/) have emerged to automate this process. In `vegetation_download()`, we employ functions from `luna` and add quality of life features to further automate the downloading of MODIS vegetation indices. + +First, lets prep some data from NatureCounts for use in downloading MODIS data using `data_fmt()`. `vegetation_download()` requires input data in either `sf` or `terra` spatial format with information on observation year, month, and day each stpred in their own column. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need! +# We'll need to to convert it into an sf object for use in vegetation_download(). +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() + +# As 16-day resolution vegetation can result in the downloading of a lot of data, we will restrict our data to the years 1999-2000. + +bcch <- filter(bcch, survey_year %in% c(1999, 2000)) + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` + +The only other prerequisite here is an [EarthData](https://urs.earthdata.nasa.gov/users/new) account, which is necessary to access MODIS data stored in the NASA EarthData Archive. Users can register at the link above. + +Supplying our formatted data and EarthData account email to `vegetation_download()` will begin the download process. If the user wishes to just see which files would be downloaded without executing the download, they can do so by setting `ed_transfer` to `FALSE`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +``` {r} +# Let's see which files would be downloaded for our data + +files <- vegetation_download(data = formatted, + ed_transfer = FALSE, + progress = FALSE) + +files + +# Now, by providing an EarthData login email, we can execute the download. Files will be downloaded into a 'modis/' subdirectory in your current working directory. + +ed_email <- "rmacklin@birdscanada.org" + +files <- vegetation_download(data = formatted, + ed_email = ed_email, + progress = FALSE, + ed_transfer = TRUE) # We don't need to specify this # as TRUE is the default, but we + # have done so for clarity. + +files +``` + +Examining the `files` object, we can see it is a character vector containing the paths to all downloaded files. All downloaded files can be found by default in the created `./modis` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .hdf format, with each file containing raster data for one MODIS tile for one of each requested 16-day period. These files can be brought into R using `terra::rast()` to examine, but we will use `vegetation_extract()` to manage the extraction process. + +We also note that several warnings arose in the process! They are informing us that MODIS vegetation data files could not be found for some of our observation dates. All of these dates fall in 1999 - before the beginning of this dataset in 2000. Thus, only files associated with observations in the year 2000 were downloaded. + +# 3.3 Extracting vegetation indices with `vegetation_extract()` {#3.3extract} + +Once we have gathered the appropriate MODIS vegetation data files, using `vegetation_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile and year. Again, this would take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `vegetation_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the NDVI or EVI value of the raster grid cell that each site point falls within in a column named `ndvi` or `evi` respectively. This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean NDVI or EVI of cells overlapped by each polygon, again in a column called `ndvi` or `evi`. This is carried out via a call to `exactextractr::exact_extract()` + +To execute these extractions, we need to select which index we want to use, and specify it in the `covariates` argument. The appropriate covariate codes can be found in the `covariate_name` column of the table called with `nc_covariate_table()`. We will extract NDVI, which is called by setting `covariates = "modis_ndvi"`. We will need to point `vegetation_extract()` to where our MODIS data files are stored by providing a character vector with the filepaths of all applicable files to the argument `vegetation_files`. Conveniently, this is exactly the output of `vegetation_download()` that we stored in our `files` object. + +``` {r} +# We will start by fetching the vegetation data for our point dataset created above. +output <- vegetation_extract(data = formatted, + covariates = "modis_ndvi", + vegetation_files = files) + +head(output) +``` + +We have again been warned that some of the observations in our data are from years that are covered by the MODIS vegetation data. Other than that, there are no errors or warnings, so we can take a look at what the function has returned for us! NDVI values have been added for the observations in the year 2000 in the `ndvi` column, while the values for observations in 1999 have been left as NAs. + +We can gain additional information about the reliability of the NDVI observations that `vegetation_extract()` returns by setting the argument `reliability = TRUE`. This will extract the reliability value for each site, derived from the grid cell it falls within, giving us a quick-look at whether low NDVI values are driven by confounding factors such as snow, ice, or cloud, or are simply areas of little vegetation. These values will be added in a new column called `vegetation_reliability` and apply to both the NDVI and EVI measurements for that grid cell. + +``` {r} +# Lets try our call again with reliability = TRUE. +output <- vegetation_extract(data = formatted, + covariates = "modis_ndvi", + vegetation_files = files, + reliability = TRUE) + +head(output) +``` + +For the observations in the year 2000, we can see that two observations NDVI values are from grid cells with good data, while one is from an area where snow/ice has interfered with NDVI measurement. More information on these quality assessments is available in the [MOD13A1 User Guide](https://lpdaac.usgs.gov/documents/621/MOD13_User_Guide_V61.pdf). + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean of our selected vegetation index (we'll calculate both NDVI and EVI this time) within a 500 m radius of each observation, as well as reliability information. We will expect and ignore the same warnings as in the previous example. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- vegetation_extract(data = buffered, + covariates = c("modis_ndvi", "modis_evi"), + vegetation_files = files, + reliability = TRUE) + +head(output) +``` + +We can see that the mean NDVI and EVI values have been added in the `ndvi` and `evi` columns respectively. This time, the `vegetation_reliability` column contains a string containing the percentage of all cells overlapped by each observation polygon in each reliability category. Here, we can see that not only has snow interfered with our NDVI and EVI measurements for one of our observations, but clouds have also interfered as well. This information provides users with important decision-making tools to assure the quality of NDVI/EVI data is considered in their analyses. + +# 3.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year, month, and day data can be provided directly to `vegetation_download()` and `vegetation_extract()` via the `site_name`, `date_year`, `date_month`, and `date_day` columns respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `vegetation_` function, you do not need to specify this information again. + +By default, the MODIS files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `vegetation_extract()`. + +Once you've extracted your vegetation index data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate vegetation index data for your observation data using `vegetation_download()` and `vegetation_extract()`. + +# 3.5 References + +Pettorelli, Nathalie & Ryan, Sadie & Mueller, Thomas & Bunnefeld, Nils & Jedrzejewsk, Bogumila & Lima, Mauricio & Kausrud, Kyrre. (2011). The Normalized Difference Vegetation Index (NDVI): Unforeseen successes in animal ecology. Climate Research. 46. 15-27. 10.3354/cr00936. diff --git a/vignettes/articles/4.4-Elevation.Rmd b/vignettes/articles/4.4-Elevation.Rmd new file mode 100644 index 00000000..f360bc6e --- /dev/null +++ b/vignettes/articles/4.4-Elevation.Rmd @@ -0,0 +1,214 @@ +--- +title: "Chapter 4 - Downloading and Extracting Elevation Data" +author: "Rory Macklin" +date: "2026-06-09" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 4 - Downloading and Extracting Elevation Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + +# Chapter 4: Downloading and Extracting Elevation Data + +##### Author: Rory Macklin + +> While animal populations may not directly respond to changes in elevation, they frequently depend significantly on correlates of elevation (e.g., temperature, habitat type). For this reason, elevation is frequently included in species distribution models, and can be used to proxy a number of difficult-to-map features when correlates are well understood. This is all possible due to the global and broad availability of satellite-derived digital elevation models (DEMs). + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in elevation data download and extraction functions. + +# 4.0 Learning Objectives + +By the end of **Chapter 4 - Downloading and Extracting Elevation Data**, users will know how to: + +- Have a basic understanding of the MapZen Terrain Tiles dataset accessed through `elevation_download()` and `elevation_extract()`: [MapZen Terrain Tiles Data](#4.1elevation). +- Use `elevation_download()` to download MapZen Terrain Tiles data ready to match to observations in your data: [Downloading elevation data with `elevation_download()`](#4.2download). +- Use `elevation_extract()` to extract and summarize MapZen Terrain Tiles data for each observation in their data: [Extracting elevation data with `elevation_extract()`](#4.3extract). + +This R tutorial requires the following packages: + + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 4.1 MapZen Terrain Tiles Data {#4.1elevation} + +The [MapZen Terrain Tiles dataset](github.com/tilezen/joerd/tree/master/docs) is a globally-composited dataset of gridded elevation data. The product can be accessed at a variety of spatial resolutions and the data has a static temporal resolution. The massive coverage and flexible spatial resolution of these data make them ideal candidates for generalizable use in ecological research, being able to inform analyses at a variety of scales. + +These data are composited from a wide variety of DEMs from across the globe. The full list of sources can be found [here](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#list-of-sources). Generally speaking, when data on land is requested at low spatial resolution data is sourced from [GMTED](https://www.usgs.gov/coastal-changes-and-impacts/gmted2010). At medium-to-high spatial resolutions data for land areas are sourced from [SRTM](https://doi.org/10.5067/MEASURES/SRTM/SRTMGL1.003), except at high (>60°) latitudes, where GMTED is used. Where higher resolution datasets are available (e.g., [CDEM](https://open.canada.ca/data/en/dataset/7f245e4d-76c2-4caa-951a-45d1d2051333) in Canada), they are used in place of SRTM for medium-to-high resolutions. At all resolutions, [ETOPO1](https://www.ncei.noaa.gov/metadata/geoportal/rest/metadata/item/gov.noaa.ngdc.mgg.dem%3A316/html#) is used to provide bathymetric data. In any specific region, the sources used can be determined from [this table](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-sourced-at-what-zooms). Information on appropriate data attribution can be found [here](https://github.com/tilezen/joerd/blob/master/docs/attribution.md#attribution). + +# 4.2 Downloading elevation data with `elevation_download()` {#4.2download} + +MapZen's Terrain Tile dataset is hosted on the [Amazon Web Service (AWS)](https://registry.opendata.aws/terrain-tiles/). Normally, getting data from the AWS into R would be a complicated task on its own. Thankfully, various R packages have taken up the task of easing this process. + +The United States Environmental Protection Agency has created the R Package [`elevatr`](https://github.com/USEPA/elevatr), providing easy access to the MapZen Terrain Tiles dataset within R. In `elevation_download()`, we employ functions from `elevatr` and add quality of life features to further automate the downloading of elevation data. + +First, lets prep some data from NatureCounts for use in downloading elevation data using `data_fmt()`. `elevation_download()` requires input data in either `sf` or `terra` spatial format. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude and longitude)! +# We'll need to to convert it into an sf object for use in elevation_download(). +bcch %>% + select(latitude, longitude) %>% + head() +#> latitude longitude +#> 1 45.81553 -77.14251 +#> 2 45.81553 -77.14251 +#> 3 45.55757 -77.41739 +#> 4 45.55757 -77.41739 +#> 5 45.79170 -76.90276 +#> 6 45.79170 -76.90276 + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be +#> EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry +#> 1 POINT (1462530 839736.7) +#> 2 POINT (1462530 839736.7) +#> 3 POINT (1449503 806527.6) +#> 4 POINT (1449503 806527.6) +#> 5 POINT (1481359 842474.9) +#> 6 POINT (1481359 842474.9) +``` +With our data prepared, we can make a call to elevation_download() to begin downloading elevation data. There are a few important decisions to make at this stage. First using the `negative_to_na` argument, we can choose whether we want negative elevation values in the datasets to be converted to `NA`. These negative elevation values can represent a few different things: + +1. True inland areas with elevations below sea level. +2. Fill values from certain datasets in the compositing process (i.e., areas of missing data that should be marked with NA). +3. Bathymetry values representing sea depth in coastal areas. + +With these options in mind, users should consider whether it is appropriate to retain the negative elevation values. Since our data is from inland Ontario, Canada, where most areas are above sea level, we will choose to convert negative values to `NA` to ensure that fill values are treated appropriately. We can do this by setting `negative_to_na = TRUE`. + +Next, users must consider what spatial resolution would be most appropriate for their analysis. In `elevatr`, the end spatial resolution is determined by the "map zoom" level requested and the latitude of the requested area. An approximate scale comparing map zoom levels to ground resolutions in metres can be found [here](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-the-ground-resolution). In `elevation_download()`, the map zoom level is specified using the `z` argument. We recommend checking the resolution of the downloaded rasters after calling `elevation_download()` using `terra::res()`. We will use the default `z = 7`, providing an approximately 400m spatial resolution. + + +``` r +# Let's download some files! Files will be downloaded into a 'TerrainTiles/' subdirectory in your current working directory. + +elev <- elevation_download(data = formatted, + negative_to_na = TRUE, + z = 7, + dl_path = "./TerrainTiles") +#> [Elevation Download] downloading data. + +elev +#> class : SpatRaster +#> size : 628, 637, 1 (nrow, ncol, nlyr) +#> resolution : 424.2925, 424.2925 (x, y) +#> extent : 1306489, 1576763, 729231.5, 995687.2 (xmin, xmax, ymin, ymax) +#> coord. ref. : +proj=aea +lat_0=40 +lon_0=-96 +lat_1=50 +lat_2=70 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs +#> source(s) : memory +#> name : file823050c4cc9 +#> min value : 2 +#> max value : 1492 +``` + +Examining the `elev` object, we can see it is a `terra::SpatRaster` containing our composited data. All downloaded files can be found by default in the created `./TerrainTiles` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .tif format, with each file containing raster data for one map tile. The `SpatRaster` output by `elevation_download()` is a merged representation of these files. This could be recreated using `elevatr::merge_rasters()`. + +# 4.3 Extracting elevation data with `elevation_extract()` {#4.3extract} + +Once we have gathered the appropriate elevation data rasters, using `elevation_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `elevation_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the elevation value of the raster grid cell that each site point falls within in a column named `elevation`. This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean elevation of cells overlapped by each polygon, again in a column called `elevation`. This is carried out via a call to `exactextractr::exact_extract()`. + +To execute these extractions, we will need to point `elevation_extract()` to the object containing our elevation data using the argument `elevation_data`. Conveniently, this object is exactly the output of `elevation_download()` that we stored in our `elev` object. + + +``` r +# We will start by fetching the elevation data for our point dataset created above. +output <- elevation_extract(data = formatted, + elevation_data = elev) +#> [Elevation Extraction] extracting elevation data. + +head(output) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry elevation +#> 1 POINT (1462530 839736.7) 136 +#> 2 POINT (1462530 839736.7) 136 +#> 3 POINT (1449503 806527.6) 179 +#> 4 POINT (1449503 806527.6) 179 +#> 5 POINT (1481359 842474.9) 108 +#> 6 POINT (1481359 842474.9) 108 +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean elevation within a 500 m radius of each observation. + + +``` r +buffered <- data_buff(data = formatted) +#> [Data Buffering] buffering sites by 500m radius (default). + +output <- elevation_extract(data = buffered, + elevation_data = elev) +#> [Elevation Extraction] extracting elevation data. + +head(output) +#> Simple feature collection with 6 features and 7 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1449003 ymin: 806027.6 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry elevation +#> 1 POLYGON ((1463030 839736.7,... 132.5853 +#> 2 POLYGON ((1463030 839736.7,... 132.5853 +#> 3 POLYGON ((1450003 806527.6,... 179.8404 +#> 4 POLYGON ((1450003 806527.6,... 179.8404 +#> 5 POLYGON ((1481859 842474.9,... 110.5203 +#> 6 POLYGON ((1481859 842474.9,... 110.5203 +``` + +We can see that the mean elevation values have been added in the `elevation` column. + +# 4.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names data can be provided directly to `elevation_download()` and `elevation_extract()` via the `site_name` argument. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `elevation_` function, you do not need to specify this information again. + +By default, the elevation files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `elevation_extract()`. + +Once you've extracted your elevation data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate elevation data for your observation data using `elevation_download()` and `elevation_extract()`. diff --git a/vignettes/articles/4.4-Elevation.Rmd.orig b/vignettes/articles/4.4-Elevation.Rmd.orig new file mode 100644 index 00000000..e031050c --- /dev/null +++ b/vignettes/articles/4.4-Elevation.Rmd.orig @@ -0,0 +1,134 @@ +--- +title: "Chapter 4 - Downloading and Extracting Elevation Data" +author: "Rory Macklin" +date: "2026-06-09" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 4 - Downloading and Extracting Elevation Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 4: Downloading and Extracting Elevation Data + +##### Author: Rory Macklin + +> While animal populations may not directly respond to changes in elevation, they frequently depend significantly on correlates of elevation (e.g., temperature, habitat type). For this reason, elevation is frequently included in species distribution models, and can be used to proxy a number of difficult-to-map features when correlates are well understood. This is all possible due to the global and broad availability of satellite-derived digital elevation models (DEMs). + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in elevation data download and extraction functions. + +# 4.0 Learning Objectives + +By the end of **Chapter 4 - Downloading and Extracting Elevation Data**, users will know how to: + +- Have a basic understanding of the MapZen Terrain Tiles dataset accessed through `elevation_download()` and `elevation_extract()`: [MapZen Terrain Tiles Data](#4.1elevation). +- Use `elevation_download()` to download MapZen Terrain Tiles data ready to match to observations in your data: [Downloading elevation data with `elevation_download()`](#4.2download). +- Use `elevation_extract()` to extract and summarize MapZen Terrain Tiles data for each observation in their data: [Extracting elevation data with `elevation_extract()`](#4.3extract). + +This R tutorial requires the following packages: + +``` {r} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 4.1 MapZen Terrain Tiles Data {#4.1elevation} + +The [MapZen Terrain Tiles dataset](github.com/tilezen/joerd/tree/master/docs) is a globally-composited dataset of gridded elevation data. The product can be accessed at a variety of spatial resolutions and the data has a static temporal resolution. The massive coverage and flexible spatial resolution of these data make them ideal candidates for generalizable use in ecological research, being able to inform analyses at a variety of scales. + +These data are composited from a wide variety of DEMs from across the globe. The full list of sources can be found [here](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#list-of-sources). Generally speaking, when data on land is requested at low spatial resolution data is sourced from [GMTED](https://www.usgs.gov/coastal-changes-and-impacts/gmted2010). At medium-to-high spatial resolutions data for land areas are sourced from [SRTM](https://doi.org/10.5067/MEASURES/SRTM/SRTMGL1.003), except at high (>60°) latitudes, where GMTED is used. Where higher resolution datasets are available (e.g., [CDEM](https://open.canada.ca/data/en/dataset/7f245e4d-76c2-4caa-951a-45d1d2051333) in Canada), they are used in place of SRTM for medium-to-high resolutions. At all resolutions, [ETOPO1](https://www.ncei.noaa.gov/metadata/geoportal/rest/metadata/item/gov.noaa.ngdc.mgg.dem%3A316/html#) is used to provide bathymetric data. In any specific region, the sources used can be determined from [this table](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-sourced-at-what-zooms). Information on appropriate data attribution can be found [here](https://github.com/tilezen/joerd/blob/master/docs/attribution.md#attribution). + +# 4.2 Downloading elevation data with `elevation_download()` {#4.2download} + +MapZen's Terrain Tile dataset is hosted on the [Amazon Web Service (AWS)](https://registry.opendata.aws/terrain-tiles/). Normally, getting data from the AWS into R would be a complicated task on its own. Thankfully, various R packages have taken up the task of easing this process. + +The United States Environmental Protection Agency has created the R Package [`elevatr`](https://github.com/USEPA/elevatr), providing easy access to the MapZen Terrain Tiles dataset within R. In `elevation_download()`, we employ functions from `elevatr` and add quality of life features to further automate the downloading of elevation data. + +First, lets prep some data from NatureCounts for use in downloading elevation data using `data_fmt()`. `elevation_download()` requires input data in either `sf` or `terra` spatial format. You can provide your own data in this format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude and longitude)! +# We'll need to to convert it into an sf object for use in elevation_download(). +bcch %>% + select(latitude, longitude) %>% + head() + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` +With our data prepared, we can make a call to elevation_download() to begin downloading elevation data. There are a few important decisions to make at this stage. First using the `negative_to_na` argument, we can choose whether we want negative elevation values in the datasets to be converted to `NA`. These negative elevation values can represent a few different things: + +1. True inland areas with elevations below sea level. +2. Fill values from certain datasets in the compositing process (i.e., areas of missing data that should be marked with NA). +3. Bathymetry values representing sea depth in coastal areas. + +With these options in mind, users should consider whether it is appropriate to retain the negative elevation values. Since our data is from inland Ontario, Canada, where most areas are above sea level, we will choose to convert negative values to `NA` to ensure that fill values are treated appropriately. We can do this by setting `negative_to_na = TRUE`. + +Next, users must consider what spatial resolution would be most appropriate for their analysis. In `elevatr`, the end spatial resolution is determined by the "map zoom" level requested and the latitude of the requested area. An approximate scale comparing map zoom levels to ground resolutions in metres can be found [here](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-the-ground-resolution). In `elevation_download()`, the map zoom level is specified using the `z` argument. We recommend checking the resolution of the downloaded rasters after calling `elevation_download()` using `terra::res()`. We will use the default `z = 7`, providing an approximately 400m spatial resolution. + +``` {r} +# Let's download some files! Files will be downloaded into a 'TerrainTiles/' subdirectory in your current working directory. + +elev <- elevation_download(data = formatted, + negative_to_na = TRUE, + z = 7, + dl_path = "./TerrainTiles") + +elev +``` + +Examining the `elev` object, we can see it is a `terra::SpatRaster` containing our composited data. All downloaded files can be found by default in the created `./TerrainTiles` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .tif format, with each file containing raster data for one map tile. The `SpatRaster` output by `elevation_download()` is a merged representation of these files. This could be recreated using `elevatr::merge_rasters()`. + +# 4.3 Extracting elevation data with `elevation_extract()` {#4.3extract} + +Once we have gathered the appropriate elevation data rasters, using `elevation_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate tile. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `elevation_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the elevation value of the raster grid cell that each site point falls within in a column named `elevation`. This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean elevation of cells overlapped by each polygon, again in a column called `elevation`. This is carried out via a call to `exactextractr::exact_extract()`. + +To execute these extractions, we will need to point `elevation_extract()` to the object containing our elevation data using the argument `elevation_data`. Conveniently, this object is exactly the output of `elevation_download()` that we stored in our `elev` object. + +``` {r} +# We will start by fetching the elevation data for our point dataset created above. +output <- elevation_extract(data = formatted, + elevation_data = elev) + +head(output) +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean elevation within a 500 m radius of each observation. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- elevation_extract(data = buffered, + elevation_data = elev) + +head(output) +``` + +We can see that the mean elevation values have been added in the `elevation` column. + +# 4.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names data can be provided directly to `elevation_download()` and `elevation_extract()` via the `site_name` argument. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `elevation_` function, you do not need to specify this information again. + +By default, the elevation files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `elevation_extract()`. + +Once you've extracted your elevation data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate elevation data for your observation data using `elevation_download()` and `elevation_extract()`. \ No newline at end of file diff --git a/vignettes/articles/4.5-WorldClim.Rmd b/vignettes/articles/4.5-WorldClim.Rmd new file mode 100644 index 00000000..855795ed --- /dev/null +++ b/vignettes/articles/4.5-WorldClim.Rmd @@ -0,0 +1,239 @@ +--- +title: "Chapter 5 - Downloading and Extracting WorldClim Data" +author: "Rory Macklin" +date: "2026-06-14" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 5 - Downloading and Extracting WorldClim Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + +# Chapter 5: Downloading and Extracting WorldClim Data + +##### Author: Rory Macklin + +> Climate norms can determine species' distributions by modulating the availability of particular habitat types, but also by exerting physiological pressure on species. Though climate norms are shifting, historical norms can be useful with older species occurence data, or as a point of comparison to current or future predicted conditions. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in WorldClim data download and extraction functions. + +# 5.0 Learning Objectives + +By the end of **Chapter 5 - Downloading and Extracting WorldClim Data**, users will: + +- Have a basic understanding of the WorldClim dataset accessed through `worldclim_download()` and `worldclim_extract()`: [WorldClim data](#5.1worldclim). +- Be able to use `worldclim_download()` to download Worldclim data ready to match to observations in your data: [Downloading WorldClim data with `worldclim_download()`](#5.2download). +- Be able to use `worldclim_extract()` to extract and summarize WorldClim data for each observation in their data: [Extracting WorldClim data with `worldclim_extract()`](#5.3extract). + +This R tutorial requires the following packages: + + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 5.1 WorldClim data {#5.1worldclim} + +The [WorldClim dataset](https://www.worldclim.org/) is a global dataset of gridded climatic data at a ~ 1 km resolution, with the monthly average from 1970-2000 available for several climatic variables. The variables available through `naturecounts` include: + +- Average temperature (°C) +- Average minimum temperature (°C) +- Average maximum temperature (°C) +- Average total precipitation (mm) +- Average incident solar radiation (kJ/m^2/day) +- Average wind speed (2 m above the ground; m/s) + +These average values are modeled from weather station data interpolated using satellite data such as elevation and surface temperature. For more information about the generation of this dataset, see [Fick & Hijmans (2017)](https://doi.org/10.1002/joc.5086). + +# 5.2 Downloading WorldClim data with `worldclim_download()` {#5.2download} + +WorldClim data can be accessed from their [website](https://www.worldclim.org/). While these are easily accessible, the entire global dataset is downloaded at once, making filesizes large, even if only a smaller area of data is needed. Thankfully, various R packages have allowed for reduced areas to be downloaded. + +The R Package [`geodata`](https://github.com/rspatial/geodata) provides easy access to a number of geographic datasets within R, including the WorldClim dataset. In `worldclim_download()`, we employ functions from `geodata` and add quality of life features to further automate the downloading of WorldClim data. + +First, lets prep some data from NatureCounts for use in downloading WorldClim data using `data_fmt()`. `worldclim_download()` reduces the required download from the global dataset to just the national dataset(s) required. This function needs input data in either `sf` or `terra` spatial format or can be called without input data if the country name(s) for data to be downloaded for is provided. If providing input spatial data, you can provide your own data in the required format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and month)! +# We'll need to to convert it into an sf object for use in worldclim_download(). +bcch %>% + select(latitude, longitude, survey_month) %>% + head() +#> latitude longitude survey_month +#> 1 45.81553 -77.14251 11 +#> 2 45.81553 -77.14251 12 +#> 3 45.55757 -77.41739 12 +#> 4 45.55757 -77.41739 12 +#> 5 45.79170 -76.90276 4 +#> 6 45.79170 -76.90276 4 + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be +#> EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry +#> 1 POINT (1462530 839736.7) +#> 2 POINT (1462530 839736.7) +#> 3 POINT (1449503 806527.6) +#> 4 POINT (1449503 806527.6) +#> 5 POINT (1481359 842474.9) +#> 6 POINT (1481359 842474.9) +``` +With our data prepared, we can make a call to `worldclim_download()` to begin downloading WorldClim data. If we provide the spatial data we have generated, `worldclim_download()` will attempt to identify the country or countries that the data falls within. Since all of our test data falls within Canada, we could provide the country name "Canada" or the [ISO3 code](https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3) "CAN" to the `countries` argument instead of our input data and achieve the same result. + +At this stage, we also need to decide which climatic variables we want to download. We can provide the following names to the `covariates` argument to download one or multiple datasets: + +- `worldclim_tavg` - average temperature (°C) +- `worldclim_tmin` - average minimum temperature (°C) +- `worldclim_tmax` - average maximum temperature (°C) +- `worldclim_prec` - average total precipitation (mm) +- `worldclim_srad` - average incident solar radiation (kJ/m^2/day) +- `worldclim_wind` - average wind speed (2 m above the ground; m/s) + +We will download the minimum and maximum temperature datasets. + + +``` r +# Let's download some files! Files will be downloaded into a 'worldclim/' subdirectory in your current working directory. + +climate_data <- worldclim_download(data = formatted, + covariates = c("worldclim_tmax", "worldclim_tmin")) + +climate_data +#> $tmax +#> class : SpatRaster +#> size : 5040, 10680, 12 (nrow, ncol, nlyr) +#> resolution : 0.008333333, 0.008333333 (x, y) +#> extent : -141.5, -52.5, 41.5, 83.5 (xmin, xmax, ymin, ymax) +#> coord. ref. : lon/lat WGS 84 (EPSG:4326) +#> source : CAN_wc2.1_30s_tmax.tif +#> names : CAN_w~max_1, CAN_w~max_2, CAN_w~max_3, CAN_w~max_4, CAN_w~max_5, CAN_w~max_6, ... +#> min values : -38.599998, -40.5, -39.099998, -30.6, -21.1, -14.6, ... +#> max values : 13.2, 13.9, 15.9, 20.200001, 26.6, 31.799999, ... +#> +#> $tmin +#> class : SpatRaster +#> size : 5040, 10680, 12 (nrow, ncol, nlyr) +#> resolution : 0.008333333, 0.008333333 (x, y) +#> extent : -141.5, -52.5, 41.5, 83.5 (xmin, xmax, ymin, ymax) +#> coord. ref. : lon/lat WGS 84 (EPSG:4326) +#> source : CAN_wc2.1_30s_tmin.tif +#> names : CAN_w~min_1, CAN_w~min_2, CAN_w~min_3, CAN_w~min_4, CAN_w~min_5, CAN_w~min_6, ... +#> min values : -46.099998, -47.799999, -47.599998, -38.799999, -23.799999, -17.700001, ... +#> max values : 5.8, 5.7, 6, 6.7, 10.8, 16.299999, ... +``` + +Examining the `climate_data` object, we can see it is a list containing two `terra::SpatRaster` containing our requested data for Canada. All downloaded files can be found by default in the created `./worldclim` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .tif format, with each file containing raster data for one of the requested countries, with a layer containing the reqeuested climate variables for each month. The `SpatRaster` output by `worldclim_download()` is a merged representation of these files. + +# 5.3 Extracting WorldClim data with `worldclim_extract()` {#5.3extract} + +Once we have gathered the appropriate WorldClim data rasters, using `worldclim_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate country file and month. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `worldclim_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the climate variable value of the raster grid cell that each site point falls within for the appropriate month in a column named following the abbreviated name of that variable (e.g., `tmax`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean climate variable value of cells overlapped by each polygon for the appropriate month, again in a column named following the variable's abbreviated name. This is carried out via a call to `exactextractr::exact_extract()`. + +The input data must also have a column containing the month in which each observation was made. By default, `worldclim_extract()` searches for this information in the BMDE column `survey_month` (included by default in data downloaded through `naturecounts`), but alternate month column names can be specified using the `date_month` argument. + +To execute these extractions, we will need to point `worldclim_extract()` to the object containing our WorldClim data using the argument `worldclim_data`. Conveniently, this object is exactly the output of `worldclim_download()` that we stored in our `climate_data` object. + + +``` r +# We will start by fetching the WorldClim data for our point dataset created above. +output <- worldclim_extract(data = formatted, + covariates = c("worldclim_tmax", "worldclim_tmin"), + worldclim_data = climate_data) +#> [WorldClim Extraction] extracting WorldClim tmax. +#> [WorldClim Extraction] extracting WorldClim tmin. + +head(output) +#> Simple feature collection with 6 features and 8 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry tmax tmin +#> 1 POINT (1462530 839736.7) 4.9 -2.9 +#> 2 POINT (1462530 839736.7) -2.9 -12.1 +#> 3 POINT (1449503 806527.6) -2.6 -12.1 +#> 4 POINT (1449503 806527.6) -2.6 -12.1 +#> 5 POINT (1481359 842474.9) 9.1 -2.0 +#> 6 POINT (1481359 842474.9) 9.1 -2.0 +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean average maximum and minimum montly temperature within a 500 m radius of each observation. + + +``` r +buffered <- data_buff(data = formatted) +#> [Data Buffering] buffering sites by 500m radius (default). + +output <- worldclim_extract(data = buffered, + covariates = c("worldclim_tmax", "worldclim_tmin"), + worldclim_data = climate_data) +#> [WorldClim Extraction] extracting WorldClim tmax. +#> [WorldClim Extraction] extracting WorldClim tmin. + +head(output) +#> Simple feature collection with 6 features and 8 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1449003 ymin: 806027.6 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 1999 11 18 +#> 2 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 3 FilledSurveyArea2 45.55757 -77.41739 1999 12 19 +#> 4 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 5 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> 6 FilledSurveyArea3 45.79170 -76.90276 1999 4 17 +#> geometry tmax tmin +#> 1 POLYGON ((1463030 839736.7,... 4.968483 -2.797274 +#> 2 POLYGON ((1463030 839736.7,... -2.831517 -12.031516 +#> 3 POLYGON ((1450003 806527.6,... -2.583323 -12.083324 +#> 4 POLYGON ((1450003 806527.6,... -2.583323 -12.083324 +#> 5 POLYGON ((1481859 842474.9,... 9.096169 -2.025829 +#> 6 POLYGON ((1481859 842474.9,... 9.096169 -2.025829 +``` + +We can see that the mean minimum and maximum temperature values have been added in the `tmax` and `tmin` column. + +# 5.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and month data can be provided directly to `worldclim_download()` and `worldclim_extract()` via the `site_name` and `date_month` argument respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `worldclim_` function, you do not need to specify this information again. + +By default, the WorldClim files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `worldclim_extract()`. + +Once you've extracted your WorldClim data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate WorldClim data for your observation data using `worldclim_download()` and `worldclim_extract()`. diff --git a/vignettes/articles/4.5-WorldClim.Rmd.orig b/vignettes/articles/4.5-WorldClim.Rmd.orig new file mode 100644 index 00000000..27eb9675 --- /dev/null +++ b/vignettes/articles/4.5-WorldClim.Rmd.orig @@ -0,0 +1,146 @@ +--- +title: "Chapter 5 - Downloading and Extracting WorldClim Data" +author: "Rory Macklin" +date: "2026-06-14" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 5 - Downloading and Extracting WorldClim Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 5: Downloading and Extracting WorldClim Data + +##### Author: Rory Macklin + +> Climate norms can determine species' distributions by modulating the availability of particular habitat types, but also by exerting physiological pressure on species. Though climate norms are shifting, historical norms can be useful with older species occurence data, or as a point of comparison to current or future predicted conditions. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in WorldClim data download and extraction functions. + +# 5.0 Learning Objectives + +By the end of **Chapter 5 - Downloading and Extracting WorldClim Data**, users will: + +- Have a basic understanding of the WorldClim dataset accessed through `worldclim_download()` and `worldclim_extract()`: [WorldClim data](#5.1worldclim). +- Be able to use `worldclim_download()` to download Worldclim data ready to match to observations in your data: [Downloading WorldClim data with `worldclim_download()`](#5.2download). +- Be able to use `worldclim_extract()` to extract and summarize WorldClim data for each observation in their data: [Extracting WorldClim data with `worldclim_extract()`](#5.3extract). + +This R tutorial requires the following packages: + +``` {r} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 5.1 WorldClim data {#5.1worldclim} + +The [WorldClim dataset](https://www.worldclim.org/) is a global dataset of gridded climatic data at a ~ 1 km resolution, with the monthly average from 1970-2000 available for several climatic variables. The variables available through `naturecounts` include: + +- Average temperature (°C) +- Average minimum temperature (°C) +- Average maximum temperature (°C) +- Average total precipitation (mm) +- Average incident solar radiation (kJ/m^2/day) +- Average wind speed (2 m above the ground; m/s) + +These average values are modeled from weather station data interpolated using satellite data such as elevation and surface temperature. For more information about the generation of this dataset, see [Fick & Hijmans (2017)](https://doi.org/10.1002/joc.5086). + +# 5.2 Downloading WorldClim data with `worldclim_download()` {#5.2download} + +WorldClim data can be accessed from their [website](https://www.worldclim.org/). While these are easily accessible, the entire global dataset is downloaded at once, making filesizes large, even if only a smaller area of data is needed. Thankfully, various R packages have allowed for reduced areas to be downloaded. + +The R Package [`geodata`](https://github.com/rspatial/geodata) provides easy access to a number of geographic datasets within R, including the WorldClim dataset. In `worldclim_download()`, we employ functions from `geodata` and add quality of life features to further automate the downloading of WorldClim data. + +First, lets prep some data from NatureCounts for use in downloading WorldClim data using `data_fmt()`. `worldclim_download()` reduces the required download from the global dataset to just the national dataset(s) required. This function needs input data in either `sf` or `terra` spatial format or can be called without input data if the country name(s) for data to be downloaded for is provided. If providing input spatial data, you can provide your own data in the required format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and month)! +# We'll need to to convert it into an sf object for use in worldclim_download(). +bcch %>% + select(latitude, longitude, survey_month) %>% + head() + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` +With our data prepared, we can make a call to `worldclim_download()` to begin downloading WorldClim data. If we provide the spatial data we have generated, `worldclim_download()` will attempt to identify the country or countries that the data falls within. Since all of our test data falls within Canada, we could provide the country name "Canada" or the [ISO3 code](https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3) "CAN" to the `countries` argument instead of our input data and achieve the same result. + +At this stage, we also need to decide which climatic variables we want to download. We can provide the following names to the `covariates` argument to download one or multiple datasets: + +- `worldclim_tavg` - average temperature (°C) +- `worldclim_tmin` - average minimum temperature (°C) +- `worldclim_tmax` - average maximum temperature (°C) +- `worldclim_prec` - average total precipitation (mm) +- `worldclim_srad` - average incident solar radiation (kJ/m^2/day) +- `worldclim_wind` - average wind speed (2 m above the ground; m/s) + +We will download the minimum and maximum temperature datasets. + +``` {r} +# Let's download some files! Files will be downloaded into a 'worldclim/' subdirectory in your current working directory. + +climate_data <- worldclim_download(data = formatted, + covariates = c("worldclim_tmax", "worldclim_tmin")) + +climate_data +``` + +Examining the `climate_data` object, we can see it is a list containing two `terra::SpatRaster` containing our requested data for Canada. All downloaded files can be found by default in the created `./worldclim` subdirectory or at a custom path specified using the argument `dl_path`. Files are in .tif format, with each file containing raster data for one of the requested countries, with a layer containing the reqeuested climate variables for each month. The `SpatRaster` output by `worldclim_download()` is a merged representation of these files. + +# 5.3 Extracting WorldClim data with `worldclim_extract()` {#5.3extract} + +Once we have gathered the appropriate WorldClim data rasters, using `worldclim_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate country file and month. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `worldclim_extract()` can help make the process quicker and easier. + +This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the climate variable value of the raster grid cell that each site point falls within for the appropriate month in a column named following the abbreviated name of that variable (e.g., `tmax`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean climate variable value of cells overlapped by each polygon for the appropriate month, again in a column named following the variable's abbreviated name. This is carried out via a call to `exactextractr::exact_extract()`. + +The input data must also have a column containing the month in which each observation was made. By default, `worldclim_extract()` searches for this information in the BMDE column `survey_month` (included by default in data downloaded through `naturecounts`), but alternate month column names can be specified using the `date_month` argument. + +To execute these extractions, we will need to point `worldclim_extract()` to the object containing our WorldClim data using the argument `worldclim_data`. Conveniently, this object is exactly the output of `worldclim_download()` that we stored in our `climate_data` object. + +``` {r} +# We will start by fetching the WorldClim data for our point dataset created above. +output <- worldclim_extract(data = formatted, + covariates = c("worldclim_tmax", "worldclim_tmin"), + worldclim_data = climate_data) + +head(output) +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean average maximum and minimum montly temperature within a 500 m radius of each observation. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- worldclim_extract(data = buffered, + covariates = c("worldclim_tmax", "worldclim_tmin"), + worldclim_data = climate_data) + +head(output) +``` + +We can see that the mean minimum and maximum temperature values have been added in the `tmax` and `tmin` column. + +# 5.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and month data can be provided directly to `worldclim_download()` and `worldclim_extract()` via the `site_name` and `date_month` argument respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `worldclim_` function, you do not need to specify this information again. + +By default, the WorldClim files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `worldclim_extract()`. + +Once you've extracted your WorldClim data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate WorldClim data for your observation data using `worldclim_download()` and `worldclim_extract()`. \ No newline at end of file diff --git a/vignettes/articles/4.6-SCANFI.Rmd b/vignettes/articles/4.6-SCANFI.Rmd new file mode 100644 index 00000000..34e52f1f --- /dev/null +++ b/vignettes/articles/4.6-SCANFI.Rmd @@ -0,0 +1,323 @@ +--- +title: "Chapter 6 - Downloading and Extracting SCANFI Data" +author: "Rory Macklin" +date: "2026-06-28" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 6 - Downloading and Extracting SCANFI Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +# Chapter 6: Downloading and Extracting SCANFI Data + +##### Author: Rory Macklin + +> Forest structure is a key habitat feature for many birds, as well as many other organisms. With detailed information on forest age, height, and species composition in Canada, the SCANFI dataset offers a significant opportunity to gain insight into species' habitat preferences and other ecological relationships. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in SCANFI data download and extraction functions. + +# 6.0 Learning Objectives + +By the end of **Chapter 6 - Downloading and Extracting SCANFI Data**, users will: + +- Have a basic understanding of the SCANFI dataset accessed through `scanfi_download()` and `scanfi_extract()`: [SCANFI data](#6.1scanfi). +- Be able to use `scanfi_download()` to download SCANFI data ready to match to observations in your data: [Downloading SCANFI data with `scanfi_download()`](#6.2download). +- Be able to use `scanfi_extract()` to extract and summarize SCANFI data for each observation in their data: [Extracting SCANFI data with `scanfi_extract()`](#6.3extract). + +This R tutorial requires the following packages: + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 6.1 SCANFI data {#6.1scanfi} + +The [Spatialized CAnadian National Forest Inventory (SCANFI) dataset](https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf) is a wall-to-wall Canadian dataset of gridded forest structure and land cover data at a \~ 30 m resolution, with annual snapshots of a number of variables every 5 years from 1985-2025. The variables available through `naturecounts` include: + +- Forest age (years) +- Forest biomass (tons/ha) +- Crown closure (% of pixel covered by tree canopy) +- Forest height (m) +- National Forest Inventory land cover (NFILC) class +- Balsam Fir cover (% of pixel) +- Black Spruce cover (% of pixel) +- Douglas Fir cover (% of pixel) +- Jack Pine cover (% of pixel) +- Lodgepole Pine cover (% of pixel) +- Ponderosa Pine cover (% of pixel) +- Tamarack cover (% of pixel) +- White and Red Pine cover (% of pixel) +- Broadleaf tree species cover (% of pixel) +- Other conifer species cover (% of pixel) + +These values are modeled from a variety of satellite- and ground-derived data sources and provide useful snapshots of forest structure at different times across the last 4 decades. For more information about the generation of this dataset, see [Guindon et al. (2024)](https://doi.org/10.1139/cjfr-2023-0118) and [Guindon et al. (2026)](https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf). + +# 6.2 Downloading SCANFI data with `scanfi_download()` {#6.2download} + +SCANFI data can be accessed from freely via an [FTP server](https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/). While these data are easily accessible, the filenames can be difficult to read, and users must ensure they download all snapshot years needed for each variable desired. This is a step the `naturecounts` package aims to eliminate to promote ease of access to these fantastic data. + +First, lets prep some data from NatureCounts for use in downloading SCANFI data using `data_fmt()`. THe function we will use to download SCANFI data - `scanfi_download()` - needs input data in either `data.frame`, `sf` or `terra` spatial format containing a column for each observation with the year the observation was made, or can be called without input data if the desired snapshot years to be downloaded are provided. If providing input data, you can provide your own data in the required format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and year)! +# We'll convert it into an sf object for use in scanfi_download(). +bcch %>% + select(latitude, longitude, survey_year) %>% + head() +#> latitude longitude survey_year +#> 1 45.81553 -77.14251 1999 +#> 2 45.81553 -77.14251 2000 +#> 3 45.55757 -77.41739 1999 +#> 4 45.55757 -77.41739 2000 +#> 5 45.79170 -76.90276 2000 +#> 6 45.79170 -76.90276 1999 + +# To reduce the necessary downloads, we will restrict our data to years 2000-2007. + +bcch <- bcch[bcch$survey_year %in% c(2000:2007),] + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be +#> EPSG:4326. + +head(formatted) +#> Simple feature collection with 3 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 2 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 3 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> geometry +#> 1 POINT (1462530 839736.7) +#> 2 POINT (1449503 806527.6) +#> 3 POINT (1481359 842474.9) +``` + +With our data prepared, we can make a call to `scanfi_download()` to begin downloading SCANFI data. If we provide the spatial data we have generated, `scanfi_download()` will attempt to identify the snapshot year(s) that the data fall closest to. Alternatively, we could specify the years we want the function to download by setting `use_date = FALSE` and `snapshot_year = c(2000, 2005)`. + +At this stage, we also need to decide which SCANFI variables we want to download. We can provide the following names to the `covariates` argument to download one or multiple datasets: + +- Forest age (years): `scanfi_age` +- Forest biomass (tons/ha): `scanfi_biomass` +- Crown closure (% of pixel covered by tree canopy): `scanfi_closure` +- Forest height (m): `scanfi_height` +- National Forest Inventory land cover (NFILC) class: `scanfi_nfilc` +- Balsam Fir cover (% of pixel): `scanfi_balsamfir` +- Black Spruce cover (% of pixel): `scanfi_blackspruce` +- Douglas Fir cover (% of pixel): `scanfi_douglasfir` +- Jack Pine cover (% of pixel): `scanfi_jackpine` +- Lodgepole Pine cover (% of pixel): `scanfi_lodgepolepine` +- Ponderosa Pine cover (% of pixel): `scanfi_ponderosapine` +- Tamarack cover (% of pixel): `scanfi_tamarack` +- White and Red Pine cover (% of pixel): `scanfi_whiteredpine` +- Broadleaf tree species cover (% of pixel): `scanfi_broadleaf` +- Other conifer species cover (% of pixel): `scanfi_otherconifer` + +We will download the forest height and NFILC dataset. Users should be aware that SCANFI data files, being at a fine spatial resolution across the entirety of Canada, are large (generally 1-5Gb per snapshot year) and should consider disk space before downloading. + +``` r +# Let's download some files! Files will be downloaded into a 'scanfi/' subdirectory in your current working directory. + +scanfi_data <- scanfi_download(data = formatted, + covariates = c("scanfi_height", "scanfi_nfilc"), + use_date = TRUE) # this is TRUE by default, telling + # the function to find the snapshot + # years needed from the data argument, + # but we include it here for clarity. + +# If we didn't have any input data, but still wanted to download the same files +# we could do so as follows: +scanfi_data <- scanfi_download(covariates = c("scanfi_height", "scanfi_nfilc"), + use_date = FALSE, + snapshot_year = c(2000, 2005)) + + +scanfi_data +#> $`2000` +#> $`2000`$height +#> class : SpatRaster +#> size : 119100, 178400, 1 (nrow, ncol, nlyr) +#> resolution : 30, 30 (x, y) +#> extent : -2341500, 3010500, 5863500, 9436500 (xmin, xmax, ymin, ymax) +#> coord. ref. : NAD_1983_Canada_Lambert +#> source : SCANFI_att_height_2000_v2_20260119.tif +#> name : SCANFI_att_height_2000_v2_20260119 +#> +#> $`2000`$nfilc +#> class : SpatRaster +#> size : 119100, 178400, 1 (nrow, ncol, nlyr) +#> resolution : 30, 30 (x, y) +#> extent : -2341500, 3010500, 5863500, 9436500 (xmin, xmax, ymin, ymax) +#> coord. ref. : NAD_1983_Canada_Lambert +#> source : SCANFI_att_nfiLandcover_2000_v2_20260119.tif +#> name : SCANFI_att_nfiLandcover_2000_v2_20260119 +#> +#> +#> $`2005` +#> $`2005`$height +#> class : SpatRaster +#> size : 119100, 178400, 1 (nrow, ncol, nlyr) +#> resolution : 30, 30 (x, y) +#> extent : -2341500, 3010500, 5863500, 9436500 (xmin, xmax, ymin, ymax) +#> coord. ref. : NAD_1983_Canada_Lambert +#> source : SCANFI_att_height_2005_v2_20260119.tif +#> name : SCANFI_att_height_2005_v2_20260119 +#> +#> $`2005`$nfilc +#> class : SpatRaster +#> size : 119100, 178400, 1 (nrow, ncol, nlyr) +#> resolution : 30, 30 (x, y) +#> extent : -2341500, 3010500, 5863500, 9436500 (xmin, xmax, ymin, ymax) +#> coord. ref. : NAD_1983_Canada_Lambert +#> source : SCANFI_att_nfiLandcover_2005_v2_20260119.tif +#> name : SCANFI_att_nfiLandcover_2005_v2_20260119 +``` + +Examining the `scanfi_data` object, we can see it is a list containing two sub-lists, each named for the snapshot year the data contained is from. Within each, we can find a `terra::SpatRaster` containing our requested data for that snapshot year. All downloaded files can be found by default in the created `./scanfi` subdirectory or at a custom path specified using the argument `dl_path`. + +# 6.3 Extracting SCANFI data with `scanfi_extract()` {#6.3extract} + +Once we have gathered the appropriate SCANFI data rasters, using `scanfi_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate snapshot year's data files. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `scanfi_extract()` can help make the process quicker and easier. + +`scanfi_extract()` requires input data in either a `sf` or `terra` spatial format. This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the SCANFI variable value of the raster grid cell that each site point falls within for the appropriate snapshot year in a column named following the name of that variable (e.g., `scanfi_height`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean SCANFI variable value of cells overlapped by each polygon for the appropriate snapshot year, again in a column named following the variable's name. This is carried out via a call to `exactextractr::exact_extract()`. In the case of the NFILC dataset, which contains values representing the land cover type within each 30 m pixel, polygon input data to the function will be passed through `landscapemetrics::calculate_lsm()`, returning a column for each land cover class containing the percent of the polygon area covered by that land cover class. + +The input data must also have a column containing the name of the site each observation was made at and the year the observation was made. By default, `scanfi_extract()` searches for this information in the BMDE columns `SurveyAreaIdentifier` and `survey_year` respectively (included by default in data downloaded through `naturecounts`), but alternate site name and year column names can be specified using the `site_name` and `date_year` arguments. By default, `scanfi_extract()` will only extract data for years that match exactly to the snapshot years, but if users want to fill the interceding years with the value from the closest snapshot year, they can do so by setting `interpolate = TRUE`. + +To execute these extractions, we will need to point `scanfi_extract()` to the object containing our SCANFI data using the argument `scanfi_data`. Conveniently, this object is exactly the output of `scanfi_download()` that we stored in our `scanfi_data` object. + +``` r +# We will start by fetching the SCANFI height data for our point dataset created above. +output <- scanfi_extract(data = formatted, + covariates = "scanfi_height", + scanfi_data = scanfi_data, + interpolate = FALSE) # this is the default value, but + # we include it explicitly for clarity. +#> [SCANFI Extraction] extracting SCANFI height. + + +output[output$survey_year %in% c(2000, 2002, 2005),] +#> Simple feature collection with 3 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 2 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 3 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> geometry scanfi_height +#> 1 POINT (1462530 839736.7) 0 +#> 2 POINT (1449503 806527.6) 0 +#> 3 POINT (1481359 842474.9) 0 +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean forest height within a 500 m radius of each observation. This time, we'll set `interpolate = TRUE` so that the years between 2000 and 2005 and the years after 2005 are filled with the value from the nearest snapshot year. + +``` r +buffered <- data_buff(data = formatted) +#> [Data Buffering] buffering sites by 500m radius (default). + +output <- scanfi_extract(data = buffered, + covariates = "scanfi_height", + scanfi_data = scanfi_data, + interpolate = TRUE) +#> [SCANFI Extraction] extracting SCANFI height. + +output[output$survey_year %in% c(2000, 2002, 2005),] +#> Simple feature collection with 3 features and 7 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1449003 ymin: 806027.6 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 2 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 3 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> geometry scanfi_height +#> 1 POLYGON ((1463030 839736.7,... 1.946103 +#> 2 POLYGON ((1450003 806527.6,... 4.153365 +#> 3 POLYGON ((1481859 842474.9,... 4.461547 +``` + +We can see that the mean height values have been added in the `scanfi_height` column and that the years 2001 and 2002 have been filled with the value from year 2000, and the years 2003, 2004, 2006, and 2007 have been filled with the value from 2005. + +To demonstrate the different way that NFILC data are extracted, we'll extract those with our point and polygon data below. + +``` r +# Using our point data, we can see that extracting NFILC data returns a column +# called "nfilc_class" containing the land cover class of the pixel the point +# lands within. + +output <- scanfi_extract(data = formatted, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_data, + interpolate = FALSE) +#> [SCANFI Extraction] extracting SCANFI nfilc. + +output[output$survey_year %in% c(2000, 2002, 2005),] +#> Simple feature collection with 3 features and 7 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1449503 ymin: 806527.6 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 2 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 3 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> geometry nfilc_class +#> 1 POINT (1462530 839736.7) rock +#> 2 POINT (1449503 806527.6) rock +#> 3 POINT (1481359 842474.9) herbs + +# And using our buffered polygons data, we can see that extracting NFILC data +# returns a column for each land cover class containing the percent of the +# polygon's area covered by each land cover class. + +output <- scanfi_extract(data = buffered, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_data, + interpolate = FALSE) +#> [SCANFI Extraction] extracting SCANFI nfilc. + +output[output$survey_year %in% c(2000, 2002, 2005),] +#> Simple feature collection with 3 features and 14 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1449003 ymin: 806027.6 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day +#> 1 FilledSurveyArea1 45.81553 -77.14251 2000 12 16 +#> 2 FilledSurveyArea2 45.55757 -77.41739 2000 12 19 +#> 3 FilledSurveyArea3 45.79170 -76.90276 2000 4 15 +#> geometry nfilc_bryoid nfilc_herbs nfilc_rock nfilc_shrub +#> 1 POLYGON ((1463030 839736.7,... 0.00000000 23.010381 56.83391003 3.546713 +#> 2 POLYGON ((1450003 806527.6,... 0.00000000 5.793226 61.14081996 4.010695 +#> 3 POLYGON ((1481859 842474.9,... 0.08912656 36.987522 0.08912656 12.299465 +#> nfilc_treed_broadleaf nfilc_treed_conifer nfilc_treed_mixed nfilc_water +#> 1 11.50519 1.211073 3.892734 0.00000 +#> 2 16.66667 3.475936 8.912656 0.00000 +#> 3 26.11408 2.762923 7.843137 13.81462 +``` + +# 6.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year data can be provided directly to `scanfi_download()` and `scanfi_extract()` via the `site_name` and `date_yera` argument respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `scanfi_` function, you do not need to specify this information again. + +By default, the SCANFI files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `scanfi_extract()`. + +Once you've extracted your SCANFI data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate SCANFI data for your observation data using `scanfi_download()` and `scanfi_extract()`. diff --git a/vignettes/articles/4.6-SCANFI.Rmd.orig b/vignettes/articles/4.6-SCANFI.Rmd.orig new file mode 100644 index 00000000..c443ba9d --- /dev/null +++ b/vignettes/articles/4.6-SCANFI.Rmd.orig @@ -0,0 +1,206 @@ +--- +title: "Chapter 6 - Downloading and Extracting SCANFI Data" +author: "Rory Macklin" +date: "2026-06-28" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 6 - Downloading and Extracting SCANFI Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 6: Downloading and Extracting SCANFI Data + +##### Author: Rory Macklin + +> Forest structure is a key habitat feature for many birds, as well as many other organisms. With detailed information on forest age, height, and species composition in Canada, the SCANFI dataset offers a significant opportunity to gain insight into species' habitat preferences and other ecological relationships. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in SCANFI data download and extraction functions. + +# 6.0 Learning Objectives + +By the end of **Chapter 6 - Downloading and Extracting SCANFI Data**, users will: + +- Have a basic understanding of the SCANFI dataset accessed through `scanfi_download()` and `scanfi_extract()`: [SCANFI data](#6.1scanfi). +- Be able to use `scanfi_download()` to download SCANFI data ready to match to observations in your data: [Downloading SCANFI data with `scanfi_download()`](#6.2download). +- Be able to use `scanfi_extract()` to extract and summarize SCANFI data for each observation in their data: [Extracting SCANFI data with `scanfi_extract()`](#6.3extract). + +This R tutorial requires the following packages: + +``` {r} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 6.1 SCANFI data {#6.1scanfi} + +The [Spatialized CAnadian National Forest Inventory (SCANFI) dataset](https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf) is a wall-to-wall Canadian dataset of gridded forest structure and land cover data at a ~ 30 m resolution, with annual snapshots of a number of variables every 5 years from 1985-2025. The variables available through `naturecounts` include: + +- Forest age (years) +- Forest biomass (tons/ha) +- Crown closure (% of pixel covered by tree canopy) +- Forest height (m) +- National Forest Inventory land cover (NFILC) class +- Balsam Fir cover (% of pixel) +- Black Spruce cover (% of pixel) +- Douglas Fir cover (% of pixel) +- Jack Pine cover (% of pixel) +- Lodgepole Pine cover (% of pixel) +- Ponderosa Pine cover (% of pixel) +- Tamarack cover (% of pixel) +- White and Red Pine cover (% of pixel) +- Broadleaf tree species cover (% of pixel) +- Other conifer species cover (% of pixel) + +These values are modeled from a variety of satellite- and ground-derived data sources and provide useful snapshots of forest structure at different times across the last 4 decades. For more information about the generation of this dataset, see [Guindon et al. (2024)](https://doi.org/10.1139/cjfr-2023-0118) and [Guindon et al. (2026)](https://doi.org/10.23687/07653869-f303-46c2-a04e-9ab479b73cbf). + +# 6.2 Downloading SCANFI data with `scanfi_download()` {#6.2download} + +SCANFI data can be accessed from freely via an [FTP server](https://ftp.maps.canada.ca/pub/nrcan_rncan/Forests_Foret/SCANFI/v2/). While these data are easily accessible, the filenames can be difficult to read, and users must ensure they download all snapshot years needed for each variable desired. This is a step the `naturecounts` package aims to eliminate to promote ease of access to these fantastic data. + +First, lets prep some data from NatureCounts for use in downloading SCANFI data using `data_fmt()`. THe function we will use to download SCANFI data - `scanfi_download()` - needs input data in either `data.frame`, `sf` or `terra` spatial format containing a column for each observation with the year the observation was made, or can be called without input data if the desired snapshot years to be downloaded are provided. If providing input data, you can provide your own data in the required format, or use the built-in `naturecounts::data_fmt()` function to conform your data to the necessary format. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and year)! +# We'll convert it into an sf object for use in scanfi_download(). +bcch %>% + select(latitude, longitude, survey_year) %>% + head() + +# To reduce the necessary downloads, we will restrict our data to years 2000-2007. + +bcch <- bcch[bcch$survey_year %in% c(2000:2007),] + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` +With our data prepared, we can make a call to `scanfi_download()` to begin downloading SCANFI data. If we provide the spatial data we have generated, `scanfi_download()` will attempt to identify the snapshot year(s) that the data fall closest to. Alternatively, we could specify the years we want the function to download by setting `use_date = FALSE` and `snapshot_year = c(2000, 2005)`. + +At this stage, we also need to decide which SCANFI variables we want to download. We can provide the following names to the `covariates` argument to download one or multiple datasets: + +- Forest age (years): `scanfi_age` +- Forest biomass (tons/ha): `scanfi_biomass` +- Crown closure (% of pixel covered by tree canopy): `scanfi_closure` +- Forest height (m): `scanfi_height` +- National Forest Inventory land cover (NFILC) class: `scanfi_nfilc` +- Balsam Fir cover (% of pixel): `scanfi_balsamfir` +- Black Spruce cover (% of pixel): `scanfi_blackspruce` +- Douglas Fir cover (% of pixel): `scanfi_douglasfir` +- Jack Pine cover (% of pixel): `scanfi_jackpine` +- Lodgepole Pine cover (% of pixel): `scanfi_lodgepolepine` +- Ponderosa Pine cover (% of pixel): `scanfi_ponderosapine` +- Tamarack cover (% of pixel): `scanfi_tamarack` +- White and Red Pine cover (% of pixel): `scanfi_whiteredpine` +- Broadleaf tree species cover (% of pixel): `scanfi_broadleaf` +- Other conifer species cover (% of pixel): `scanfi_otherconifer` + +We will download the forest height and NFILC dataset. Users should be aware that SCANFI data files, being at a fine spatial resolution across the entirety of Canada, are large (generally 1-5Gb per snapshot year) and should consider disk space before downloading. + +``` {r} +# Let's download some files! Files will be downloaded into a 'scanfi/' subdirectory in your current working directory. + +scanfi_data <- scanfi_download(data = formatted, + covariates = c("scanfi_height", "scanfi_nfilc"), + use_date = TRUE) # this is TRUE by default, telling + # the function to find the snapshot + # years needed from the data argument, + # but we include it here for clarity. + +# If we didn't have any input data, but still wanted to download the same files +# we could do so as follows: +scanfi_data <- scanfi_download(covariates = c("scanfi_height", "scanfi_nfilc"), + use_date = FALSE, + snapshot_year = c(2000, 2005)) + + +scanfi_data +``` + +Examining the `scanfi_data` object, we can see it is a list containing two sub-lists, each named for the snapshot year the data contained is from. Within each, we can find a `terra::SpatRaster` containing our requested data for that snapshot year. All downloaded files can be found by default in the created `./scanfi` subdirectory or at a custom path specified using the argument `dl_path`. + +# 6.3 Extracting SCANFI data with `scanfi_extract()` {#6.3extract} + +Once we have gathered the appropriate SCANFI data rasters, using `scanfi_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate snapshot year's data files. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `scanfi_extract()` can help make the process quicker and easier. + +`scanfi_extract()` requires input data in either a `sf` or `terra` spatial format. This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the SCANFI variable value of the raster grid cell that each site point falls within for the appropriate snapshot year in a column named following the name of that variable (e.g., `scanfi_height`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean SCANFI variable value of cells overlapped by each polygon for the appropriate snapshot year, again in a column named following the variable's name. This is carried out via a call to `exactextractr::exact_extract()`. In the case of the NFILC dataset, which contains values representing the land cover type within each 30 m pixel, polygon input data to the function will be passed through `landscapemetrics::calculate_lsm()`, returning a column for each land cover class containing the percent of the polygon area covered by that land cover class. + +The input data must also have a column containing the name of the site each observation was made at and the year the observation was made. By default, `scanfi_extract()` searches for this information in the BMDE columns `SurveyAreaIdentifier` and `survey_year` respectively (included by default in data downloaded through `naturecounts`), but alternate site name and year column names can be specified using the `site_name` and `date_year` arguments. By default, `scanfi_extract()` will only extract data for years that match exactly to the snapshot years, but if users want to fill the interceding years with the value from the closest snapshot year, they can do so by setting `interpolate = TRUE`. + +To execute these extractions, we will need to point `scanfi_extract()` to the object containing our SCANFI data using the argument `scanfi_data`. Conveniently, this object is exactly the output of `scanfi_download()` that we stored in our `scanfi_data` object. + +``` {r} +# We will start by fetching the SCANFI height data for our point dataset created above. +output <- scanfi_extract(data = formatted, + covariates = "scanfi_height", + scanfi_data = scanfi_data, + interpolate = FALSE) # this is the default value, but + # we include it explicitly for clarity. + +output[output$survey_year %in% c(2000, 2002, 2005),] +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean forest height within a 500 m radius of each observation. This time, we'll set `interpolate = TRUE` so that the years between 2000 and 2005 and the years after 2005 are filled with the value from the nearest snapshot year. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- scanfi_extract(data = buffered, + covariates = "scanfi_height", + scanfi_data = scanfi_data, + interpolate = TRUE) + +output[output$survey_year %in% c(2000, 2002, 2005),] +``` + +We can see that the mean height values have been added in the `scanfi_height` column and that the years 2001 and 2002 have been filled with the value from year 2000, and the years 2003, 2004, 2006, and 2007 have been filled with the value from 2005. + +To demonstrate the different way that NFILC data are extracted, we'll extract those with our point and polygon data below. + +``` {r} +# Using our point data, we can see that extracting NFILC data returns a column +# called "nfilc_class" containing the land cover class of the pixel the point +# lands within. + +output <- scanfi_extract(data = formatted, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_data, + interpolate = FALSE) + +output[output$survey_year %in% c(2000, 2002, 2005),] + +# And using our buffered polygons data, we can see that extracting NFILC data +# returns a column for each land cover class containing the percent of the +# polygon's area covered by each land cover class. + +output <- scanfi_extract(data = buffered, + covariates = "scanfi_nfilc", + scanfi_data = scanfi_data, + interpolate = FALSE) + +output[output$survey_year %in% c(2000, 2002, 2005),] +``` + +# 6.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year data can be provided directly to `scanfi_download()` and `scanfi_extract()` via the `site_name` and `date_yera` argument respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `scanfi_` function, you do not need to specify this information again. + +By default, the SCANFI files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `scanfi_extract()`. + +Once you've extracted your SCANFI data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to quickly download and extract the appropriate SCANFI data for your observation data using `scanfi_download()` and `scanfi_extract()`. \ No newline at end of file diff --git a/vignettes/articles/4.7-Daymet.Rmd b/vignettes/articles/4.7-Daymet.Rmd new file mode 100644 index 00000000..3050166d --- /dev/null +++ b/vignettes/articles/4.7-Daymet.Rmd @@ -0,0 +1,307 @@ +--- +title: "Chapter 7 - Downloading and Extracting Daymet Data" +author: "Rory Macklin" +date: "2026-07-02" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 7 - Downloading and Extracting Daymet Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +# Chapter 7: Downloading and Extracting Daymet Data + +##### Author: Rory Macklin + +> Daily weather patterns can induce behavioural changes in many species, with potentially significant outcomes for avian detectability and distributional patterns. This data can be recorded at the time of surveys by observers, but these observations can be spatially limited and may contain some degree of subjectivity. Spatially broad and consistently measured daily climatic data can provide a strong alternative to at-survey approaches. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in Daymet data download and extraction functions. + +# 7.0 Learning Objectives + +By the end of **Chapter 7 - Downloading and Extracting Daymet Data**, users will: + +- Have a basic understanding of the Daymet dataset accessed through `daymet_request()`, `daymet_download()` and `daymet_extract()`: [Daymet data](#7.1daymet). +- Be able to use `daymet_request()`, `daymet_check()`, and `daymet_download()` to download Daymet data ready to match to observations in your data: [Downloading Daymet data with `daymet_request()` and `daymet_download()`](#7.2download). +- Be able to use `daymet_extract()` to extract and summarize Daymet data for each observation in their data: [Extracting Daymet data with `daymet_extract()`](#7.3extract). + +This R tutorial requires the following packages: + +``` r +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 7.1 Daymet data {#7.1daymet} + +The [Daymet dataset](https://daymet.ornl.gov/) is a long-running dataset interpolating and extrapolating weather station data to generate daily summaries of surface weather at a \~ 1 km resolution, with daily estimates of a number of variables since 1980 for North America and Hawa'ii and since 1950 for Puerto Rico. The variables available through `naturecounts` include: + +- Day length (s/day) +- Precipitation (mm/day) +- Shortwave radiation (W/m\^2) +- Snow water equivalent (kg/m\^2) +- Maximum air temperature (°C) +- Minimum air temperature (°C) +- Water vapor pressure (Pa) + +These values are modeled from a variety of satellite- and ground-derived data sources and provide estimates of weather patterns at spatially and temporally fine resolutions. For more information about the generation of this dataset, see Thornton et al. ([1997](https://doi.org/10.1016/S0022-1694(96)03128-9), [2021](https://doi.org/10.1038/s41597-021-00973-0%5D)). + +# 7.2 Downloading Daymet data with `daymet_request()` and `daymet_download()` {#7.2download} + +Daymet data can be accessed from freely via [NASA's EarthData Download Tools](https://www.earthdata.nasa.gov/data/projects/daymet/data-access-tools). While these data are easily accessible, daily-scale data must be downloaded in files containing all dates in a year and in files containing all data for North America, Hawa'ii, or Puerto Rico. This can lead to very large file downloads. R packages such as [`appeears`](https://cran.r-project.org/web/packages/appeears/index.html) have instead routed users through the [AppEEARS API](https://appeears.earthdatacloud.nasa.gov/) to make finer scale downloads accessible. The `naturecounts` R package builds upon functionality from the `appeears` package and builds in quality-of-life features to create functions tailored to working with NatureCounts data. + +To download Daymet data, a request must first be placed with the AppEEARS service. To submit a request, users must have a NASA EarthData Account, which can be made [here](https://urs.earthdata.nasa.gov/users/new). We automate the AppEEARS request process in `daymet_request()`, which requires input data from the user in `data.frame`, `sf` or `terra` spatial format containing location and date data for all observations. The function will then use these data to build a request to download raster data for all locations and dates present in the data. + +Due to API limitations, `daymet_request()` will submit one request for each date present in the data. Unfortunately, AppEEARS automatically sends an email upon request receipt and completion for each request, so for users with many observation dates, we recommend considering setting rules in their email client for handling these emails (address [appeears-noreply\@nasa.gov](mailto:appeears-noreply@nasa.gov){.email}). + +First, lets prep some data from NatureCounts for use in build a request for Daymet data using `data_fmt()`. + +``` r +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and year, month, and day)! +# We'll convert it into an sf object for use in scanfi_download(). +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() +#> latitude longitude survey_year survey_month survey_day +#> 1 45.51110 -77.50533 2011 2 12 +#> 4 45.48730 -77.74651 2011 5 5 +#> 16 45.82165 -77.30006 2011 2 18 +#> 18 45.81219 -77.18879 2011 2 20 +#> 28 45.80918 -77.36667 2011 5 23 +#> 30 45.62016 -77.39027 2011 6 28 + +# To reduce the necessary downloads, we will restrict our data to the first six months of 2011. + +bcch <- bcch[bcch$survey_year == 2011 & bcch$survey_month %in% c(1:6),] + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) +#> [Data Formatting] beginning formatting. +#> Warning: [Data Formatting] as the 'crs' argument is not specified, data CRS is assumed to be EPSG:4326. + +head(formatted) +#> Simple feature collection with 6 features and 6 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1459137 ymax: 838377.7 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day geometry +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 POINT (1444206 799722.4) +#> 2 FilledSurveyArea2 45.48730 -77.74651 2011 5 5 POINT (1426543 792053.4) +#> 3 FilledSurveyArea3 45.82165 -77.30006 2011 2 18 POINT (1450445 836967.1) +#> 4 FilledSurveyArea4 45.81219 -77.18879 2011 2 20 POINT (1459137 838377.7) +#> 5 FilledSurveyArea5 45.80918 -77.36667 2011 5 23 POINT (1445787 834213) +#> 6 FilledSurveyArea6 45.62016 -77.39027 2011 6 28 POINT (1449684 813726.2) +``` + +With our data prepared, we can make a call to `daymet_request()` to create a request with AppEEARs for Daymet data. If we provide the spatial data we have generated, `daymet_request()` will identify the necessary locations and dates to create a request for and will return data on the submitted requests upon completion. + +At this stage, we also need to decide which Daymet variables we want to request. We can provide the following names to the `covariates` argument to request one or multiple datasets: + +- Day length (s/day): `daymet_dayl` +- Precipitation (mm/day): `daymet_prcp` +- Shortwave radiation (W/m\^2): `daymet_srad` +- Snow water equivalent (kg/m\^2): `daymet_swe` +- Maximum air temperature (°C): `daymet_tmax` +- Minimum air temperature (°C): `daymet_tmin` +- Water vapor pressure (Pa): `daymet_vp` + +We will request the day length and precipitation datasets. We have already set up a rule in our email client for the email associated with our EarthData account keeping emails from [appeears-noreply\@nasa.gov](mailto:appeears-noreply@nasa.gov){.email} out of our inbox, and are ready to go! We can give our requests a readable name so they are easier for us to associate with our purpose for submitting with the `request_name` argument, and we can choose to save an external copy of the request data output by `daymet_request()` in a `.rds` file in case we need to end our R session while requests are processing using the `save` argument. + +We note that you will need to provide your EarthData *username* to submit requests to AppEEARs rather than the email associated with your EarthData account, as in other functions such as `landcover_download()` and `vegetation_download()`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +In the request process, you may be prompted to input your keychain password to securely store your EarthData login information. If you don't know what this is, try entering your system user password. + +``` r +# Let's request some data! Request data will be returned by the function and +# saved externally into a 'daymet/' subdirectory in your current working directory +# since we set save = TRUE. + +requests <- daymet_request(data = formatted, + covariates = c("daymet_dayl", "daymet_prcp"), + ed_username = "your EarthData username", + request_name = "daymet_vignette", + save = TRUE, # By setting save = TRUE, we will save + # an external copy of our request data + # in a .rds file once submitted. + verbose = FALSE) + + +requests +#> request_name request_id date +#> 1 daymet_vignette_2026-07-02_135830_2011-02-12 60e38b3b-9808-44f6-bb1c-09c5343405c7 2011-02-12 +#> 2 daymet_vignette_2026-07-02_135830_2011-02-18 85980ef1-e001-4c47-93d2-4229b1d731a7 2011-02-18 +#> 3 daymet_vignette_2026-07-02_135830_2011-02-20 c39da500-dca4-4c0e-8ea2-779461c26adf 2011-02-20 +#> 4 daymet_vignette_2026-07-02_135830_2011-04-16 3d0c14bb-8b99-446f-bf94-43a2411c3e1d 2011-04-16 +#> 5 daymet_vignette_2026-07-02_135830_2011-05-05 9c40a3bb-0c4d-4bbd-a158-8b467c551e07 2011-05-05 +#> 6 daymet_vignette_2026-07-02_135830_2011-05-23 912680a4-8a51-4b18-acc8-787a8b227803 2011-05-23 +#> 7 daymet_vignette_2026-07-02_135830_2011-06-28 e97fda63-3094-46c1-915e-ae05ca675397 2011-06-28 +``` + +Examining the `requests` object, we can see it is a `data.frame` containing three columns: 1) `request_name`, containing AppEEARS request names, 2) `request_id`, containing AppEEARS request IDs, and 3) `date`, containing the date for which the associated request is requesting data for. + +These requests have now been submitted to AppEEARs for processing. Depending on the size of the area you've requested data for, and the number of dates you have requested, these can take a long time to process before they are ready for downloading. In the meantime, you can check on the status of your active requests using `daymet_check()`. + +`daymet_check()` uses the request data output by `daymet_request()` and your EarthData login to grab information on the status of your EarthData requests from the AppEEARs API. This is a simple function only requiring two inputs: request data (i.e. a `data.frame` containing columns of request names and request IDs, as output by `daymet_request()`) and your EarthData login. + +If we chose to save our request data externally using `save = TRUE` in `daymet_request()` and have since ended our R session, we can instead provide a file path to the `.rds` file saved by `daymet_request()` containing our request data. This will be true of other cases where request data is required in `daymet_download()` and `daymet_extract()`. + +We'll check the status of our requests below! + +``` r +status <- daymet_check(daymet_reqs = requests, + ed_username = "your EarthData username", + verbose = FALSE) + +status +#> request_name request_id date status +#> 1 daymet_vignette_2026-07-02_135830_2011-02-12 60e38b3b-9808-44f6-bb1c-09c5343405c7 2011-02-12 queued +#> 2 daymet_vignette_2026-07-02_135830_2011-02-18 85980ef1-e001-4c47-93d2-4229b1d731a7 2011-02-18 queued +#> 3 daymet_vignette_2026-07-02_135830_2011-02-20 c39da500-dca4-4c0e-8ea2-779461c26adf 2011-02-20 pending +#> 4 daymet_vignette_2026-07-02_135830_2011-04-16 3d0c14bb-8b99-446f-bf94-43a2411c3e1d 2011-04-16 pending +#> 5 daymet_vignette_2026-07-02_135830_2011-05-05 9c40a3bb-0c4d-4bbd-a158-8b467c551e07 2011-05-05 pending +#> 6 daymet_vignette_2026-07-02_135830_2011-05-23 912680a4-8a51-4b18-acc8-787a8b227803 2011-05-23 pending +#> 7 daymet_vignette_2026-07-02_135830_2011-06-28 e97fda63-3094-46c1-915e-ae05ca675397 2011-06-28 pending +#> expires_on +#> 1 2026-08-01T20:58:40.675823 +#> 2 2026-08-01T20:58:57.875820 +#> 3 2026-08-01T20:58:37.622581 +#> 4 2026-08-01T20:58:46.444879 +#> 5 2026-08-01T20:58:49.616859 +#> 6 2026-08-01T20:58:53.040771 +#> 7 2026-08-01T20:58:56.433831 + +# If we check again after about 15 mins, we can see that our requests are all +# marked as "done" and are ready for downloading! + +status <- daymet_check(daymet_reqs = requests, + ed_username = "your EarthData username", + verbose = FALSE) + +status +#> request_name request_id date status +#> 1 daymet_vignette_2026-07-02_135830_2011-02-12 60e38b3b-9808-44f6-bb1c-09c5343405c7 2011-02-12 done +#> 2 daymet_vignette_2026-07-02_135830_2011-02-18 85980ef1-e001-4c47-93d2-4229b1d731a7 2011-02-18 done +#> 3 daymet_vignette_2026-07-02_135830_2011-02-20 c39da500-dca4-4c0e-8ea2-779461c26adf 2011-02-20 done +#> 4 daymet_vignette_2026-07-02_135830_2011-04-16 3d0c14bb-8b99-446f-bf94-43a2411c3e1d 2011-04-16 done +#> 5 daymet_vignette_2026-07-02_135830_2011-05-05 9c40a3bb-0c4d-4bbd-a158-8b467c551e07 2011-05-05 done +#> 6 daymet_vignette_2026-07-02_135830_2011-05-23 912680a4-8a51-4b18-acc8-787a8b227803 2011-05-23 done +#> 7 daymet_vignette_2026-07-02_135830_2011-06-28 e97fda63-3094-46c1-915e-ae05ca675397 2011-06-28 done +#> expires_on +#> 1 2026-08-01T21:12:07.713647 +#> 2 2026-08-01T21:12:02.208686 +#> 3 2026-08-01T21:13:14.028178 +#> 4 2026-08-01T21:12:56.471097 +#> 5 2026-08-01T21:13:27.051280 +#> 6 2026-08-01T21:13:52.126186 +#> 7 2026-08-01T21:14:30.300291 +``` + +Once our requests are complete (i.e., `status` column in the output of `daymet_check()` are all `done`), we can proceed to downloading our data with `daymet_download()`. + +Again, we'll supply our request data stored in `requests` to this function as well as our EarthData login information. By default, the data will be downloaded into the created `daymet/` subdirectory in your working directory, and will create a further subdirectory for each request following the request names as in `requests$request_name`. Custom download paths can be specified with the `dl_path` argument. + +Executing `daymet_download()` will attempt to download all of the requests supplied in `requests` and will return our request data with an additional column `success`, indicating if the required files have successfully been downloaded. + +``` r +downloaded <- daymet_download(daymet_reqs = requests, + ed_username = "your EarthData username", + verbose = FALSE) + +downloaded +#> request_name request_id date success +#> 1 daymet_vignette_2026-07-02_135830_2011-02-12 60e38b3b-9808-44f6-bb1c-09c5343405c7 2011-02-12 TRUE +#> 2 daymet_vignette_2026-07-02_135830_2011-02-18 85980ef1-e001-4c47-93d2-4229b1d731a7 2011-02-18 TRUE +#> 3 daymet_vignette_2026-07-02_135830_2011-02-20 c39da500-dca4-4c0e-8ea2-779461c26adf 2011-02-20 TRUE +#> 4 daymet_vignette_2026-07-02_135830_2011-04-16 3d0c14bb-8b99-446f-bf94-43a2411c3e1d 2011-04-16 TRUE +#> 5 daymet_vignette_2026-07-02_135830_2011-05-05 9c40a3bb-0c4d-4bbd-a158-8b467c551e07 2011-05-05 TRUE +#> 6 daymet_vignette_2026-07-02_135830_2011-05-23 912680a4-8a51-4b18-acc8-787a8b227803 2011-05-23 TRUE +#> 7 daymet_vignette_2026-07-02_135830_2011-06-28 e97fda63-3094-46c1-915e-ae05ca675397 2011-06-28 TRUE +``` + +We can see that all of the necessary files have been downloaded, and we can proceed to extracting our data! + +# 7.3 Extracting Daymet data with `daymet_extract()` {#7.3extract} + +Once we have gathered the appropriate Daymet data rasters, using `daymet_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate date's data files. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `daymet_extract()` can help make the process quicker and easier. + +`daymet_extract()` requires input data in either a `sf` or `terra` spatial format. This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the Daymet variable value of the raster grid cell that each site point falls within for the appropriate date in a column named following the abbreviated name of that variable (e.g., `dayl` for `covariates = "daymet_dayl"`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean Daymet variable value of cells overlapped by each polygon for the appropriate date, again in a column named following the variable's name. This is carried out via a call to `exactextractr::exact_extract()`. + +The input data must also have a column containing the name of the site each observation was made at and the year, month, and day the observation was made. By default, `daymet_extract()` searches for this information in the BMDE columns `SurveyAreaIdentifier`, `survey_year`, `survey_month` and `survey_day` respectively (included by default in data downloaded through `naturecounts`), but alternate site name, year, month, and day column names can be specified using the `site_name`, `date_year`, `date_month`, and `date_day` arguments. + +To execute these extractions, we will need to point `daymet_extract()` to the object containing our Daymet request data using the argument `daymet_reqs`. Conveniently, this object is exactly the output of `daymet_request()` or `daymet_download()` that we stored in our `requests` and `downloaded` objects. + +``` r +# We will start by fetching the Daymet dayl and prcp data for our point dataset created above. +output <- daymet_extract(data = formatted, + daymet_reqs = downloaded, + covariates = c("daymet_dayl", "daymet_prcp"), + verbose = FALSE) + +output +#> Simple feature collection with 7 features and 8 fields +#> Geometry type: POINT +#> Dimension: XY +#> Bounding box: xmin: 1426543 ymin: 792053.4 xmax: 1481359 ymax: 842474.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day dayl prcp geometry +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 35996.38 0.82 POINT (1444206 799722.4) +#> 2 FilledSurveyArea2 45.48730 -77.74651 2011 5 5 51392.66 0.00 POINT (1426543 792053.4) +#> 3 FilledSurveyArea3 45.82165 -77.30006 2011 2 18 36993.89 2.02 POINT (1450445 836967.1) +#> 4 FilledSurveyArea4 45.81219 -77.18879 2011 2 20 37361.08 0.62 POINT (1459137 838377.7) +#> 5 FilledSurveyArea5 45.80918 -77.36667 2011 5 23 54078.42 12.51 POINT (1445787 834213) +#> 6 FilledSurveyArea6 45.62016 -77.39027 2011 6 28 55732.60 21.31 POINT (1449684 813726.2) +#> 7 FilledSurveyArea7 45.79170 -76.90276 2011 4 16 48102.56 12.15 POINT (1481359 842474.9) +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean day length and precipitation within a 500 m radius of each observation. + +``` r +buffered <- data_buff(data = formatted) + +output <- daymet_extract(data = buffered, + daymet_reqs = downloaded, + covariates = c("daymet_dayl", "daymet_prcp"), + verbose = FALSE) + +output +#> Simple feature collection with 7 features and 8 fields +#> Geometry type: POLYGON +#> Dimension: XY +#> Bounding box: xmin: 1426043 ymin: 791553.4 xmax: 1481859 ymax: 842974.9 +#> Projected CRS: Canada_Albers_Equal_Area_Conic +#> SurveyAreaIdentifier latitude longitude survey_year survey_month survey_day dayl prcp +#> 1 FilledSurveyArea1 45.51110 -77.50533 2011 2 12 35996.38 0.8195103 +#> 2 FilledSurveyArea2 45.48730 -77.74651 2011 5 5 51392.66 0.0000000 +#> 3 FilledSurveyArea3 45.82165 -77.30006 2011 2 18 36993.89 1.9761295 +#> 4 FilledSurveyArea4 45.81219 -77.18879 2011 2 20 37361.08 0.6002662 +#> 5 FilledSurveyArea5 45.80918 -77.36667 2011 5 23 54078.42 12.5189886 +#> 6 FilledSurveyArea6 45.62016 -77.39027 2011 6 28 55732.60 21.6352558 +#> 7 FilledSurveyArea7 45.79170 -76.90276 2011 4 16 48102.56 12.1555138 +#> geometry +#> 1 POLYGON ((1444706 799722.4,... +#> 2 POLYGON ((1427043 792053.4,... +#> 3 POLYGON ((1450945 836967.1,... +#> 4 POLYGON ((1459637 838377.7,... +#> 5 POLYGON ((1446287 834213, 1... +#> 6 POLYGON ((1450184 813726.2,... +#> 7 POLYGON ((1481859 842474.9,... +``` + +We can see that the mean day length and precipitation values have been added in the `dayl` and `prcp` columns respectively + +# 7.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year, month and day data can be provided directly to `daymet_request()` and `daymet_extract()` via the `site_name`, `date_year`, `date_month`. and `date_day` arguments respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `daymet_` function, you do not need to specify this information again. + +By default, the Daymet files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `daymet_extract()`. + +Once you've extracted your Daymet data, you may want to merge it back into the data you originally supplied to the `data` argument of `data_fmt()`. You can do so using `nc_covariates_merge()`. + +**Congratulations!** You have now learned how to request, download, and extract the appropriate Daymet data for your observation data using `daymet_request()`, `daymet_download()` and `daymet_extract()`. diff --git a/vignettes/articles/4.7-Daymet.Rmd.orig b/vignettes/articles/4.7-Daymet.Rmd.orig new file mode 100644 index 00000000..f36385ac --- /dev/null +++ b/vignettes/articles/4.7-Daymet.Rmd.orig @@ -0,0 +1,208 @@ +--- +title: "Chapter 7 - Downloading and Extracting Daymet Data" +author: "Rory Macklin" +date: "2026-07-02" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Chapter 7 - Downloading and Extracting Daymet Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Chapter 7: Downloading and Extracting Daymet Data + +##### Author: Rory Macklin + +> Daily weather patterns can induce behavioural changes in many species, with potentially significant outcomes for avian detectability and distributional patterns. This data can be recorded at the time of surveys by observers, but these observations can be spatially limited and may contain some degree of subjectivity. Spatially broad and consistently measured daily climatic data can provide a strong alternative to at-survey approaches. + +This tutorial assumes you have a basic understanding of working with spatial data in R. For a good introduction to these kinds of operations, the [NatureCounts Spatial Data Tutorial](https://github.com/BirdsCanada/NatureCounts_SpatialData_Tutorial) can serve as a useful starting point. It explains how to download, process, and visualize spatial data, including NatureCounts surveys, conservation areas, and environmental layers. This tutorial also uses functions demonstrated in [**Chapter 1: Formatting Data for Covariate Download and Extraction**](4.1-CovariateFormatting.html). If you are unfamiliar with these functions, we recommend using the previous tutorial to learn to conform your data to a standardized format used in Daymet data download and extraction functions. + +# 7.0 Learning Objectives + +By the end of **Chapter 7 - Downloading and Extracting Daymet Data**, users will: + +- Have a basic understanding of the Daymet dataset accessed through `daymet_request()`, `daymet_download()` and `daymet_extract()`: [Daymet data](#7.1daymet). +- Be able to use `daymet_request()`, `daymet_check()`, and `daymet_download()` to download Daymet data ready to match to observations in your data: [Downloading Daymet data with `daymet_request()` and `daymet_download()`](#7.2download). +- Be able to use `daymet_extract()` to extract and summarize Daymet data for each observation in their data: [Extracting Daymet data with `daymet_extract()`](#7.3extract). + +This R tutorial requires the following packages: + +``` {r} +library(naturecounts) +library(tidyverse) +library(sf) +library(terra) +``` + +# 7.1 Daymet data {#7.1daymet} + +The [Daymet dataset](https://daymet.ornl.gov/) is a long-running dataset interpolating and extrapolating weather station data to generate daily summaries of surface weather at a ~ 1 km resolution, with daily estimates of a number of variables since 1980 for North America and Hawa'ii and since 1950 for Puerto Rico. The variables available through `naturecounts` include: + +- Day length (s/day) +- Precipitation (mm/day) +- Shortwave radiation (W/m^2) +- Snow water equivalent (kg/m^2) +- Maximum air temperature (°C) +- Minimum air temperature (°C) +- Water vapor pressure (Pa) + +These values are modeled from a variety of satellite- and ground-derived data sources and provide estimates of weather patterns at spatially and temporally fine resolutions. For more information about the generation of this dataset, see Thornton et al. ([1997](https://doi.org/10.1016/S0022-1694(96)03128-9), [2021](https://doi.org/10.1038/s41597-021-00973-0])). + +# 7.2 Downloading Daymet data with `daymet_request()` and `daymet_download()` {#7.2download} + +Daymet data can be accessed from freely via [NASA's EarthData Download Tools](https://www.earthdata.nasa.gov/data/projects/daymet/data-access-tools). While these data are easily accessible, daily-scale data must be downloaded in files containing all dates in a year and in files containing all data for North America, Hawa'ii, or Puerto Rico. This can lead to very large file downloads. R packages such as [`appeears`](https://cran.r-project.org/web/packages/appeears/index.html) have instead routed users through the [AppEEARS API](https://appeears.earthdatacloud.nasa.gov/) to make finer scale downloads accessible. The `naturecounts` R package builds upon functionality from the `appeears` package and builds in quality-of-life features to create functions tailored to working with NatureCounts data. + +To download Daymet data, a request must first be placed with the AppEEARS service. To submit a request, users must have a NASA EarthData Account, which can be made [here](https://urs.earthdata.nasa.gov/users/new). We automate the AppEEARS request process in `daymet_request()`, which requires input data from the user in `data.frame`, `sf` or `terra` spatial format containing location and date data for all observations. The function will then use these data to build a request to download raster data for all locations and dates present in the data. + +Due to API limitations, `daymet_request()` will submit one request for each date present in the data. Unfortunately, AppEEARS automatically sends an email upon request receipt and completion for each request, so for users with many observation dates, we recommend considering setting rules in their email client for handling these emails (address ). + +First, lets prep some data from NatureCounts for use in build a request for Daymet data using `data_fmt()`. + +``` {r} +# This dataset containing Black-capped Chickadee observations included in +# the naturecounts R package is in a data.frame format, and contains the columns +# we need (latitude, longitude, and year, month, and day)! +# We'll convert it into an sf object for use in scanfi_download(). +bcch %>% + select(latitude, longitude, survey_year, survey_month, survey_day) %>% + head() + +# To reduce the necessary downloads, we will restrict our data to the first six months of 2011. + +bcch <- bcch[bcch$survey_year == 2011 & bcch$survey_month %in% c(1:6),] + +# We can make a call to data_fmt() to automatically convert this to an sf object +# ready to work with naturecounts' covariate download and extraction functions. We +# can ignore the warning as EPSG:4326 is an appropriate CRS for our data. +formatted <- data_fmt(bcch) + +head(formatted) +``` +With our data prepared, we can make a call to `daymet_request()` to create a request with AppEEARs for Daymet data. If we provide the spatial data we have generated, `daymet_request()` will identify the necessary locations and dates to create a request for and will return data on the submitted requests upon completion. + +At this stage, we also need to decide which Daymet variables we want to request. We can provide the following names to the `covariates` argument to request one or multiple datasets: + +- Day length (s/day): `daymet_dayl` +- Precipitation (mm/day): `daymet_prcp` +- Shortwave radiation (W/m^2): `daymet_srad` +- Snow water equivalent (kg/m^2): `daymet_swe` +- Maximum air temperature (°C): `daymet_tmax` +- Minimum air temperature (°C): `daymet_tmin` +- Water vapor pressure (Pa): `daymet_vp` + +We will request the day length and precipitation datasets. We have already set up a rule in our email client for the email associated with our EarthData account keeping emails from out of our inbox, and are ready to go! We can give our requests a readable name so they are easier for us to associate with our purpose for submitting with the `request_name` argument, and we can choose to save an external copy of the request data output by `daymet_request()` in a `.rds` file in case we need to end our R session while requests are processing using the `save` argument. + +We note that you will need to provide your EarthData *username* to submit requests to AppEEARs rather than the email associated with your EarthData account, as in other functions such as `landcover_download()` and `vegetation_download()`. Your EarthData account password can either be stored in your .Renviron file by adding the line `EarthData_password = "yourpassword"` or can be supplied through the resulting pop-up window if no `Earthdata_password` is found in your .Renviron. This is done securely using the `askpass` package used in `naturecounts` functions. + +In the request process, you may be prompted to input your keychain password to securely store your EarthData login information. If you don't know what this is, try entering your system user password. + +``` {r} +# Let's request some data! Request data will be returned by the function and +# saved externally into a 'daymet/' subdirectory in your current working directory +# since we set save = TRUE. + +requests <- daymet_request(data = formatted, + covariates = c("daymet_dayl", "daymet_prcp"), + ed_username = "rdjmacklin_bc", + request_name = "daymet_vignette", + save = TRUE, # By setting save = TRUE, we will save + # an external copy of our request data + # in a .rds file once submitted. + verbose = FALSE) + + +requests +``` + +Examining the `requests` object, we can see it is a `data.frame` containing three columns: 1) `request_name`, containing AppEEARS request names, 2) `request_id`, containing AppEEARS request IDs, and 3) `date`, containing the date for which the associated request is requesting data for. + +These requests have now been submitted to AppEEARs for processing. Depending on the size of the area you've requested data for, and the number of dates you have requested, these can take a long time to process before they are ready for downloading. In the meantime, you can check on the status of your active requests using `daymet_check()`. + +`daymet_check()` uses the request data output by `daymet_request()` and your EarthData login to grab information on the status of your EarthData requests from the AppEEARs API. This is a simple function only requiring two inputs: request data (i.e. a `data.frame` containing columns of request names and request IDs, as output by `daymet_request()`) and your EarthData login. + +If we chose to save our request data externally using `save = TRUE` in `daymet_request()` and have since ended our R session, we can instead provide a file path to the `.rds` file saved by `daymet_request()` containing our request data. This will be true of other cases where request data is required in `daymet_download()` and `daymet_extract()`. + +We'll check the status of our requests below! + +``` {r} +status <- daymet_check(daymet_reqs = requests, + ed_username = "rdjmacklin_bc", + verbose = FALSE) + +status + +Sys.sleep(900) + +# If we check again after about 15 mins, we can see that our requests are all +# marked as "done" and are ready for downloading! + +status <- daymet_check(daymet_reqs = requests, + ed_username = "rdjmacklin_bc", + verbose = FALSE) + +status +``` +Once our requests are complete (i.e., `status` column in the output of `daymet_check()` are all `done`), we can proceed to downloading our data with `daymet_download()`. + +Again, we'll supply our request data stored in `requests` to this function as well as our EarthData login information. By default, the data will be downloaded into the created `daymet/` subdirectory in your working directory, and will create a further subdirectory for each request following the request names as in `requests$request_name`. Custom download paths can be specified with the `dl_path` argument. + +Executing `daymet_download()` will attempt to download all of the requests supplied in `requests` and will return our request data with an additional column `success`, indicating if the required files have successfully been downloaded. + +``` {r} +downloaded <- daymet_download(daymet_reqs = requests, + ed_username = "rdjmacklin_bc", + verbose = FALSE) + +downloaded +``` +We can see that all of the necessary files have been downloaded, and we can proceed to extracting our data! + +# 7.3 Extracting Daymet data with `daymet_extract()` {#7.3extract} + +Once we have gathered the appropriate Daymet data rasters, using `daymet_download()` or otherwise, we will want to extract the appropriate values and match them to our observations. Traditionally this might be accomplished with complicated for-loops running through each observation and matching it to the appropriate date's data files. This could take significant time for the researcher and could be prone to errors for those not experienced with spatial operations in R. In these cases, `daymet_extract()` can help make the process quicker and easier. + +`daymet_extract()` requires input data in either a `sf` or `terra` spatial format. This function works slightly differently depending on whether the input site data are in point or polygon format (again, either `sf` or `terra` objects are accepted). For point data, the extraction process will return the Daymet variable value of the raster grid cell that each site point falls within for the appropriate date in a column named following the abbreviated name of that variable (e.g., `dayl` for `covariates = "daymet_dayl"`). This is carried out via a call to `terra::extract()`. For polygon data, the extraction process will return the mean Daymet variable value of cells overlapped by each polygon for the appropriate date, again in a column named following the variable's name. This is carried out via a call to `exactextractr::exact_extract()`. + +The input data must also have a column containing the name of the site each observation was made at and the year, month, and day the observation was made. By default, `daymet_extract()` searches for this information in the BMDE columns `SurveyAreaIdentifier`, `survey_year`, `survey_month` and `survey_day` respectively (included by default in data downloaded through `naturecounts`), but alternate site name, year, month, and day column names can be specified using the `site_name`, `date_year`, `date_month`, and `date_day` arguments. + +To execute these extractions, we will need to point `daymet_extract()` to the object containing our Daymet request data using the argument `daymet_reqs`. Conveniently, this object is exactly the output of `daymet_request()` or `daymet_download()` that we stored in our `requests` and `downloaded` objects. + +``` {r} +# We will start by fetching the Daymet dayl and prcp data for our point dataset created above. +output <- daymet_extract(data = formatted, + daymet_reqs = downloaded, + covariates = c("daymet_dayl", "daymet_prcp"), + verbose = FALSE) + +output +``` + +Now let's give it a go with polygon input data. We'll buffer our points to fetch the mean day length and precipitation within a 500 m radius of each observation. + +``` {r} +buffered <- data_buff(data = formatted) + +output <- daymet_extract(data = buffered, + daymet_reqs = downloaded, + covariates = c("daymet_dayl", "daymet_prcp"), + verbose = FALSE) + +output +``` + +We can see that the mean day length and precipitation values have been added in the `dayl` and `prcp` columns respectively + +# 7.4 Tips and tricks + +For users using data in non-BMDE formats (the default column-set downloaded via NatureCounts), alternate column names for your site names and year, month and day data can be provided directly to `daymet_request()` and `daymet_extract()` via the `site_name`, `date_year`, `date_month`. and `date_day` arguments respectively. If you have already provided this information in a call to `data_fmt()` and are providing the output of that function as the `data` argument of either `daymet_` function, you do not need to specify this information again. + +By default, the Daymet files downloaded will be retained until the user manually deletes them. However, if the user wishes to save disk space and reduce clutter, the files can be automatically deleted by setting `retain = FALSE` in `daymet_extract()`. + +**Congratulations!** You have now learned how to request, download, and extract the appropriate Daymet data for your observation data using `daymet_request()`, `daymet_download()` and `daymet_extract()`. \ No newline at end of file