test_that("basic plot builds without error", { skip_if_not_installed("sf") nc_tiny_coords <- matrix( c(-81.473, -81.741, -81.67, -81.345, -81.266, -81.24, -81.473, 36.234, 36.392, 36.59, 36.573, 36.437, 36.365, 36.234), ncol = 2 ) nc <- sf::st_as_sf( data_frame( NAME = "ashe", geometry = sf::st_sfc(sf::st_polygon(list(nc_tiny_coords)), crs = 4326) ) ) expect_doppelganger("sf-polygons", ggplot(nc) + geom_sf() + coord_sf()) }) test_that("graticule lines can be removed via theme", { skip_if_not_installed("sf") df <- data_frame(x = c(1, 2, 3), y = c(1, 2, 3)) plot <- ggplot(df, aes(x, y)) + geom_point() + coord_sf() + theme_gray() + # to test for presence of background grob theme(panel.grid = element_blank()) expect_doppelganger("no panel grid", plot) }) test_that("axis labels are correct for manual breaks", { skip_if_not_installed("sf") plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) + geom_sf() # autogenerated labels b <- ggplot_build( plot + scale_x_continuous(breaks = c(1000, 2000, 3000)) + scale_y_continuous(breaks = c(1000, 1500, 2000)) ) graticule <- b$layout$panel_params[[1]]$graticule expect_identical( graticule[graticule$type == "E", ]$degree_label, c("1000", "2000", "3000") ) expect_identical( graticule[graticule$type == "N", ]$degree_label, c("1000", "1500", "2000") ) }) test_that("axis labels can be set manually", { skip_if_not_installed("sf") plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) + geom_sf() # character labels b <- ggplot_build( plot + scale_x_continuous( breaks = c(1000, 2000, 3000), labels = c("A", "B", "C") ) + scale_y_continuous( breaks = c(1000, 1500, 2000), labels = c("D", "E", "F") ) ) graticule <- b$layout$panel_params[[1]]$graticule expect_identical( graticule[graticule$type == "E", ]$degree_label, c("A", "B", "C") ) expect_identical( graticule[graticule$type == "N", ]$degree_label, c("D", "E", "F") ) p <- plot + scale_x_continuous( breaks = c(1000, 2000, 3000), labels = function(...) c("A", "B") ) expect_snapshot_error(ggplot_build(p)) p <- plot + scale_y_continuous( breaks = c(1000, 2000, 3000), labels = function(...) c("A", "B") ) expect_snapshot_error(ggplot_build(p)) expect_snapshot_error(coord_sf(label_graticule = 1:17)) expect_snapshot_error(coord_sf(label_axes = 1:17)) }) test_that("factors are treated like character labels and are not parsed", { skip_if_not_installed("sf") plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) + geom_sf() b <- ggplot_build( plot + scale_x_continuous( breaks = c(1000, 2000, 3000), labels = factor(c("A", "B", "C")) ) + scale_y_continuous( breaks = c(1000, 1500, 2000), labels = factor(c("1 * degree * N", "1.5 * degree * N", "2 * degree * N")) ) ) graticule <- b$layout$panel_params[[1]]$graticule expect_identical( graticule[graticule$type == "E", ]$degree_label, c("A", "B", "C") ) expect_identical( graticule[graticule$type == "N", ]$degree_label, c("1 * degree * N", "1.5 * degree * N", "2 * degree * N") ) }) test_that("expressions can be mixed with character labels", { skip_if_not_installed("sf") plot <- ggplot(sf::st_polygon(list(matrix(1e3*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2)))) + geom_sf() b <- ggplot_build( plot + scale_x_continuous( breaks = c(1000, 2000, 3000), labels = c("A", "B", "C") ) + scale_y_continuous( breaks = c(1000, 1500, 2000), labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3")) ) ) graticule <- b$layout$panel_params[[1]]$graticule expect_identical( graticule[graticule$type == "E", ]$degree_label, as.list(c("A", "B", "C")) ) parsed <- vector("list", 3) parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3")) expect_identical( graticule[graticule$type == "N", ]$degree_label, parsed ) # reverse x and y from previous test b <- ggplot_build( plot + scale_y_continuous( breaks = c(1000, 2000, 3000), labels = c("A", "B", "C") ) + scale_x_continuous( breaks = c(1000, 1500, 2000), labels = parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3")) ) ) graticule <- b$layout$panel_params[[1]]$graticule expect_identical( graticule[graticule$type == "N", ]$degree_label, as.list(c("A", "B", "C")) ) parsed <- vector("list", 3) parsed[1:3] <- parse(text = c("10^3", "1.5 %*% 10^3", "2 %*% 10^3")) expect_identical( graticule[graticule$type == "E", ]$degree_label, parsed ) }) test_that("degree labels are automatically parsed", { skip_if_not_installed("sf") data <- sf::st_sfc( sf::st_polygon(list(matrix(1e1*c(1, 2, 3, 1, 1, 3, 2, 1), ncol = 2))), crs = 4326 # basic long-lat crs ) plot <- ggplot(data) + geom_sf() b <- ggplot_build( plot + scale_x_continuous(breaks = c(10, 20, 30)) + scale_y_continuous(breaks = c(10, 15, 20)) ) graticule <- b$layout$panel_params[[1]]$graticule expect_setequal( graticule[graticule$type == "N", ]$degree, c(10, 15, 20) ) expect_setequal( graticule[graticule$type == "E", ]$degree, c(10, 20, 30) ) expect_true(all(vapply(graticule$degree_label, is.language, logical(1)))) }) test_that("Inf is squished to range", { skip_if_not_installed("sf") d <- cdata( ggplot(sf::st_point(c(0, 0))) + geom_sf() + annotate("text", -Inf, Inf, label = "Top-left") ) expect_equal(d[[2]]$x, 0) expect_equal(d[[2]]$y, 1) }) test_that("default crs works", { skip_if_not_installed("sf") polygon <- sf::st_sfc( sf::st_polygon(list(matrix(c(-80, -76, -76, -80, -80, 35, 35, 40, 40, 35), ncol = 2))), crs = 4326 # basic long-lat crs ) polygon <- sf::st_transform(polygon, crs = 3347) points <- data_frame( x = c(-80, -80, -76, -76), y = c(35, 40, 35, 40) ) p <- ggplot(polygon) + geom_sf(fill = NA) expect_snapshot_error(ggplot_build(p + xlim(-Inf, 80))) # by default, regular geoms are interpreted to use projected data points_trans <- sf_transform_xy(points, 3347, 4326) expect_doppelganger( "non-sf geoms using projected coords", p + geom_point(data = points_trans, aes(x, y)) ) # projected sf objects can be mixed with regular geoms using non-projected data expect_doppelganger( "non-sf geoms using long-lat", p + geom_point(data = points, aes(x, y)) + coord_sf(default_crs = 4326) ) # coord limits can be specified in long-lat expect_doppelganger( "limits specified in long-lat", p + geom_point(data = points, aes(x, y)) + coord_sf(xlim = c(-80.5, -76), ylim = c(36, 41), default_crs = 4326) ) # by default limits are specified in projected coords lims <- sf_transform_xy( list(x = c(-80.5, -76, -78.25, -78.25), y = c(38.5, 38.5, 36, 41)), 3347, 4326 ) expect_doppelganger( "limits specified in projected coords", p + geom_point(data = points_trans, aes(x, y)) + coord_sf(xlim = lims$x[1:2], ylim = lims$y[3:4]) ) }) test_that("sf_transform_xy() works", { skip_if_not_installed("sf") data <- list( city = c("Charlotte", "Raleigh", "Greensboro"), x = c(-80.843, -78.639, -79.792), y = c(35.227, 35.772, 36.073) ) # no transformation if one crs is missing out <- sf_transform_xy(data, NULL, 4326) expect_identical(data, out) out <- sf_transform_xy(data, 4326, NULL) expect_identical(data, out) # transform to projected coordinates out <- sf_transform_xy(data, 3347, 4326) expect_identical(data$city, out$city) # columns other than x, y are not changed expect_true(all(abs(out$x - c(7275499, 7474260, 7357835)) < 10)) expect_true(all(abs(out$y - c(-60169, 44384, 57438)) < 10)) # transform back out2 <- sf_transform_xy(out, 4326, 3347) expect_identical(data$city, out2$city) expect_true(all(abs(out2$x - data$x) < .01)) expect_true(all(abs(out2$y - data$y) < .01)) })
Generated by dwww version 1.15 on Wed May 22 22:33:42 CEST 2024.