From 1db9b59ea3a6f6d31c4e704bf26e7f171b74f4d3 Mon Sep 17 00:00:00 2001 From: Edzer Pebesma Date: Mon, 12 Jun 2017 09:37:05 +0200 Subject: [PATCH] deprecate FUN argument in st_join --- R/join.R | 47 +++++++++++++++++++++------------------------ man/st_join.Rd | 8 +++++--- tests/sfc.R | 2 -- tests/sfc.Rout.save | 23 +--------------------- 4 files changed, 28 insertions(+), 52 deletions(-) diff --git a/R/join.R b/R/join.R index 6fcff08fb..b74ffa988 100644 --- a/R/join.R +++ b/R/join.R @@ -26,28 +26,28 @@ left_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), . check_join(x, y) sf_join(NextMethod(), attr(x, "sf_column")) } - + #' @name dplyr #' @export right_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) sf_join(NextMethod(), attr(x, "sf_column")) } - + #' @name dplyr #' @export full_join.sf = function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { check_join(x, y) sf_join(NextMethod(), attr(x, "sf_column")) } - + #' @name dplyr #' @export semi_join.sf = function(x, y, by = NULL, copy = FALSE, ...) { check_join(x, y) sf_join(NextMethod(), attr(x, "sf_column")) } - + #' @name dplyr #' @export anti_join.sf = function(x, y, by = NULL, copy = FALSE, ...) { @@ -62,7 +62,7 @@ anti_join.sf = function(x, y, by = NULL, copy = FALSE, ...) { #' @param x object of class \code{sf} #' @param y object of class \code{sf} #' @param join geometry predicate function with the same profile as \link{st_intersects}; see details -#' @param FUN aggregation function, see \link[stats]{aggregate}; in case of multiple matches, if \code{FUN} is defined, attributes of \code{y} will be aggregated using \code{FUN}; else, all combinations of \code{x} and \code{y} are returned. +#' @param FUN deprecated; #' @param suffix length 2 character vector; see \link[base]{merge} #' @param prepared logical; see \link{st_intersects} #' @param left logical; if \code{TRUE} carry out left join, else inner join; @@ -80,35 +80,32 @@ anti_join.sf = function(x, y, by = NULL, copy = FALSE, ...) { #' geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) #' st_join(a, b) #' st_join(a, b, left = FALSE) -#' st_join(a, b, FUN = mean) -#' st_join(a, b, FUN = mean, left = FALSE) +#' # two ways to aggregate y's attribute values outcome over x's geometries: +#' st_join(a, b) %>% aggregate(list(.$a.x), mean) +#' library(dplyr) +#' st_join(a, b) %>% group_by(a.x) %>% summarise(mean(a.y)) #' @export st_join = function(x, y, join = st_intersects, FUN, suffix = c(".x", ".y"), - prepared = TRUE, left = TRUE, ...) { - stopifnot(inherits(x, "sf") && inherits(y, "sf")) - i = join(x, y, prepared = prepared, ...) - st_geometry(y) = NULL + prepared = TRUE, left = TRUE, ...) { + stopifnot(inherits(x, "sf") && inherits(y, "sf")) + if (!missing(FUN)) { + .Deprecated("aggregate") + stop("for aggregation/summarising after st_join, see examples in ?st_join") + } + i = join(x, y, prepared = prepared, ...) + st_geometry(y) = NULL which.x = which(names(x) %in% names(y)) which.y = which(names(y) %in% names(x)) if (length(which.x)) names(x)[which.x] = paste0(names(x)[which.x], suffix[1]) if (length(which.y)) names(y)[which.y] = paste0(names(y)[which.y], suffix[2]) - ix = rep(seq_len(nrow(x)), lengths(i)) + ix = rep(seq_len(nrow(x)), lengths(i)) xNAs = seq_len(nrow(x)) xNAs[sapply(i, function(x) length(x)==0)] = NA_integer_ - if (missing(FUN)) { - if (left) { - i = lapply(i, function(x) { if (length(x) == 0) NA_integer_ else x }) - ix = rep(seq_len(nrow(x)), lengths(i)) - } - st_sf(cbind(as.data.frame(x)[ix,], y[unlist(i),,drop=FALSE])) - } else { # aggregate y: - y = aggregate(y[unlist(i), , drop=FALSE], list(ix), FUN) - if (left) { - xNAs[!is.na(xNAs)] = seq_len(nrow(y)) - st_sf(cbind(as.data.frame(x), y[xNAs, , drop = FALSE])) - } else # inner: - st_sf(cbind(as.data.frame(x)[!is.na(xNAs), , drop=FALSE], y)) + if (left) { # fill NA y values when no match: + i = lapply(i, function(x) { if (length(x) == 0) NA_integer_ else x }) + ix = rep(seq_len(nrow(x)), lengths(i)) } + st_sf(cbind(as.data.frame(x)[ix,], y[unlist(i),,drop=FALSE])) } diff --git a/man/st_join.Rd b/man/st_join.Rd index f39e513d6..26b83d76f 100644 --- a/man/st_join.Rd +++ b/man/st_join.Rd @@ -14,7 +14,7 @@ st_join(x, y, join = st_intersects, FUN, suffix = c(".x", ".y"), \item{join}{geometry predicate function with the same profile as \link{st_intersects}; see details} -\item{FUN}{aggregation function, see \link[stats]{aggregate}; in case of multiple matches, if \code{FUN} is defined, attributes of \code{y} will be aggregated using \code{FUN}; else, all combinations of \code{x} and \code{y} are returned.} +\item{FUN}{deprecated;} \item{suffix}{length 2 character vector; see \link[base]{merge}} @@ -44,6 +44,8 @@ b = st_sf(a = 11:14, geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) st_join(a, b) st_join(a, b, left = FALSE) -st_join(a, b, FUN = mean) -st_join(a, b, FUN = mean, left = FALSE) +# two ways to aggregate y's attribute values outcome over x's geometries: +st_join(a, b) \%>\% aggregate(list(.$a.x), mean) +library(dplyr) +st_join(a, b) \%>\% group_by(a.x) \%>\% summarise(mean(a.y)) } diff --git a/tests/sfc.R b/tests/sfc.R index 11c189e9c..2be6f2f7c 100644 --- a/tests/sfc.R +++ b/tests/sfc.R @@ -138,8 +138,6 @@ b = st_sf(a = 11:14, geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) st_join(a, b) st_join(a, b, left = FALSE) -st_join(a, b, FUN = mean) -st_join(a, b, FUN = mean, left = FALSE) # rbind: x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) diff --git a/tests/sfc.Rout.save b/tests/sfc.Rout.save index 0153773e4..74938a6bb 100644 --- a/tests/sfc.Rout.save +++ b/tests/sfc.Rout.save @@ -611,27 +611,6 @@ proj4string: NA 2 2 12 POINT(2 2) 2.1 2 13 POINT(2 2) 3 3 14 POINT(3 3) -> st_join(a, b, FUN = mean) -Simple feature collection with 3 features and 3 fields -geometry type: POINT -dimension: XY -bbox: xmin: 1 ymin: 1 xmax: 3 ymax: 3 -epsg (SRID): NA -proj4string: NA - a.x Group.1 a.y geom -1 1 NA NA POINT(1 1) -2 2 2 12.5 POINT(2 2) -3 3 3 14.0 POINT(3 3) -> st_join(a, b, FUN = mean, left = FALSE) -Simple feature collection with 2 features and 3 fields -geometry type: POINT -dimension: XY -bbox: xmin: 2 ymin: 2 xmax: 3 ymax: 3 -epsg (SRID): NA -proj4string: NA - a.x Group.1 a.y geom -2 2 2 12.5 POINT(2 2) -3 3 3 14.0 POINT(3 3) > > # rbind: > x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) @@ -739,4 +718,4 @@ POINT(-81.6410816551367 36.3952045484235) > > proc.time() user system elapsed - 1.516 0.296 1.503 + 1.456 0.344 1.488