Skip to content

Commit

Permalink
Figured out extract_with_buffer_kernel errors
Browse files Browse the repository at this point in the history
- func argument should be explicitly declared (which accepts weights)
- Local test passing confirmed
  • Loading branch information
Insang Song committed Dec 18, 2023
1 parent 46c1639 commit 0e3727a
Show file tree
Hide file tree
Showing 7 changed files with 500 additions and 195 deletions.
5 changes: 4 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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
12 changes: 7 additions & 5 deletions R/processing.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 <-
Expand All @@ -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
Expand Down
57 changes: 29 additions & 28 deletions R/scale_process.R
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,7 @@ distribute_process_grid <-
error = function(e) {
if (debug) print(e)

Check warning on line 115 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L115

Added line #L115 was not covered by tests
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
}
Expand Down Expand Up @@ -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"
Expand All @@ -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

Check warning on line 240 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L239-L240

Added lines #L239 - L240 were not covered by tests
}
Expand All @@ -248,7 +249,7 @@ distribute_process_hierarchy <-
results_distributed <- do.call(dplyr::bind_rows, results_distributed)

return(results_distributed)
}
}



Expand Down Expand Up @@ -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 <-
Expand All @@ -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]])

Check warning on line 321 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L316-L321

Added lines #L316 - L321 were not covered by tests

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"))

Check warning on line 323 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L323

Added line #L323 was not covered by tests

return(res)
},
args_input[[rast_target]] <- rast_short(path, win = vect_ext)
if (!"id" %in% names(formals(fun_dist))) {
args_input$id <- NULL

Check warning on line 327 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L325-L327

Added lines #L325 - L327 were not covered by tests
}

res <-
rlang::inject(fun_dist(!!!args_input))
if (!is.data.frame(res)) {
res <- as.data.frame(res)

Check warning on line 333 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L330-L333

Added lines #L330 - L333 were not covered by tests
}

return(res)
},
error = function(e) {
if (debug) print(e)

Check warning on line 339 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L339

Added line #L339 was not covered by tests
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

Check warning on line 343 in R/scale_process.R

View check run for this annotation

Codecov / codecov/patch

R/scale_process.R#L341-L343

Added lines #L341 - L343 were not covered by tests
}
Expand Down
335 changes: 216 additions & 119 deletions scomps_rmarkdown_litr.html

Large diffs are not rendered by default.

Loading

0 comments on commit 0e3727a

Please sign in to comment.