Skip to content

Commit

Permalink
deprecate FUN argument in st_join
Browse files Browse the repository at this point in the history
  • Loading branch information
@edzer
edzer committed Jun 12, 2017
1 parent 4ed85a4 commit 1db9b59
Show file tree
Hide file tree
Showing 4 changed files with 28 additions and 52 deletions.
47 changes: 22 additions & 25 deletions R/join.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, ...) {
Expand All @@ -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;
Expand All @@ -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]))
}
8 changes: 5 additions & 3 deletions man/st_join.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 0 additions & 2 deletions tests/sfc.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
23 changes: 1 addition & 22 deletions tests/sfc.Rout.save
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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

0 comments on commit 1db9b59

Please sign in to comment.