1context("sf: st_cast")
2
3m <- rbind(c(0,0), c(1,0), c(1, 1), c(0,1), c(0,0))
4s <- matrix(c(2, 0), 5, 2, byrow = TRUE)
5cc <- list(
6  points = list(
7    single = m[1, ] %>% st_point(),
8    multi = m %>% st_multipoint(),
9    multi_empty = st_multipoint()
10  ),
11  lines = list(
12    single = m %>% st_linestring(),
13    multi = list(m, m + s) %>% st_multilinestring()
14  ),
15  polygons = list(
16    single = list(m + s)  %>% st_polygon(),
17    multi = list(list(m), list(m + s)) %>% st_multipolygon()
18  )
19)
20
21test_that("st_cast() can coerce to MULTI* or GEOMETRY", {
22  # st_cast
23  # ======
24  # points
25  pt <- st_sfc(cc$points$single, cc$points$single)
26  expect_is(st_cast(pt), "sfc_POINT")
27  pts <- st_sfc(cc$points$single, cc$points$multi, cc$points$multi_empty)
28  expect_is(st_cast(pts), "sfc_MULTIPOINT")
29  expect_warning(pt <- st_cast(pts, "POINT"), "first coordinate")
30  expect_is(pt, "sfc_POINT")
31  expect_is(st_cast(pts, "MULTIPOINT"), "sfc_MULTIPOINT")
32  expect_error(st_cast(pts, "LINESTRING"), "cannot create LINESTRING from POINT")
33  expect_error(st_cast(pts, "MULTILINESTRING"), "cannot create MULTILINESTRING from POINT")
34  expect_error(st_cast(pts, "POLYGON"), "cannot create POLYGON from POINT")
35  expect_error(st_cast(pts, "MULTIPOLYGON"), "cannot create MULTIPOLYGON from POINT")
36
37  # multipoints
38  mp <- st_sfc(st_multipoint(m[1:4,]))
39  expect_is(mp, "sfc_MULTIPOINT")
40  expect_is(st_cast(mp, "MULTIPOINT"), "sfc_MULTIPOINT")
41  expect_is(st_cast(mp, "POINT"), "sfc_POINT")
42  expect_silent(st_cast(mp, "POINT"))
43  expect_warning(st_cast(mp[[1]], "POINT"), "point from first coordinate only")
44  expect_is(st_cast(mp, "POLYGON"), "sfc_POLYGON")
45  expect_is(st_cast(mp[[1]], "POLYGON"), "POLYGON")
46  expect_is(st_cast(mp, "LINESTRING"), "sfc_LINESTRING")
47  expect_is(st_cast(mp[[1]], "LINESTRING"), "LINESTRING")
48  expect_error(st_cast(mp, "MULTIPOLYGON"), "smaller steps")
49  expect_is(st_cast(mp[[1]], "MULTIPOLYGON"), "MULTIPOLYGON")
50  expect_is(st_cast(mp, "MULTILINESTRING"), "sfc_MULTILINESTRING")
51  expect_is(st_cast(mp[[1]], "MULTILINESTRING"), "MULTILINESTRING")
52  expect_error(st_cast(mp, "GEOMETRYCOLLECTION"), "smaller steps")
53  expect_is(st_cast(mp[[1]], "GEOMETRYCOLLECTION"), "GEOMETRYCOLLECTION")
54
55  # lines
56  ln <- st_sfc(cc$lines$single, cc$lines$single)
57  expect_is(st_cast(ln), "sfc_LINESTRING")
58  lns <- st_sfc(cc$lines$single, cc$lines$multi)
59  expect_is(st_cast(lns), "sfc_MULTILINESTRING")
60  expect_warning(ln <- st_cast(lns, "POINT"), "first coordinate")
61  expect_is(ln, "sfc_POINT")
62  expect_is(st_cast(lns, "MULTIPOINT"), "sfc_MULTIPOINT")
63  expect_warning(ln2 <- st_cast(lns, "LINESTRING"), "first linestring")
64  expect_is(ln2, "sfc_LINESTRING")
65  expect_is(st_cast(lns, "MULTILINESTRING"), "sfc_MULTILINESTRING")
66  expect_is(st_cast(lns, "POLYGON"), "sfc_POLYGON")
67  expect_is(st_cast(lns, "MULTIPOLYGON"), "sfc_MULTIPOLYGON")
68
69  # polygons
70  pl <- st_sfc(cc$polygons$single, cc$polygons$single)
71  expect_is(st_cast(pl), "sfc_POLYGON")
72  pls <- st_sfc(cc$polygons$single, cc$polygons$multi)
73  expect_is(st_cast(pls), "sfc_MULTIPOLYGON")
74  expect_warning(pl <- st_cast(pls, "POINT"), "first coordinate")
75  expect_is(pl, "sfc_POINT")
76  expect_is(st_cast(pls, "MULTIPOINT"), "sfc_MULTIPOINT")
77  expect_warning(pl2 <- st_cast(pls, "LINESTRING"), "first ring")
78  expect_is(pl2, "sfc_LINESTRING")
79  expect_is(st_cast(pls, "MULTILINESTRING"), "sfc_MULTILINESTRING")
80  expect_warning(pl3 <- st_cast(pls, "POLYGON"), "first part")
81  expect_is(pl3, "sfc_POLYGON")
82  expect_is(st_cast(pls, "MULTIPOLYGON"), "sfc_MULTIPOLYGON")
83
84  # mixed
85  expect_is(st_cast(st_sfc(cc$points$single, cc$lines$multi)), "sfc_GEOMETRY")
86  expect_is(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY")
87
88  expect_is(st_cast(st_sfc(cc$lines$multi, cc$polygons$multi)), "sfc_GEOMETRY")
89  expect_is(st_cast(st_sfc(cc$points$multi, cc$polygons$multi)), "sfc_GEOMETRY")
90  expect_is(st_cast(st_sfc(cc$points$multi, cc$lines$multi, cc$polygons$multi)),
91            "sfc_GEOMETRY")
92  expect_is(st_cast(st_sfc(list(cc$points$multi, cc$lines$multi, cc$polygons$multi))),
93            "sfc_GEOMETRY")
94})
95
96test_that("st_cast preserves crs (#154)", {
97  expect_identical(st_cast(st_sfc(cc$points$single, cc$lines$multi, crs = 4326)) %>% st_crs(),
98              st_sfc(cc$points$single, cc$lines$multi, crs = 4326) %>% st_crs())
99})
100
101test_that("st_cast can crack GEOMETRYCOLLECTION", {
102  gc1 <- st_geometrycollection(list(st_linestring(rbind(c(0,0),c(1,1),c(2,1)))))
103  gc2 <- st_geometrycollection(list(st_multilinestring(list(
104    rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1))))))
105  gc3 <- st_geometrycollection(list(st_multilinestring(list(
106    rbind(c(4,4),c(4,3)), rbind(c(2,2),c(2,1),c(3,1))))))
107  gc4 <- st_geometrycollection(list(st_multipoint(rbind(c(1,5), c(4,3)))))
108
109  sfc <- st_sfc(gc1, gc2, gc3)
110  expect_is(st_cast(sfc), "sfc_GEOMETRY")  # first, it cracks the collection
111  expect_is(st_cast(st_cast(sfc)), "sfc_MULTILINESTRING")  # then cast to multi*
112#  expect_warning(expect_is(st_cast(sfc, "POINT"), "sfc_POINT"), "first coordinate")
113#  expect_equal(st_cast(sfc, "POINT") %>% length, sfc %>% length)
114# @etienne: I think this is more useful; attr(x, "ids") contains the original lengths
115  expect_is(st_cast(sfc, "MULTIPOINT"), "sfc_MULTIPOINT")
116  #expect_is(st_cast(sfc, "LINESTRING"), "sfc_LINESTRING")
117  expect_error(st_cast(sfc, "LINESTRING"))
118  expect_error(st_cast(sfc, "MULTILINESTRING"))
119  expect_is(st_cast(sfc) %>% st_cast("MULTILINESTRING"), "sfc_MULTILINESTRING")
120
121  # Can deal with GCs containing empty geometries - #1767
122  gc5 <- st_as_sfc(
123    c("GEOMETRYCOLLECTION (POLYGON ((5.5 0, 7 0, 7 -0.5, 6 -0.5, 5.5 0)))",
124      "GEOMETRYCOLLECTION (POLYGON EMPTY)"
125    )
126  )
127  expect_is(st_cast(gc5), "sfc_POLYGON")
128  expect_equal(st_is_empty(st_cast(gc5)), c(FALSE, TRUE))
129
130  sfc2 <- st_sfc(gc1, gc2, gc4)
131  expect_is(sfc2 %>% st_cast, "sfc_GEOMETRY")
132  expect_equal(sapply(sfc2 %>% st_cast, class)[2, ], c("LINESTRING", "MULTILINESTRING", "MULTIPOINT"))
133})
134
135test_that("can cast empty polygon (#1094)", {
136  poly <- st_as_sfc(c('MULTIPOLYGON(((3 1,3 5,6 5,3 1)))', 'POLYGON EMPTY'))
137  expect_is(st_cast(poly), "sfc_MULTIPOLYGON")
138})
139