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