Skip to content

Commit 357c7c3

Browse files
committed
Merge af4fd33 into fb40491
2 parents fb40491 + af4fd33 commit 357c7c3

File tree

2 files changed

+67
-1
lines changed

2 files changed

+67
-1
lines changed

R/ggplotly.R

+17-1
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ gg2list <- function(p) {
167167
range.values <- if(use.ranges){
168168
range.name <- paste0(xy, ".range")
169169
sapply(built$panel$ranges, "[[", range.name)
170-
}else{
170+
} else{
171171
## for categorical variables on the axes, panel$ranges info is
172172
## meaningless.
173173
name.name <- paste0(xy, ".name")
@@ -768,6 +768,22 @@ gg2list <- function(p) {
768768
stop("No exportable traces")
769769
}
770770

771+
# fixed coordinates: if the coordinates ratio is not NULL, then
772+
# we make the size of the plot according to the specified ratio
773+
# note: we set the biggest dimension to 600
774+
if (!is.null(p$coordinates$ratio)) {
775+
x_range <- range(built[[2]]$ranges[[1]]$x.major_source, na.rm = TRUE)
776+
y_range <- range(built[[2]]$ranges[[1]]$y.major_source, na.rm = TRUE)
777+
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
778+
if (yx_ratio > 1) {
779+
layout$height <- 600
780+
layout$width <- layout$height * (1 / p$coordinates$ratio) * (1 / yx_ratio)
781+
} else {
782+
layout$width <- 600
783+
layout$height <- layout$height * (1 / p$coordinates$ratio) * yx_ratio
784+
}
785+
}
786+
771787
mode.mat <- matrix(NA, 3, 3)
772788
rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none")
773789
mode.mat["markers", "lines"] <-

tests/testthat/test-ggplot-coord.R

+50
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
context("Fixed coordinates")
2+
3+
# Expect trace function
4+
expect_traces <- function(gg, n_traces, name) {
5+
stopifnot(is.ggplot(gg))
6+
stopifnot(is.numeric(n_traces))
7+
save_outputs(gg, paste0("coord_fixed-", name))
8+
L <- gg2list(gg)
9+
all_traces <- L$data
10+
no_data <- sapply(all_traces, function(tr) {
11+
is.null(tr[["x"]]) && is.null(tr[["y"]])
12+
})
13+
has_data <- all_traces[!no_data]
14+
expect_equal(length(has_data), n_traces)
15+
list(traces = has_data, layout = L$layout)
16+
}
17+
18+
# Data where x ranges from 0-10, y ranges from 0-30
19+
set.seed(202)
20+
dat <- data.frame(xval = runif(40,0,10), yval = runif(40,0,30))
21+
22+
# Force equal scaling
23+
p <- ggplot(dat, aes(xval, yval)) + geom_point() + coord_fixed()
24+
# Test
25+
test_that("coord_fixed() is translated to the right height-width ratio", {
26+
info <- expect_traces(p, 1, "force_equal_scaling")
27+
tr <- info$traces[[1]]
28+
la <- info$layout
29+
expect_identical(tr$type, "scatter")
30+
# height-width ratio check
31+
x_range <- range(p$data$xval, na.rm = TRUE)
32+
y_range <- range(p$data$yval, na.rm = TRUE)
33+
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
34+
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
35+
})
36+
37+
# Equal scaling, with each 1 on the x axis the same length as y on x axis
38+
p <- ggplot(dat, aes(xval, yval)) + geom_point() + coord_fixed(1/3)
39+
# Test
40+
test_that("coord_fixed() is translated to the right height-width ratio", {
41+
info <- expect_traces(p, 1, "force_equal_scaling")
42+
tr <- info$traces[[1]]
43+
la <- info$layout
44+
expect_identical(tr$type, "scatter")
45+
# height-width ratio check
46+
x_range <- range(p$data$xval, na.rm = TRUE)
47+
y_range <- range(p$data$yval, na.rm = TRUE)
48+
yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1])
49+
expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10)
50+
})

0 commit comments

Comments
 (0)