m <- rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0)) s <- matrix(c(2, 0), 5, 2, byrow = TRUE) cc <- list( points = list( single = m[1, ] %>% st_point(), multi = m %>% st_multipoint(), multi_empty = st_multipoint() ), lines = list( single = m %>% st_linestring(), multi = list(m, m + s) %>% st_multilinestring() ), polygons = list( single = list(m + s) %>% st_polygon(), multi = list(list(m), list(m + s)) %>% st_multipolygon() ) ) test_that("st_cast() can coerce to MULTI* or GEOMETRY", { # st_cast # ====== # points pt <- st_sfc(cc$points$single, cc$points$single) expect_s3_class(st_cast(pt), "sfc_POINT") pts <- st_sfc(cc$points$single, cc$points$multi, cc$points$multi_empty) expect_s3_class(st_cast(pts), "sfc_MULTIPOINT") expect_warning(pt <- st_cast(pts, "POINT"), "first coordinate") expect_s3_class(pt, "sfc_POINT") expect_s3_class(st_cast(pts, "MULTIPOINT"), "sfc_MULTIPOINT") expect_error(st_cast(pts, "LINESTRING"), "cannot create LINESTRING from POINT") expect_error(st_cast(pts, "MULTILINESTRING"), "cannot create MULTILINESTRING from POINT") expect_error(st_cast(pts, "POLYGON"), "cannot create POLYGON from POINT") expect_error(st_cast(pts, "MULTIPOLYGON"), "cannot create MULTIPOLYGON from POINT") # multipoints mp <- st_sfc(st_multipoint(m[1:4,])) expect_s3_class(mp, "sfc_MULTIPOINT") expect_s3_class(st_cast(mp, "MULTIPOINT"), "sfc_MULTIPOINT") expect_s3_class(st_cast(mp, "POINT"), "sfc_POINT") expect_silent(st_cast(mp, "POINT")) expect_warning(st_cast(mp[[1]], "POINT"), "point from first coordinate only") expect_s3_class(st_cast(mp, "POLYGON"), "sfc_POLYGON") expect_s3_class(st_cast(mp[[1]], "POLYGON"), "POLYGON") expect_s3_class(st_cast(mp, "LINESTRING"), "sfc_LINESTRING") expect_s3_class(st_cast(mp[[1]], "LINESTRING"), "LINESTRING") expect_error(st_cast(mp, "MULTIPOLYGON"), "smaller steps") expect_s3_class(st_cast(mp[[1]], "MULTIPOLYGON"), "MULTIPOLYGON") expect_s3_class(st_cast(mp, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_s3_class(st_cast(mp[[1]], "MULTILINESTRING"), "MULTILINESTRING") expect_error(st_cast(mp, "GEOMETRYCOLLECTION"), "smaller steps") expect_s3_class(st_cast(mp[[1]], "GEOMETRYCOLLECTION"), "GEOMETRYCOLLECTION") # lines ln <- st_sfc(cc$lines$single, cc$lines$single) expect_s3_class(st_cast(ln), "sfc_LINESTRING") lns <- st_sfc(cc$lines$single, cc$lines$multi) expect_s3_class(st_cast(lns), "sfc_MULTILINESTRING") expect_warning(ln <- st_cast(lns, "POINT"), "first coordinate") expect_s3_class(ln, "sfc_POINT") expect_s3_class(st_cast(lns, "MULTIPOINT"), "sfc_MULTIPOINT") expect_warning(ln2 <- st_cast(lns, "LINESTRING"), "first linestring") expect_s3_class(ln2, "sfc_LINESTRING") expect_s3_class(st_cast(lns, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_s3_class(st_cast(lns, "POLYGON"), "sfc_POLYGON") expect_s3_class(st_cast(lns, "MULTIPOLYGON"), "sfc_MULTIPOLYGON") # polygons pl <- st_sfc(cc$polygons$single, cc$polygons$single) expect_s3_class(st_cast(pl), "sfc_POLYGON") pls <- st_sfc(cc$polygons$single, cc$polygons$multi) expect_s3_class(st_cast(pls), "sfc_MULTIPOLYGON") expect_warning(pl <- st_cast(pls, "POINT"), "first coordinate") expect_s3_class(pl, "sfc_POINT") expect_s3_class(st_cast(pls, "MULTIPOINT"), "sfc_MULTIPOINT") expect_warning(pl2 <- st_cast(pls, "LINESTRING"), "first ring") expect_s3_class(pl2, "sfc_LINESTRING") expect_s3_class(st_cast(pls, "MULTILINESTRING"), "sfc_MULTILINESTRING") expect_warning(pl3 <- st_cast(pls, "POLYGON"), "first part") expect_s3_class(pl3, "sfc_POLYGON") expect_s3_class(st_cast(pls, "MULTIPOLYGON"), "sfc_MULTIPOLYGON") # mixed expect_s3_class(st_cast(st_sfc(cc$points$single, cc$lines$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$points$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(cc$points$multi, cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY") expect_s3_class(st_cast(st_sfc(list(cc$points$multi, cc$lines$multi, cc$polygons$multi))), "sfc_GEOMETRY") }) test_that("st_cast preserves crs (#154)", { expect_identical(st_cast(st_sfc(cc$points$single, cc$lines$multi, crs = 4326)) %>% st_crs(), st_sfc(cc$points$single, cc$lines$multi, crs = 4326) %>% st_crs()) }) test_that("st_cast can crack GEOMETRYCOLLECTION", { gc1 <- st_geometrycollection(list(st_linestring(rbind(c(0,0),c(1,1),c(2,1))))) gc2 <- st_geometrycollection(list(st_multilinestring(list( rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))))) gc3 <- st_geometrycollection(list(st_multilinestring(list( rbind(c(4,4),c(4,3)), rbind(c(2,2),c(2,1),c(3,1)))))) gc4 <- st_geometrycollection(list(st_multipoint(rbind(c(1,5), c(4,3))))) sfc <- st_sfc(gc1, gc2, gc3) expect_s3_class(st_cast(sfc), "sfc_GEOMETRY") # first, it cracks the collection expect_s3_class(st_cast(st_cast(sfc)), "sfc_MULTILINESTRING") # then cast to multi* # expect_warning(expect_s3_class(st_cast(sfc, "POINT"), "sfc_POINT"), "first coordinate") # expect_equal(st_cast(sfc, "POINT") %>% length, sfc %>% length) # @etienne: I think this is more useful; attr(x, "ids") contains the original lengths expect_s3_class(st_cast(sfc, "MULTIPOINT"), "sfc_MULTIPOINT") # expect_s3_class(st_cast(sfc, "LINESTRING"), "sfc_LINESTRING") expect_error(st_cast(sfc, "LINESTRING")) expect_error(st_cast(sfc, "MULTILINESTRING")) expect_s3_class(st_cast(sfc) %>% st_cast("MULTILINESTRING"), "sfc_MULTILINESTRING") # Can deal with GCs containing empty geometries - #1767 gc5 <- st_as_sfc( c("GEOMETRYCOLLECTION (POLYGON ((5.5 0, 7 0, 7 -0.5, 6 -0.5, 5.5 0)))", "GEOMETRYCOLLECTION (POLYGON EMPTY)" ) ) expect_s3_class(st_cast(gc5), "sfc_POLYGON") expect_equal(st_is_empty(st_cast(gc5)), c(FALSE, TRUE)) sfc2 <- st_sfc(gc1, gc2, gc4) expect_s3_class(sfc2 %>% st_cast, "sfc_GEOMETRY") expect_equal(sapply(sfc2 %>% st_cast, class)[2, ], c("LINESTRING", "MULTILINESTRING", "MULTIPOINT")) }) test_that("can cast empty polygon (#1094)", { poly <- st_as_sfc(c('MULTIPOLYGON(((3 1,3 5,6 5,3 1)))', 'POLYGON EMPTY')) expect_s3_class(st_cast(poly), "sfc_MULTIPOLYGON") })