diff --git a/DESCRIPTION b/DESCRIPTION index 6348d29..51739ed 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,7 +48,8 @@ Suggests: ape, deeptime, palmerpenguins, - maps + maps, + sf Config/testthat/edition: 3 URL: https://rphylopic.palaeoverse.org, https://github.com/palaeoverse-community/rphylopic, diff --git a/R/geom_phylopic.R b/R/geom_phylopic.R index 3e8a58c..e9b10c2 100644 --- a/R/geom_phylopic.R +++ b/R/geom_phylopic.R @@ -232,14 +232,21 @@ GeomPhylopic <- ggproto("GeomPhylopic", Geom, # Calculate height as percentage of y limits # (or r limits for polar coordinates) if ("y.range" %in% names(panel_params)) { - heights <- data$size / diff(panel_params$y.range) + y_diff <- diff(panel_params$y.range) } else if ("y_range" %in% names(panel_params)) { # exclusive to coord_sf - heights <- data$size / diff(panel_params$y_range) + y_diff <- diff(panel_params$y_range) } else if ("r.range" %in% names(panel_params)) { # exclusive to coord_polar - heights <- data$size / diff(panel_params$r.range) + y_diff <- diff(panel_params$r.range) } else { - heights <- data$size + y_diff <- 1 } + if (any(data$size < (y_diff / 1000))) { + warning(paste("Your specified silhouette `size`s are less than 1000 times", + "smaller than your y-axis range. You probably want to", + "use a larger `size`."), call. = FALSE) + } + heights <- data$size / y_diff + # Hack to make silhouettes the full height of the plot heights[is.infinite(heights)] <- 1 diff --git a/tests/testthat/_snaps/geom_phylopic/geom-phylopic-with-sf.svg b/tests/testthat/_snaps/geom_phylopic/geom-phylopic-with-sf.svg new file mode 100644 index 0000000..3693a6d --- /dev/null +++ b/tests/testthat/_snaps/geom_phylopic/geom-phylopic-with-sf.svg @@ -0,0 +1,1726 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +x +y +geom_phylopic with sf + + diff --git a/tests/testthat/test-geom_phylopic.R b/tests/testthat/test-geom_phylopic.R index bbdc250..71aa9e1 100644 --- a/tests/testthat/test-geom_phylopic.R +++ b/tests/testthat/test-geom_phylopic.R @@ -1,4 +1,6 @@ suppressPackageStartupMessages(library(ggplot2, quietly = TRUE)) +suppressPackageStartupMessages(library(sf, quietly = TRUE)) +suppressPackageStartupMessages(library(maps, quietly = TRUE)) test_that("geom_phylopic works", { skip_if_offline(host = "api.phylopic.org") @@ -56,6 +58,27 @@ test_that("geom_phylopic works", { ggplot(df) + geom_phylopic(aes(x = x, y = y), uuid = "asdfghjkl") ))) + + # sf integration + coords <- data.frame(x = c(-95, -30, 30, 95), y = c(-60, -30, 30, 60)) + # Get map data + world1 <- st_wrap_dateline(st_as_sf(map('world', plot = FALSE, fill = TRUE))) + expect_warning( + plot( + ggplot() + + geom_sf(data = world1) + + geom_phylopic(data = coords, aes(x = x, y = y), size = 10, + uuid = "e25f1863-331b-4891-8084-fe8602e4cf8d") + + coord_sf(crs = "ESRI:54009", default_crs = st_crs(4326)) + ) + ) + try(dev.off(), silent = TRUE) + gg <- ggplot() + + geom_sf(data = world1) + + geom_phylopic(data = coords, aes(x = x, y = y), size = 1000000, + uuid = "e25f1863-331b-4891-8084-fe8602e4cf8d") + + coord_sf(crs = "ESRI:54009", default_crs = st_crs(4326)) + expect_doppelganger("geom_phylopic with sf", gg) }) test_that("phylopic_key_glyph works", {