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