1context("geom-sf")
2
3test_that("geom_sf() determines the legend type automatically", {
4  skip_if_not_installed("sf")
5  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
6
7  mp <- sf::st_sf(
8    geometry = sf::st_sfc(sf::st_multipoint(rbind(c(1,1), c(2,2), c(3,3)))),
9    v = "a")
10
11  s1 <- rbind(c(0,3),c(0,4),c(1,5),c(2,5))
12  s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8))
13  s3 <- rbind(c(0,4.4), c(0.6,5))
14
15  mls <- sf::st_sf(
16    geometry = sf::st_sfc(sf::st_multilinestring(list(s1,s2,s3))),
17    v = "a")
18
19  p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))
20  p2 <- rbind(c(1,1), c(1,2), c(2,2), c(1,1))
21  p3 <- rbind(c(3,0), c(4,0), c(4,1), c(3,1), c(3,0))
22  p4 <- rbind(c(3.3,0.3), c(3.8,0.3), c(3.8,0.8), c(3.3,0.8), c(3.3,0.3))[5:1,]
23  p5 <- rbind(c(3,3), c(4,2), c(4,3), c(3,3))
24
25  mpol <- sf::st_sf(
26    geometry = sf::st_sfc(sf::st_multipolygon(list(list(p1,p2), list(p3,p4), list(p5)))),
27    v = "a")
28
29  fun_geom_sf <- function(sf, show.legend) {
30    p <- ggplot() + geom_sf(aes(colour = v), data = sf, show.legend = show.legend)
31    ggplot_build(p)
32  }
33
34  # test the automatic choice
35  expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$show.legend, TRUE)
36  expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "point")
37
38  expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$show.legend, TRUE)
39  expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "line")
40
41  expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$show.legend, TRUE)
42  expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "polygon")
43
44  # test that automatic choice can be overridden manually
45  expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$show.legend, TRUE)
46  expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$computed_geom_params$legend, "point")
47
48  expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$show.legend, TRUE)
49  expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$computed_geom_params$legend, "point")
50
51  expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$show.legend, TRUE)
52  expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$computed_geom_params$legend, "point")
53})
54
55test_that("geom_sf() determines the legend type from mapped geometry column", {
56  skip_if_not_installed("sf")
57  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
58
59  p1 <- rbind(c(1,1), c(2,2), c(3,3))
60  s1 <- rbind(c(0,3), c(0,4), c(1,5), c(2,5))
61  s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8))
62  s3 <- rbind(c(0,4.4), c(0.6,5))
63
64  d_sf <- sf::st_sf(
65    g_point = sf::st_sfc(sf::st_multipoint(p1)),
66    g_line = sf::st_sfc(sf::st_multilinestring(list(s1, s2, s3))),
67    v = "a"
68  )
69
70  p <- ggplot_build(
71    ggplot(d_sf) + geom_sf(aes(geometry = g_point, colour = "a"))
72  )
73  expect_identical(p$plot$layers[[1]]$computed_geom_params$legend, "point")
74
75  p <- ggplot_build(
76    ggplot(d_sf) + geom_sf(aes(geometry = g_line, colour = "a"))
77  )
78  expect_identical(p$plot$layers[[1]]$computed_geom_params$legend, "line")
79
80  # If `geometry` is not a symbol, `LayerSf$setup_layer()` gives up guessing
81  # the legend type, and falls back to "polygon"
82  p <- ggplot_build(
83    ggplot(d_sf) + geom_sf(aes(geometry = identity(g_point), colour = "a"))
84  )
85  expect_identical(p$plot$layers[[1]]$computed_geom_params$legend, "polygon")
86})
87
88test_that("geom_sf() removes rows containing missing aes", {
89  skip_if_not_installed("sf")
90  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
91
92  grob_xy_length <- function(x) {
93    g <- layer_grob(x)[[1]]
94    c(length(g$x), length(g$y))
95  }
96
97  pts <- sf::st_sf(
98    geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)),
99    size = c(1, NA),
100    shape = c("a", NA),
101    colour = c("red", NA)
102  )
103
104  p <- ggplot(pts) + geom_sf()
105  expect_warning(
106    expect_identical(grob_xy_length(p + aes(size = size)), c(1L, 1L)),
107    "Removed 1 rows containing missing values"
108  )
109  expect_warning(
110    expect_identical(grob_xy_length(p + aes(shape = shape)), c(1L, 1L)),
111    "Removed 1 rows containing missing values"
112  )
113  # default colour scale maps a colour even to a NA, so identity scale is needed to see if NA is removed
114  expect_warning(
115    expect_identical(grob_xy_length(p + aes(colour = colour) + scale_colour_identity()),
116                     c(1L, 1L)),
117    "Removed 1 rows containing missing values"
118  )
119})
120
121test_that("geom_sf() handles alpha properly", {
122  skip_if_not_installed("sf")
123  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
124
125  sfc <- sf::st_sfc(
126    sf::st_point(0:1),
127    sf::st_linestring(rbind(0:1, 1:2)),
128    sf::st_polygon(list(rbind(0:1, 1:2, 2:1, 0:1)))
129  )
130  red <- "#FF0000FF"
131  p <- ggplot(sfc) + geom_sf(colour = red, fill = red, alpha = 0.5)
132  g <- layer_grob(p)[[1]]
133
134  # alpha affects the colour of points and lines
135  expect_equal(g[[1]]$gp$col, alpha(red, 0.5))
136  expect_equal(g[[2]]$gp$col, alpha(red, 0.5))
137  # alpha doesn't affect the colour of polygons, but the fill
138  expect_equal(g[[3]]$gp$col, alpha(red, 1.0))
139  expect_equal(g[[3]]$gp$fill, alpha(red, 0.5))
140})
141
142# Visual tests ------------------------------------------------------------
143
144test_that("geom_sf draws correctly", {
145  skip_if_not_installed("sf")
146  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
147
148  nc_tiny_coords <- matrix(
149    c(-81.473, -81.741, -81.67, -81.345, -81.266, -81.24, -81.473,
150      36.234, 36.392, 36.59, 36.573, 36.437, 36.365, 36.234),
151    ncol = 2
152  )
153
154  nc <- sf::st_as_sf(
155    data_frame(
156      NAME = "ashe",
157      geometry = sf::st_sfc(sf::st_polygon(list(nc_tiny_coords)), crs = 4326)
158    )
159  )
160
161
162  # Perform minimal tests
163  pts <- sf::st_sf(a = 1:2, geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)))
164  plot <- ggplot() + geom_sf(data = pts)
165  expect_error(regexp = NA, ggplot_build(plot))
166
167  expect_doppelganger("North Carolina county boundaries",
168    ggplot() + geom_sf(data = nc) + coord_sf(datum = 4326)
169  )
170
171  pts <- sf::st_sf(a = 1:2, geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)))
172  expect_doppelganger("spatial points",
173    ggplot() + geom_sf(data = pts)
174  )
175})
176
177test_that("geom_sf_text() and geom_sf_label() draws correctly", {
178  skip_if_not_installed("sf")
179  if (packageVersion("sf") < "0.5.3") skip("Need sf 0.5.3")
180
181  nc_tiny_coords <- matrix(
182    c(-81.473, -81.741, -81.67, -81.345, -81.266, -81.24, -81.473,
183      36.234, 36.392, 36.59, 36.573, 36.437, 36.365, 36.234),
184    ncol = 2
185  )
186
187  nc <- sf::st_as_sf(
188    data_frame(
189      NAME = "ashe",
190      geometry = sf::st_sfc(sf::st_polygon(list(nc_tiny_coords)), crs = 4326)
191    )
192  )
193
194  # In order to avoid warning, transform to a projected coordinate system
195  nc_3857 <- sf::st_transform(nc, 3857)
196
197  expect_doppelganger("Texts for North Carolina",
198    ggplot() + geom_sf_text(data = nc_3857, aes(label = NAME))
199  )
200
201  expect_doppelganger("Labels for North Carolina",
202    ggplot() + geom_sf_label(data = nc_3857, aes(label = NAME))
203  )
204})
205