1context("coord_sf")
2
3test_that("basic plot builds without error", {
4  skip_if_not_installed("sf")
5
6  nc_tiny_coords <- matrix(
7    c(-81.473, -81.741, -81.67, -81.345, -81.266, -81.24, -81.473,
8      36.234, 36.392, 36.59, 36.573, 36.437, 36.365, 36.234),
9    ncol = 2
10  )
11
12  nc <- sf::st_as_sf(
13    data_frame(
14      NAME = "ashe",
15      geometry = sf::st_sfc(sf::st_polygon(list(nc_tiny_coords)), crs = 4326)
16    )
17  )
18
19  expect_doppelganger("sf-polygons", ggplot(nc) + geom_sf() + coord_sf())
20})
21
22test_that("graticule lines can be removed via theme", {
23  skip_if_not_installed("sf")
24
25  df <- data_frame(x = c(1, 2, 3), y = c(1, 2, 3))
26  plot <- ggplot(df, aes(x, y)) +
27    geom_point() +
28    coord_sf() +
29    theme_gray() + # to test for presence of background grob
30    theme(panel.grid = element_blank())
31
32  expect_doppelganger("no panel grid", plot)
33})
34
35test_that("axis labels are correct for manual breaks", {
36  skip_if_not_installed("sf")
37
38  plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
39    geom_sf()
40
41  # autogenerated labels
42  b <- ggplot_build(
43    plot +
44      scale_x_continuous(breaks = c(1000, 2000, 3000)) +
45      scale_y_continuous(breaks = c(1000, 1500, 2000))
46  )
47  graticule <- b$layout$panel_params[[1]]$graticule
48  expect_identical(
49    graticule[graticule$type == "E", ]$degree_label,
50    c("1000", "2000", "3000")
51  )
52  expect_identical(
53    graticule[graticule$type == "N", ]$degree_label,
54    c("1000", "1500", "2000")
55  )
56})
57
58test_that("axis labels can be set manually", {
59  skip_if_not_installed("sf")
60
61  plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
62    geom_sf()
63
64  # character labels
65  b <- ggplot_build(
66    plot +
67      scale_x_continuous(
68        breaks = c(1000, 2000, 3000),
69        labels = c("A", "B", "C")
70      ) +
71      scale_y_continuous(
72        breaks = c(1000, 1500, 2000),
73        labels = c("D", "E", "F")
74      )
75  )
76  graticule <- b$layout$panel_params[[1]]$graticule
77  expect_identical(
78    graticule[graticule$type == "E", ]$degree_label,
79    c("A", "B", "C")
80  )
81  expect_identical(
82    graticule[graticule$type == "N", ]$degree_label,
83    c("D", "E", "F")
84  )
85})
86
87test_that("factors are treated like character labels and are not parsed", {
88  skip_if_not_installed("sf")
89
90  plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
91    geom_sf()
92
93  b <- ggplot_build(
94    plot +
95      scale_x_continuous(
96        breaks = c(1000, 2000, 3000),
97        labels = factor(c("A", "B", "C"))
98      ) +
99      scale_y_continuous(
100        breaks = c(1000, 1500, 2000),
101        labels = factor(c("1 * degree * N", "1.5 * degree * N", "2 * degree * N"))
102      )
103  )
104  graticule <- b$layout$panel_params[[1]]$graticule
105  expect_identical(
106    graticule[graticule$type == "E", ]$degree_label,
107    c("A", "B", "C")
108  )
109  expect_identical(
110    graticule[graticule$type == "N", ]$degree_label,
111    c("1 * degree * N", "1.5 * degree * N", "2 * degree * N")
112  )
113})
114
115test_that("expressions can be mixed with character labels", {
116  skip_if_not_installed("sf")
117
118  plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) +
119    geom_sf()
120
121  b <- ggplot_build(
122    plot +
123      scale_x_continuous(
124        breaks = c(1000, 2000, 3000),
125        labels = c("A", "B", "C")
126      ) +
127      scale_y_continuous(
128        breaks = c(1000, 1500, 2000),
129        labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
130      )
131  )
132  graticule <- b$layout$panel_params[[1]]$graticule
133  expect_identical(
134    graticule[graticule$type == "E", ]$degree_label,
135    as.list(c("A", "B", "C"))
136  )
137  parsed <- vector("list", 3)
138  parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
139  expect_identical(
140    graticule[graticule$type == "N", ]$degree_label,
141    parsed
142  )
143
144  # reverse x and y from previous test
145  b <- ggplot_build(
146    plot +
147      scale_y_continuous(
148        breaks = c(1000, 2000, 3000),
149        labels = c("A", "B", "C")
150      ) +
151      scale_x_continuous(
152        breaks = c(1000, 1500, 2000),
153        labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
154      )
155  )
156  graticule <- b$layout$panel_params[[1]]$graticule
157  expect_identical(
158    graticule[graticule$type == "N", ]$degree_label,
159    as.list(c("A", "B", "C"))
160  )
161  parsed <- vector("list", 3)
162  parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3"))
163  expect_identical(
164    graticule[graticule$type == "E", ]$degree_label,
165    parsed
166  )
167})
168
169test_that("degree labels are automatically parsed", {
170  skip_if_not_installed("sf")
171
172  data <- sf::st_sfc(
173    sf::st_polygon(list(matrix(1e1*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2))),
174    crs = 4326 # basic long-lat crs
175  )
176  plot <- ggplot(data) + geom_sf()
177  b <- ggplot_build(
178    plot +
179      scale_x_continuous(breaks = c(10, 20, 30)) +
180      scale_y_continuous(breaks = c(10, 15, 20))
181  )
182
183  graticule <- b$layout$panel_params[[1]]$graticule
184  expect_setequal(
185    graticule[graticule$type == "N", ]$degree,
186    c(10, 15, 20)
187  )
188  expect_setequal(
189    graticule[graticule$type == "E", ]$degree,
190    c(10, 20, 30)
191  )
192  expect_true(all(vapply(graticule$degree_label, is.language, logical(1))))
193})
194
195test_that("Inf is squished to range", {
196  skip_if_not_installed("sf")
197
198  d <- cdata(
199    ggplot(sf::st_point(c(0, 0))) +
200      geom_sf() +
201      annotate("text", -Inf, Inf, label = "Top-left")
202  )
203
204  expect_equal(d[[2]]$x, 0)
205  expect_equal(d[[2]]$y, 1)
206})
207
208test_that("default crs works", {
209  skip_if_not_installed("sf")
210
211  polygon <- sf::st_sfc(
212    sf::st_polygon(list(matrix(c(-80, -76, -76, -80, -80, 35, 35, 40, 40, 35), ncol = 2))),
213    crs = 4326 # basic long-lat crs
214  )
215  polygon <- sf::st_transform(polygon, crs = 3347)
216
217  points <- data_frame(
218    x = c(-80, -80, -76, -76),
219    y = c(35, 40, 35, 40)
220  )
221
222  p <- ggplot(polygon) + geom_sf(fill = NA)
223
224  # by default, regular geoms are interpreted to use projected data
225  points_trans <- sf_transform_xy(points, 3347, 4326)
226  expect_doppelganger(
227    "non-sf geoms using projected coords",
228    p + geom_point(data = points_trans, aes(x, y))
229  )
230
231  # projected sf objects can be mixed with regular geoms using non-projected data
232  expect_doppelganger(
233    "non-sf geoms using long-lat",
234    p + geom_point(data = points, aes(x, y)) +
235      coord_sf(default_crs = 4326)
236  )
237
238  # coord limits can be specified in long-lat
239  expect_doppelganger(
240    "limits specified in long-lat",
241    p + geom_point(data = points, aes(x, y)) +
242      coord_sf(xlim = c(-80.5, -76), ylim = c(36, 41), default_crs = 4326)
243  )
244
245  # by default limits are specified in projected coords
246  lims <- sf_transform_xy(
247    list(x = c(-80.5, -76, -78.25, -78.25), y = c(38.5, 38.5, 36, 41)),
248    3347, 4326
249  )
250  expect_doppelganger(
251    "limits specified in projected coords",
252    p + geom_point(data = points_trans, aes(x, y)) +
253      coord_sf(xlim = lims$x[1:2], ylim = lims$y[3:4])
254  )
255})
256
257test_that("sf_transform_xy() works", {
258  skip_if_not_installed("sf")
259
260  data <- list(
261    city = c("Charlotte", "Raleigh", "Greensboro"),
262    x =  c(-80.843, -78.639, -79.792),
263    y = c(35.227, 35.772, 36.073)
264  )
265
266  # no transformation if one crs is missing
267  out <- sf_transform_xy(data, NULL, 4326)
268  expect_identical(data, out)
269  out <- sf_transform_xy(data, 4326, NULL)
270  expect_identical(data, out)
271
272  # transform to projected coordinates
273  out <- sf_transform_xy(data, 3347, 4326)
274  expect_identical(data$city, out$city) # columns other than x, y are not changed
275  expect_true(all(abs(out$x - c(7275499, 7474260, 7357835)) < 10))
276  expect_true(all(abs(out$y - c(-60169, 44384, 57438)) < 10))
277
278  # transform back
279  out2 <- sf_transform_xy(out, 4326, 3347)
280  expect_identical(data$city, out2$city)
281  expect_true(all(abs(out2$x - data$x) < .01))
282  expect_true(all(abs(out2$y - data$y) < .01))
283
284})
285