From 5126cd6363ab56e28c37ce1717ac2006f4a45ea3 Mon Sep 17 00:00:00 2001 From: Bart Date: Fri, 16 Feb 2024 13:19:49 +0000 Subject: [PATCH] Fix value replacement for sfc_POINT --- R/sfc.R | 6 +++++- tests/testthat/test_sfc.R | 10 ++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/sfc.R b/R/sfc.R index 622218073..e9b5e0cf7 100644 --- a/R/sfc.R +++ b/R/sfc.R @@ -181,10 +181,14 @@ st_sfc = function(..., crs = NA_crs_, precision = 0.0, check_ring_dir = FALSE, d else do.call(rbind, value) attr(x, "points")[i, ] = repl - return(structure(x, n_empty = sum(is.na(attr(x, "points")[,1])))) # RETURNS + return(structure(x, + n_empty = sum(is.na(attr(x, "points")[,1])), + bbox = bbox.pointmatrix(attr(x, "points")) + )) # RETURNS } else x = x[] # realize } + value = value[] # realize in case sfc_POINT while x is not 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/tests/testthat/test_sfc.R b/tests/testthat/test_sfc.R index ce609621e..139c419b1 100644 --- a/tests/testthat/test_sfc.R +++ b/tests/testthat/test_sfc.R @@ -119,3 +119,13 @@ test_that("c.sfc n_empty returns sum of st_is_empty(sfg)", { test_that("st_is_longlat warns on invalid bounding box", { expect_warning(st_is_longlat(st_sfc(st_point(c(0,-95)), crs = 4326))) }) + +test_that("value replacement works for sfc_POINT",{ + pts1<-st_geometry(st_as_sf(data.frame(x=1:3,y=1:3), coords = c("x","y"))) + pts2<-st_geometry(st_as_sf(data.frame(x=4:5,y=4:5), coords = c("x","y"))) + expect_identical(replace(pts1[],2:3,pts2), replace(pts1[],2:3,pts2[])) + expect_identical(replace(pts1,2:3,pts2[])[], replace(pts1[],2:3,pts2[])) + expect_identical(replace(pts1,2:3,pts2)[], replace(pts1[],2:3,pts2[])) + expect_identical(st_bbox(replace(pts1,2:3,pts2)), + st_bbox(replace(pts1[],2:3,pts2[])))# check if bbox is correct without realization +})