Skip to content

Instantly share code, notes, and snippets.

@rCarto
Last active September 9, 2024 12:49
Show Gist options
  • Save rCarto/bb47aff0a02e808d2bf64f2d8c5db7d8 to your computer and use it in GitHub Desktop.
Save rCarto/bb47aff0a02e808d2bf64f2d8c5db7d8 to your computer and use it in GitHub Desktop.
st_aggregate <- function(x, by, var, fun){
var = c(by, var)
fun = c("head", fun)
n <- length(var)
l <- vector("list", n)
for (i in 1:n){
l[[i]] <- tapply(x[[var[i]]], x[[by]], add_args(fun[[i]]), n = 1, na.rm = TRUE)
}
names(l) <- var
r <- sf::st_sf(do.call(data.frame, l),
geometry = tapply(x[attr(x, "sf_column")], x[[by]], sf::st_union),
crs = sf::st_crs(x))
r
}
add_args <- function(x){
rx <- get(x)
fx <- formals(rx)
fx$na.rm = TRUE
fx$n = 1
formals(rx) <- fx
rx
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment