|
| 1 | +#' Generate site-year covariates from yearly GeoTIFF stacks (internal) |
| 2 | +#' |
| 3 | +#' Scans `cov_dir` for files like `<file_prefix><YYYY>.tiff`, extracts raster |
| 4 | +#' values at the provided site coordinates, and returns a long tibble. |
| 5 | +#' |
| 6 | +#' @param site_coords data.frame with columns: site (chr or coercible), lon (num), lat (num). |
| 7 | +#' @param cov_dir directory containing yearly multi-layer GeoTIFFs. |
| 8 | +#' @param crs CRS string for the input points (default "EPSG:4326"). |
| 9 | +#' @param file_prefix character prefix before the 4-digit year (default "covariates_"). |
| 10 | +#' Ignored if `file_regex` is provided. |
| 11 | +#' @param file_regex optional full regex to match files (must contain a 4-digit year). |
| 12 | +#' |
| 13 | +#' @return tibble with columns site, year, and per-layer covariates. |
| 14 | +#' @keywords internal |
| 15 | +#' @noRd |
| 16 | +generate_covariates_df <- function(site_coords, |
| 17 | + cov_dir, |
| 18 | + crs = "EPSG:4326", |
| 19 | + file_prefix = "covariates_", |
| 20 | + file_regex = NULL) { |
| 21 | + if (!dir.exists(cov_dir)) stop("`cov_dir` does not exist: ", cov_dir) |
| 22 | + |
| 23 | + # validate site_coords |
| 24 | + if (!all(c("lon", "lat") %in% names(site_coords))) { |
| 25 | + stop("`site_coords` must have columns: lon, lat (and ideally site).") |
| 26 | + } |
| 27 | + if (!("site" %in% names(site_coords))) site_coords$site <- seq_len(nrow(site_coords)) |
| 28 | + site_coords$site <- as.character(site_coords$site) |
| 29 | + |
| 30 | + site_coords$lon <- suppressWarnings(as.numeric(site_coords$lon)) |
| 31 | + site_coords$lat <- suppressWarnings(as.numeric(site_coords$lat)) |
| 32 | + if (anyNA(site_coords$lon) || anyNA(site_coords$lat)) { |
| 33 | + bad <- site_coords$site[is.na(site_coords$lon) | is.na(site_coords$lat)] |
| 34 | + stop("Found non-numeric lon/lat for sites: ", paste(bad, collapse = ", ")) |
| 35 | + } |
| 36 | + |
| 37 | + # build points |
| 38 | + coords_mat <- as.matrix(site_coords[, c("lon", "lat")]) |
| 39 | + pts <- terra::vect(coords_mat, type = "points", crs = crs) |
| 40 | + pts$site <- site_coords$site |
| 41 | + |
| 42 | + # discover files/years |
| 43 | + pattern <- if (is.null(file_regex)) { |
| 44 | + # escape any regex chars in prefix, then expect YYYY.tiff |
| 45 | + paste0("^", |
| 46 | + stringr::str_replace_all(file_prefix, "([\\^$.|?*+()\\[\\]{}])", "\\\\\\1"), |
| 47 | + "\\d{4}\\.tiff$") |
| 48 | + } else { |
| 49 | + file_regex |
| 50 | + } |
| 51 | + tif_files <- list.files(cov_dir, pattern = pattern, full.names = TRUE) |
| 52 | + if (length(tif_files) == 0) { |
| 53 | + stop("No files matched pattern in: ", cov_dir, " (pattern: ", pattern, ")") |
| 54 | + } |
| 55 | + |
| 56 | + years <- as.integer(stringr::str_extract(basename(tif_files), "\\d{4}")) |
| 57 | + if (any(is.na(years))) { |
| 58 | + stop("Could not parse years from filenames: ", |
| 59 | + paste(basename(tif_files)[is.na(years)], collapse = ", ")) |
| 60 | + } |
| 61 | + ord <- order(years) |
| 62 | + tif_files <- tif_files[ord] |
| 63 | + years <- years[ord] |
| 64 | + |
| 65 | + # per-year extractor |
| 66 | + extract_year <- function(tif_path, year) { |
| 67 | + r <- terra::rast(tif_path) |
| 68 | + vals <- terra::extract(r, pts) |
| 69 | + |
| 70 | + if ("ID" %in% names(vals)) { |
| 71 | + vals <- vals[, setdiff(names(vals), "ID"), drop = FALSE] |
| 72 | + } |
| 73 | + |
| 74 | + out <- dplyr::as_tibble(vals) |
| 75 | + if (nrow(out) != nrow(site_coords)) { |
| 76 | + stop("Row mismatch for year ", year, ": expected ", nrow(site_coords), |
| 77 | + " but got ", nrow(out), ". Check CRS/coordinates or raster extent.") |
| 78 | + } |
| 79 | + |
| 80 | + dplyr::mutate(out, site = site_coords$site, year = as.integer(year)) |> |
| 81 | + dplyr::select("site", "year", dplyr::everything()) |
| 82 | + } |
| 83 | + |
| 84 | + purrr::map2_dfr(tif_files, years, extract_year) |
| 85 | +} |
0 commit comments