test_that("we can subset sf objects", {
pt1 = st_point(1:2)
pt2 = st_point(3:4)
s1 = st_sf(a = c("x", "y"), geom = st_sfc(pt1, pt2))
expect_equal(as.character(s1[[1]]), c("x", "y"))
expect_equal(s1[,1], s1) #data.frame(x = c("x", "y")))
expect_equal(nrow(s1[1,]), 1)
expect_equal(c(st_bbox(s1[1,])), c(xmin=1,ymin=2,xmax=1,ymax=2))
a = c("x", "y")
g = st_sfc(pt1, pt2)
expect_silent(xxx <- st_sf(a, g, g))
expect_silent(st_sf(a, geom1 = g, geom2 = g, sf_column_name = "geom2"))
x = st_sf(a, geom1 = g, geom2 = g, sf_column_name = "geom2")
expect_silent(st_geometry(x) <- "geom2")
expect_silent(st_geometry(x) <- "geom1")
})
test_that("we can create points sf from data.frame", {
skip_if_not_installed("sp")
data(meuse, package = "sp") # load data.frame from sp
meuse_sf = st_as_sf(meuse, coords = c("x", "y"), crs = 28992)
meuse_sf[1:5,]
summary(meuse_sf[1:5,])
expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE)
})
test_that("st_zm works", {
pt = st_point(1:2)
ptz = st_point(1:3, "XYZ")
ptm = st_point(1:3, "XYM")
ptzm = st_point(1:4, "XYZM")
pl = st_multilinestring(list(matrix(1:10,,2), matrix(1:10,,2)))
plz = st_multilinestring(list(matrix(1:15,,3), matrix(1:15,,3)), "XYZ")
plm = st_multilinestring(list(matrix(1:15,,3), matrix(1:15,,3)), "XYM")
plzm = st_multilinestring(list(matrix(1:20,,4), matrix(1:20,,4)), "XYZM")
expect_identical(pt, st_zm(ptz))
expect_identical(pt, st_zm(ptm))
expect_identical(pt, st_zm(ptzm))
expect_identical(pl, st_zm(plz))
expect_identical(pl, st_zm(plm))
expect_identical(pl, st_zm(plzm))
expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptz,plz)))
expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptm,plm)))
expect_identical(st_sfc(pt,pl), st_zm(st_sfc(ptzm,plzm)))
expect_identical(st_sf(a = 1:2, geom = st_sfc(pt,pl)), st_zm(st_sf(a = 1:2, geom = st_sfc(ptzm,plzm))))
expect_identical(st_zm(pt, drop = FALSE, what = "Z"), st_point(c(1:2,0)))
expect_silent(st_zm(pl, drop = FALSE, what = "Z"))
})
test_that("rbind/cbind work", {
# cbind/rbind:
x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326))
# don't warn when replacing crs with identical value:
if (version$major == "3") {
if (version$minor >= "3.0") {
expect_silent(xxx <- cbind(x, x, x))
rbind(x, x, x)
}
}
})
test_that("st_as_sf bulk points work", {
skip_if_not_installed("sp")
data(meuse, package = "sp") # load data.frame from sp
x <- meuse
meuse_sf = st_as_sf(x, coords = c("x", "y"), crs = 28992)
xyz_sf = st_as_sf(x, coords = c("y", "x", "dist"))
xym_sf = st_as_sf(x, coords = c("y", "x", "dist"), dim = "XYM")
xyzm_sf = st_as_sf(x, coords = c("x", "y", "dist", "zinc"), dim = "XYZM")
expect_s3_class(meuse_sf, c("sf", "data.frame"), exact = TRUE)
expect_s3_class(xyz_sf, c("sf", "data.frame"), exact = TRUE)
expect_s3_class(xym_sf, c("sf", "data.frame"), exact = TRUE)
expect_s3_class(xyzm_sf, c("sf", "data.frame"), exact = TRUE)
expect_length(st_geometry(meuse_sf)[[1]], 2L)
expect_length(st_geometry(xyz_sf)[[1]], 3L)
expect_length(st_geometry(xym_sf)[[1]], 3L)
expect_length(st_geometry(xyzm_sf)[[1]], 4L)
})
test_that("transform work", {
skip_if_not_installed("sp")
data(meuse, package = "sp")
x = st_as_sf(meuse, coords = c("x", "y"), crs = 28992)
x2 = transform(x, elev2 = elev^2, lead_zinc = lead/zinc)
expect_s3_class(x, "sf")
expect_identical(class(x2), class(x))
expect_identical(st_bbox(x), st_bbox(x))
expect_identical(st_crs(x), st_crs(x))
expect_identical(x$elev^2, x2$elev2)
})
test_that("empty agr attribute is named after subset", {
sf = st_sf(data.frame(x = st_sfc(st_point(1:2))))
out = sf[, "geometry"]
agr = attr(out, "agr")
expect_named(agr, character())
})
test_that("duplicated work",{
sf = st_sf(data.frame(x = st_sfc(st_point(1:2))[rep(1,4)], a=gl(2,2), b=as.numeric(gl(2,2))))
expect_identical(duplicated(sf), c(FALSE,TRUE,FALSE,TRUE))
expect_s3_class(unique(sf), "sf")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.