diff --git a/R/ggplotly.R b/R/ggplotly.R index 13c80ddf30..cc73f6b8db 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -167,7 +167,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") @@ -768,6 +768,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 + } + } + mode.mat <- matrix(NA, 3, 3) rownames(mode.mat) <- colnames(mode.mat) <- c("markers", "lines", "none") mode.mat["markers", "lines"] <- diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R new file mode 100644 index 0000000000..33df25a0b0 --- /dev/null +++ b/tests/testthat/test-ggplot-coord.R @@ -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)) + +# 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, 0.25) +}) + +# 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, 0.25) +})