tests/testthat/test-sf.R

In edzer/sfr: Simple Features for R

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")
})