diff --git a/DESCRIPTION b/DESCRIPTION index 609b2832..9ce6b2a6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,10 +24,13 @@ Suggests: doFuture, future.batchtools, igraph, + knitr, + rmarkdown, testthat (>= 3.0.0), tigris, units, withr +VignetteBuilder: knitr Config/testthat/edition: 3 LitrVersionUsed: 0.9.0 -LitrId: 531c76e2fb2b370df0bd7aa059cc2cdb +LitrId: 81666995d76fe29d4d2a16477742c9eb diff --git a/R/processing.R b/R/processing.R index 73209326..9cedc135 100644 --- a/R/processing.R +++ b/R/processing.R @@ -210,15 +210,16 @@ extract_with_buffer_kernel <- function( bufs <- reproject_b2r(bufs, surf) # crop raster - clip_as_extent() bufs_extent <- terra::ext(bufs) surf_cropped <- terra::crop(surf, bufs_extent) - name_surf_val <- names(surf) + name_surf_val <- + ifelse(terra::nlyr(surf_cropped) == 1, + "value", names(surf_cropped)) coords_df <- as.data.frame(points, geom = "XY") coords_df <- coords_df[, grep(sprintf("^(%s|%s|%s)", id, "x", "y"), names(coords_df))] - names(coords_df)[grep("(x|y)")] <- c("xorig", "yorig") + names(coords_df)[grep("(x|y)", names(coords_df))] <- c("xorig", "yorig") # extract raster values surf_at_bufs <- @@ -239,13 +240,14 @@ extract_with_buffer_kernel <- function( pairdist = terra::distance( x = cbind(xorig, yorig), y = cbind(x, y), - pairwise = TRUE + pairwise = TRUE, + lonlat = terra::is.lonlat(points) ), w_kernel = kernelfunction(pairdist, bandwidth, kernel), w_kernelarea = w_kernel * coverage_fraction) |> dplyr::group_by(!!rlang::sym(id)) |> dplyr::summarize( - dplyr::across(dplyr::all_of(name_surf_val), ~func(., w = w_kernelarea), na.rm = TRUE) + dplyr::across(dplyr::all_of(name_surf_val), ~func(., w = w_kernelarea)) ) |> dplyr::ungroup() colnames(surf_at_bufs_summary)[1] <- id diff --git a/R/scale_process.R b/R/scale_process.R index da63dbcb..e2b4ca58 100644 --- a/R/scale_process.R +++ b/R/scale_process.R @@ -114,7 +114,7 @@ distribute_process_grid <- error = function(e) { if (debug) print(e) fallback <- data.frame(ID = NA) - if (!"id" %in% names(formals(fun_dist))) { + if ("id" %in% names(formals(fun_dist))) { detected_id <- list(...) detected_id <- detected_id$id } @@ -214,7 +214,8 @@ distribute_process_hierarchy <- { # TODO: padded subregion to deal with # edge cases; how to determine padding? - subregion <- regions[startsWith(split_level, subregion)] + subregion <- + regions[startsWith(split_level, subregion)] args_input <- list(...) ## Strongly assuming that # the first is "at", the second is "from" @@ -234,7 +235,7 @@ distribute_process_hierarchy <- error = function(e) { if (debug) print(e) - if (!"id" %in% names(formals(fun_dist))) { + if ("id" %in% names(formals(fun_dist))) { detected_id <- list(...) detected_id <- detected_id$id } @@ -248,7 +249,7 @@ distribute_process_hierarchy <- results_distributed <- do.call(dplyr::bind_rows, results_distributed) return(results_distributed) -} + } @@ -299,9 +300,9 @@ distribute_process_multirasters <- function( # detected_id <- "ID" # } - if (any(sapply(filenames, \(x) !file.exists(x)))) { - stop("One or many of files do not exist in provided file paths. Check the paths again.\n") - } + # if (any(sapply(filenames, \(x) !file.exists(x)))) { + # stop("One or many of files do not exist in provided file paths. Check the paths again.\n") + # } file_list <- split(filenames, filenames) results_distributed <- @@ -312,32 +313,32 @@ distribute_process_multirasters <- function( run_result <- tryCatch({ - args_input <- list(...) - vect_target_tr <- detect_class(args_input, "SpatVector") - vect_target_sf <- detect_class(args_input, "sf") - vect_target <- (vect_target_tr | vect_target_sf) - vect_ext <- args_input[vect_target] - vect_ext <- terra::ext(vect_ext[[1]]) - - rast_target <- which(detect_class(args_input, "SpatRaster")) + args_input <- list(...) + vect_target_tr <- detect_class(args_input, "SpatVector") + vect_target_sf <- detect_class(args_input, "sf") + vect_target <- (vect_target_tr | vect_target_sf) + vect_ext <- args_input[vect_target] + vect_ext <- terra::ext(vect_ext[[1]]) - args_input[[rast_target]] <- rast_short(path, win = vect_ext) - if (!"id" %in% names(formals(fun_dist))) { - args_input$id <- NULL - } - - res <- - rlang::inject(fun_dist(!!!args_input)) - if (!is.data.frame(res)) { - res <- as.data.frame(res) - } + rast_target <- which(detect_class(args_input, "SpatRaster")) - return(res) - }, + args_input[[rast_target]] <- rast_short(path, win = vect_ext) + if (!"id" %in% names(formals(fun_dist))) { + args_input$id <- NULL + } + + res <- + rlang::inject(fun_dist(!!!args_input)) + if (!is.data.frame(res)) { + res <- as.data.frame(res) + } + + return(res) + }, error = function(e) { if (debug) print(e) fallback <- data.frame(ID = NA) - if (!"id" %in% names(formals(fun_dist))) { + if ("id" %in% names(formals(fun_dist))) { detected_id <- list(...) detected_id <- detected_id$id } diff --git a/scomps_rmarkdown_litr.html b/scomps_rmarkdown_litr.html index 79000e6a..e19a361a 100644 --- a/scomps_rmarkdown_litr.html +++ b/scomps_rmarkdown_litr.html @@ -29,10 +29,10 @@ }); - +h1.title {font-size: 38px;} +h2 {font-size: 30px;} +h3 {font-size: 24px;} +h4 {font-size: 18px;} +h5 {font-size: 16px;} +h6 {font-size: 12px;} +code {color: inherit; background-color: rgba(0, 0, 0, 0.04);} +pre:not([class]) { background-color: white } +code{white-space: pre-wrap;} +span.smallcaps{font-variant: small-caps;} +span.underline{text-decoration: underline;} +div.column{display: inline-block; vertical-align: top; width: 50%;} +div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;} +ul.task-list{list-style: none;} +