Skip to content

fixed problem with equal axes #223

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.

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

Closed
wants to merge 14 commits into from
Closed
18 changes: 17 additions & 1 deletion R/ggplotly.R
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,7 @@ gg2list <- function(p) {
range.values <- if(use.ranges){
range.name <- paste0(xy, ".range")
sapply(built$panel$ranges, "[[", range.name)
}else{
} else{
## for categorical variables on the axes, panel$ranges info is
## meaningless.
name.name <- paste0(xy, ".name")
Expand Down Expand Up @@ -829,6 +829,22 @@ gg2list <- function(p) {
stop("No exportable traces")
}

# fixed coordinates: if the coordinates ratio is not NULL, then
# we make the size of the plot according to the specified ratio
# note: we set the biggest dimension to 600
if (!is.null(p$coordinates$ratio)) {
x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
if (yx_ratio > 1) {
layout$height <- 600
layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio)
} else {
layout$width <- 600
layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio
}
Copy link
Collaborator

Choose a reason for hiding this comment

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

Hard-coding the height/width is going to make for unpleasant htmlwidget experience. I think the best way to do it is pass this ratio to the HTMLwidget.resize method and impose the ratio on the height/width there. We should also provide a way to specify this ratio for non-ggplots

}

mode.mat <- matrix(NA, 3, 3)
rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
mode.mat["markers", "lines"] <-
Expand Down
50 changes: 50 additions & 0 deletions tests/testthat/test-ggplot-coord.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
context("Fixed coordinates")

# Expect trace function
expect_traces <- function(gg, n_traces, name) {
stopifnot(is.ggplot(gg))
stopifnot(is.numeric(n_traces))
save_outputs(gg, paste0("coord_fixed-", name))
L <- gg2list(gg)
all_traces <- L$data
no_data <- sapply(all_traces, function(tr) {
is.null(tr[["x"]]) && is.null(tr[["y"]])
})
has_data <- all_traces[!no_data]
expect_equal(length(has_data), n_traces)
list(traces = has_data, layout = L$layout)
}

# Data where x ranges from 0-10, y ranges from 0-30
set.seed(202)
dat <- data.frame(xval = runif(40,0,10), yval = runif(40,0,30))
Copy link
Contributor

Choose a reason for hiding this comment

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

I remember that we decided not to use randomized data in our test suite, so that the image diff's remain meaningful. But I may have totally missed a discussion on the topic in the meantime... If so, please let me know.

Copy link
Member

Choose a reason for hiding this comment

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

yeah, that is still correct. I recommend just copying and pasting the results of the random data into the test :)

Copy link
Contributor

Choose a reason for hiding this comment

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

Good. An example of this practice can be found in this test: https://github.com/ropensci/plotly/blob/master/tests/testthat/test-plotly-filename.R

Copy link
Collaborator

Choose a reason for hiding this comment

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

I'm pretty sure set.seed() ensures we have the same set of numbers, so image diffs should be meaningful. That being said, I prefer setting the seed over copy/pasting numbers (I think it makes the tests easier to read).

Even better, use a built-in dataset such as mtcars, cars, iris, diamonds, etc.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

Yes. set.seed() ensures we get the same data each time. I second Carson's point. I used the set.seed with the same seed as used in the R Cookbook. But I can use one of the datasets that come with R if it's preferred.

Gotta go to graduation now! Will be back shortly.

Copy link
Contributor

Choose a reason for hiding this comment

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

Thanks, @cpsievert and @13bzhang ! I have learned something today. :)
I agree, set.seed(1); runif(100) is definitely easier to read (and diff) than a sequence of 100 numbers...

Copy link
Contributor Author

Choose a reason for hiding this comment

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

@mkcor : Does that mean we can keep set.seed(22) as it was written in the codebook?

Copy link
Contributor

Choose a reason for hiding this comment

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

Yes, all good!


# Force equal scaling
p <- ggplot(dat, aes(xval, yval)) + geom_point() + coord_fixed()
# Test
test_that("coord_fixed() is translated to the right height-width ratio", {
info <- expect_traces(p, 1, "force_equal_scaling")
tr <- info$traces[[1]]
la <- info$layout
expect_identical(tr$type, "scatter")
# height-width ratio check
x_range <- range(p$data$xval, na.rm = TRUE)
y_range <- range(p$data$yval, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})

# Equal scaling, with each 1 on the x axis the same length as y on x axis
p <- ggplot(dat, aes(xval, yval)) + geom_point() + coord_fixed(1/3)
# Test
test_that("coord_fixed() is translated to the right height-width ratio", {
info <- expect_traces(p, 1, "force_equal_scaling")
tr <- info$traces[[1]]
la <- info$layout
expect_identical(tr$type, "scatter")
# height-width ratio check
x_range <- range(p$data$xval, na.rm = TRUE)
y_range <- range(p$data$yval, na.rm = TRUE)
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
})