tests/testthat/test-collection_extract.R

In edzer/sfr: Simple Features for R

pt <- st_point(c(1, 0))
ls <- st_linestring(matrix(c(4, 3, 0, 0), ncol = 2))
poly1 <- st_polygon(list(matrix(c(5.5, 7, 7, 6, 5.5, 0, 0, -0.5, -0.5, 0), ncol = 2)))
poly2 <- st_polygon(list(matrix(c(6.6, 8, 8, 7, 6.6, 1, 1, 1.5, 1.5, 1), ncol = 2)))
multipoly <- st_multipolygon(list(poly1, poly2))

i <- st_geometrycollection(list(pt, ls, poly1, poly2))

j <- st_geometrycollection(list(pt, ls, poly1, poly2, multipoly))

## A GEOMETRYCOLLECTION
aa <- rbind(st_sf(a=1, geom = st_sfc(i)),
			st_sf(a=2, geom = st_sfc(j)))

##
## A GEOMETRY of single types
bb <- rbind(
	st_sf(a = 1, geom = st_sfc(pt)),
	st_sf(a = 2, geom = st_sfc(ls)),
	st_sf(a = 3, geom = st_sfc(poly1)),
	st_sf(a = 4, geom = st_sfc(multipoly))
)

## A GEOMETRY of mixed single types and GEOMETRYCOLLECTIONS
cc <- rbind(aa, bb)

test_that("st_collection_extract works with sfg objects", {
	expect_s3_class(st_collection_extract(i, "POLYGON"), "sfc_POLYGON")
	expect_s3_class(st_collection_extract(j, "POLYGON"), "sfc_MULTIPOLYGON")
	expect_s3_class(st_collection_extract(i, "POINT"), "POINT")
	expect_s3_class(st_collection_extract(i, "LINESTRING"), "LINESTRING")
})

test_that("st_collection_extract works with sfc objects", {
	expect_s3_class(st_collection_extract(st_geometry(aa), "POLYGON"), "sfc_MULTIPOLYGON")
	expect_s3_class(st_collection_extract(st_geometry(aa), "LINESTRING"), "sfc_LINESTRING")
	expect_s3_class(st_collection_extract(st_geometry(aa), "POINT"), "sfc_POINT")
	expect_s3_class(st_collection_extract(st_geometry(bb), "POINT"), "sfc_POINT")
	expect_s3_class(st_collection_extract(st_geometry(cc), "POLYGON"), "sfc_MULTIPOLYGON")
})


test_that("st_collection_extract works with sf objects", {
	expect_s3_class(st_geometry(st_collection_extract(aa, "POLYGON")), "sfc_MULTIPOLYGON")
	expect_s3_class(st_geometry(st_collection_extract(aa, "LINESTRING")), "sfc_LINESTRING")
	expect_s3_class(st_geometry(st_collection_extract(aa, "POINT")), "sfc_POINT")
	expect_s3_class(st_geometry(st_collection_extract(bb, "POLYGON")), "sfc_MULTIPOLYGON")
	expect_s3_class(st_geometry(st_collection_extract(cc, "POLYGON")), "sfc_MULTIPOLYGON")
})

test_that("st_collection_extract behaves with unexpected inputs", {
	expect_warning(st_collection_extract(poly1, "POLYGON"),
				   "x is already of type POLYGON")
	expect_error(st_collection_extract(st_sfc(pt), "POLYGON"),
				 "x is of singular geometry type that is different to supplied type")
	expect_error(st_collection_extract(st_sf(a = "a", geom = st_sfc(pt)), "POLYGON"),
				 "x is of singular geometry type that is different to supplied type")
	## Returns empty geometry
	expect_warning(st_collection_extract(st_sfc(pt, ls), "POLYGON"),
				   "x contains no geometries of specified type")
	expect_warning(st_collection_extract(st_sf(a = c("a", "b"), geom = st_sfc(ls, pt)),
										"POLYGON"),
				   "x contains no geometries of specified type")
	expect_warning(zero_len <- st_collection_extract(st_geometrycollection(list(pt, ls)), "POLYGON"),
	"x contains no geometries of specified type")
	expect_length(zero_len, 0L)
	expect_s3_class(zero_len, "sfg")
	expect_true(st_is(zero_len, "POLYGON"))
})