tests/testthat/test-coord_sf.R

In tidyverse/ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics

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))

})

test_that("coord_sf() uses the guide system", {
  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)

  p <- ggplot(polygon) + geom_sf(fill = NA) +
    coord_sf(label_graticule = "NSWE") + # All of the labels
    scale_x_continuous(guide = guide_none("guide_none() with title")) +
    scale_y_continuous(guide = guide_axis(angle = 45),
                       name = "title from scale") +
    guides(
      x.sec = guide_axis(angle = -45),
      y.sec = guide_axis(n.dodge = 2, title = "Secondary guide via `guides()`")
    )

  expect_doppelganger(
    "coord_sf() with custom guides",
    p
  )
})

test_that("coord_sf() throws error when limits are badly specified", {
  skip_if_not_installed("sf")
  # throws error when limit is a Scale object instead of vector
  expect_snapshot_error(ggplot() + coord_sf(xlim(1,1)))

  # throws error when limit's length is different than two
  expect_snapshot_error(ggplot() + coord_sf(ylim=1:3))
})