Skip to content

fix stat_contour() for irregular data grids. #3907

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Mar 22, 2020
Merged

fix stat_contour() for irregular data grids. #3907

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7abe967
fix stat_contour() for irregular data grids. closes #3906.
clauswilke Mar 22, 2020
164e7d1
fix test
clauswilke Mar 22, 2020
3d4b3a7
additional unit test
clauswilke Mar 22, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 5 additions & 5 deletions R/stat-contour.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -206,14 +206,14 @@ xyz_to_isobands <- function(data, breaks) {
#'
isoband_z_matrix <- function(data) {
# Convert vector of data to raster
x_pos <- as.integer((data$x - min(data$x)) / resolution(data$x, FALSE))
y_pos <- as.integer((max(data$y) - data$y) / resolution(data$y, FALSE))
x_pos <- as.integer(factor(data$x, levels = sort(unique(data$x))))
y_pos <- as.integer(factor(data$y, levels = sort(unique(data$y))))

nrow <- max(y_pos) + 1
ncol <- max(x_pos) + 1
nrow <- max(y_pos)
ncol <- max(x_pos)

raster <- matrix(NA_real_, nrow = nrow, ncol = ncol)
raster[cbind(nrow - y_pos, x_pos + 1)] <- data$z
raster[cbind(y_pos, x_pos)] <- data$z

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This looks great! I wrote this based on the code in GeomRaster because it was faster...before it was:

raster <- tapply(data$z, data[c("x", "y")], identity)

(I found that here in case you want to look at the context)

It might be worth checking whether that is faster (I suspect your way is better)

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

tapply() is ~40% slower.

As an aside, we're doing a lot of work wrangling the data into the right format for isoband and then back out. It'd probably be more efficient to just write an isoband function that takes the data in the format preferred by ggplot2 and returns it in a format that can be used directly. But that's for another day.

raster
}
Expand Down
21 changes: 20 additions & 1 deletion tests/testthat/test-stat-contour.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,26 @@ test_that("a warning is issued when there is more than one z per x+y", {
test_that("contouring sparse data results in a warning", {
tbl <- data_frame(x = c(1, 27, 32), y = c(1, 1, 30), z = c(1, 2, 3))
p <- ggplot(tbl, aes(x, y, z = z)) + geom_contour()
expect_warning(ggplot_build(p), "Number of x coordinates must match")
expect_warning(ggplot_build(p), "Zero contours were generated")
})

test_that("contouring irregularly spaced data works", {
tbl <- expand.grid(x = c(1, 10, 100, 1000), y = 1:3)
tbl$z <- 1
tbl[c(6, 7), ]$z <- 10
p <- ggplot(tbl, aes(x, y, z = z)) + geom_contour(breaks = c(4, 8))

# we're testing for set equality here because contour lines are not
# guaranteed to start and end at the same point on all architectures
d <- layer_data(p)
d4 <- d[d$level == 4,]
expect_equal(nrow(d4), 7)
expect_setequal(d4$x, c(4, 10, 100, 700))
expect_setequal(d4$y, c(2, 8/3, 4/3))
d8 <- d[d$level == 8,]
expect_equal(nrow(d8), 7)
expect_setequal(d8$x, c(8, 10, 100, 300))
expect_setequal(d8$y, c(2, 20/9, 16/9))
})

test_that("contour breaks can be set manually and by bins and binwidth", {
Expand Down