Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
while keeping r-spatial/sf#2375
  • Loading branch information
edzer committed Apr 17, 2024
1 parent cee624a commit f0156c9
Showing 1 changed file with 7 additions and 3 deletions.
10 changes: 7 additions & 3 deletions R/aggregate.R
Original file line number Diff line number Diff line change
Expand Up @@ -171,8 +171,8 @@ aggregate.stars = function(x, by, FUN, ..., drop = FALSE, join = st_intersects,
d = st_dimensions(x)
dims = dim(d)

agr_grps = function(x, grps, uq, FUN, ...) {
do.call(cbind, lapply(uq, function(i) {
agr_grps = function(x, grps, uq, FUN, bind, ...) {
do.call(bind, lapply(uq, function(i) {
sel <- which(grps == i)
if (!isTRUE(any(sel)))
NA_real_
Expand All @@ -182,6 +182,10 @@ aggregate.stars = function(x, by, FUN, ..., drop = FALSE, join = st_intersects,
))
}

bind = if (length(FUN(1:10, ...)) > 1)
cbind
else
rbind
# rearrange:
x = structure(x, dimensions = NULL, class = NULL) # unclass
newdims = c(prod(dims[1:ndims]), prod(dims[-(1:ndims)]))
Expand All @@ -196,7 +200,7 @@ aggregate.stars = function(x, by, FUN, ..., drop = FALSE, join = st_intersects,
NULL
} else
NULL
x[[i]] = agr_grps(a, grps, seq_along(by), FUN, ...)
x[[i]] = agr_grps(a, grps, seq_along(by), FUN, bind, ...)
if (is.numeric(x[[i]]) && !is.null(u))
x[[i]] = units::set_units(x[[i]], u, mode = "standard")
}
Expand Down

0 comments on commit f0156c9

Please sign in to comment.