diff --git a/R/sf.R b/R/sf.R index 1675bd62b..cff93b130 100644 --- a/R/sf.R +++ b/R/sf.R @@ -44,14 +44,19 @@ st_as_sf.data.frame = function(x, ..., agr = NA_agr_, coords, wkt, else x$geometry = st_as_sfc(as.character(x[[wkt]])) } else if (! missing(coords)) { - cc = as.data.frame(lapply(x[coords], as.numeric)) + cc = if (length(coords) == 1) { + stopifnot(is.matrix(x[[coords]]), is.numeric(x[[coords]])) + x[[coords]] + } else { + if (length(coords) == 2) + dim = "XY" + stopifnot(length(coords) == nchar(dim), dim %in% c("XY", "XYZ", "XYZM", "XYM")) + as.data.frame(lapply(x[coords], as.numeric)) + } if (na.fail && anyNA(cc)) stop("missing values in coordinates not allowed") # classdim = getClassDim(rep(0, length(coords)), length(coords), dim, "POINT") # x$geometry = structure( points_rcpp(attr(x, "points"), dim), - if (length(coords) == 2) - dim = "XY" - stopifnot(length(coords) == nchar(dim), dim %in% c("XY", "XYZ", "XYZM", "XYM")) points = as.matrix(cc) dimnames(points) = NULL x$geometry = structure(vector("list", length = nrow(cc)), diff --git a/R/sfc.R b/R/sfc.R index 2973e7092..307d2be41 100644 --- a/R/sfc.R +++ b/R/sfc.R @@ -162,12 +162,24 @@ st_sfc = function(..., crs = NA_crs_, precision = 0.0, check_ring_dir = FALSE, d #' @export -#"[<-.sfc" = function (x, i, j, value) { "[<-.sfc" = function (x, i, value) { - if (is.null(value) || inherits(value, "sfg")) + if (is.null(value) || inherits(value, "sfg")) { + is_points = inherits(value, "POINT") value = list(value) + } else + is_points = inherits(value, "sfc_POINT") + if (inherits(x, "sfc_POINT") && !is.null(attr(x, "points"))) { + if (is_points) { + repl = if (!is.null(pts <- attr(value, "points"))) + pts + else + do.call(rbind, value) + attr(x, "points")[i, ] = repl + return(structure(x, n_empty = sum(is.na(attr(x, "points")[,1])))) # RETURNS + } else + x = x[] # realize + } x = unclass(x) # becomes a list, but keeps attributes - ret = st_sfc(NextMethod(), recompute_bbox = TRUE) structure(ret, n_empty = sum(sfc_is_empty(ret))) } diff --git a/R/tidyverse.R b/R/tidyverse.R index 56d3093cf..270800650 100644 --- a/R/tidyverse.R +++ b/R/tidyverse.R @@ -52,8 +52,13 @@ group_split.sf <- function(.tbl, ..., .keep = TRUE) { #' } filter.sf <- function(.data, ..., .dots) { agr = st_agr(.data) + g = st_geometry(.data) class(.data) <- setdiff(class(.data), "sf") - .re_sf(NextMethod(), sf_column_name = attr(.data, "sf_column"), agr) + if (inherits(g, "sfc_POINT") && !is.null(pts <- attr(g, "points"))) { + .data[[ attr(.data, "sf_column") ]] = pts + st_as_sf(NextMethod(), coords = attr(.data, "sf_column"), agr = agr, remove = FALSE) # FIXME: doesn't handle tibble? + } else + .re_sf(NextMethod(), sf_column_name = attr(.data, "sf_column"), agr) } #' @name tidyverse