From f6f21054275131fdefb2ff43795192f3420458e3 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 15 May 2015 16:21:35 -0400 Subject: [PATCH 01/10] fixed problem with equal axes --- R/ggplotly.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/ggplotly.R b/R/ggplotly.R index 13c80ddf30..e15866feef 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -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"] <- From 86fbec58685d119aa358d1cb1d38fb7bb36a58ee Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 15 May 2015 21:37:32 -0400 Subject: [PATCH 02/10] add testthat test for my new features --- tests/testthat/test-ggplot-coord.R | 52 ++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 tests/testthat/test-ggplot-coord.R diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R new file mode 100644 index 0000000000..4530390188 --- /dev/null +++ b/tests/testthat/test-ggplot-coord.R @@ -0,0 +1,52 @@ +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 + built <- ggplot_build2(p) + 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]) + expect_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) +}) + +# 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 + built <- ggplot_build2(p) + 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]) + expect_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) +}) \ No newline at end of file From 31a1ef6ce070406c0a854c3a5fbf5a5f93f36ce6 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Tue, 19 May 2015 14:24:50 -0400 Subject: [PATCH 03/10] fixed the expect_traces function --- tests/testthat/test-ggplot-coord.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 4530390188..d430a66b6c 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -3,7 +3,7 @@ context("Fixed coordinates") # Expect trace function expect_traces <- function(gg, n_traces, name) { stopifnot(is.ggplot(gg)) - stopifnot(is.numeric(n.traces)) + stopifnot(is.numeric(n_traces)) save_outputs(gg, paste0("coord_fixed-", name)) L <- gg2list(gg) all_traces <- L$data From ba738b95a9c058fd23fd5db3b1e1cbe51ec6237b Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Tue, 19 May 2015 17:23:53 -0400 Subject: [PATCH 04/10] add space to the end of test --- tests/testthat/test-ggplot-coord.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index d430a66b6c..3229263ac2 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -49,4 +49,4 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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]) expect_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) -}) \ No newline at end of file +}) From 79257be14d48b2108fba4e09b2d8ce550740c404 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 22 May 2015 16:35:32 -0400 Subject: [PATCH 05/10] coordinate fixed range from data --- R/ggplotly.R | 6 +++--- tests/testthat/test-ggplot-coord.R | 9 ++++----- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index e15866feef..a5158450c6 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") @@ -772,8 +772,8 @@ gg2list <- function(p) { # 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) + x_range <- range(p$data[[as.character(layer.aes$x.name)]], na.rm = TRUE) + y_range <- range(p$data[[as.character(layer.aes$y.name)]], na.rm = TRUE) yx_ratio <- (y_range[2] - y_range[1]) / (x_range[2] - x_range[1]) if (yx_ratio > 1) { layout$height <- 600 diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 3229263ac2..3f3fc4c362 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -28,9 +28,8 @@ test_that("coord_fixed() is translated to the right height-width ratio", { la <- info$layout expect_identical(tr$type, "scatter") # height-width ratio check - built <- ggplot_build2(p) - 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) + 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_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) }) @@ -45,8 +44,8 @@ test_that("coord_fixed() is translated to the right height-width ratio", { expect_identical(tr$type, "scatter") # height-width ratio check built <- ggplot_build2(p) - 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) + 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_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) }) From 2dc1453e3f93e2d6b08dfb3cceeeae40a2592a27 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 22 May 2015 17:36:20 -0400 Subject: [PATCH 06/10] delete an extra line in test --- tests/testthat/test-ggplot-coord.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 3f3fc4c362..24f09278c0 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -43,7 +43,6 @@ test_that("coord_fixed() is translated to the right height-width ratio", { la <- info$layout expect_identical(tr$type, "scatter") # height-width ratio check - built <- ggplot_build2(p) 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]) From 5d9deca02f1e9b00752d6c904dd9b05c116c9468 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 29 May 2015 06:20:43 -0700 Subject: [PATCH 07/10] made test different from ggplotly --- R/ggplotly.R | 4 ++-- tests/testthat/test-ggplot-coord.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index a5158450c6..cc73f6b8db 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -772,8 +772,8 @@ gg2list <- function(p) { # 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(p$data[[as.character(layer.aes$x.name)]], na.rm = TRUE) - y_range <- range(p$data[[as.character(layer.aes$y.name)]], na.rm = TRUE) + 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 diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 24f09278c0..adb42ab9c5 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -31,7 +31,7 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) + expect_identical(la$height/la$width, round(yx_ratio) * p$coordinates$ratio) }) # Equal scaling, with each 1 on the x axis the same length as y on x axis @@ -46,5 +46,5 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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_identical(la$height/la$width, yx_ratio * p$coordinates$ratio) + expect_identical(la$height/la$width, round(yx_ratio) * p$coordinates$ratio) }) From b969deebb0565a1c19e533f93b5530e1901c9083 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Fri, 29 May 2015 18:10:55 -0700 Subject: [PATCH 08/10] test expect_equal with tolerance --- tests/testthat/test-ggplot-coord.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index adb42ab9c5..33df25a0b0 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -31,7 +31,7 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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_identical(la$height/la$width, round(yx_ratio) * p$coordinates$ratio) + 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 @@ -46,5 +46,5 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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_identical(la$height/la$width, round(yx_ratio) * p$coordinates$ratio) + expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, 0.25) }) From af4fd333010bb56e830310ab720b54b53ce258bc Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Mon, 1 Jun 2015 22:14:23 -0700 Subject: [PATCH 09/10] added parameter name, made tolerance smaller --- tests/testthat/test-ggplot-coord.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 33df25a0b0..0c5b29e62a 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -31,7 +31,7 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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) + 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 @@ -46,5 +46,5 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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) + expect_equal(la$height/la$width, yx_ratio * p$coordinates$ratio, tolerance = 0.10) }) From 0a85c90ef3b2ef9d5a40931e438e5a43ad5b011b Mon Sep 17 00:00:00 2001 From: cpsievert Date: Fri, 11 Dec 2015 20:02:36 -0600 Subject: [PATCH 10/10] avoid using random data --- tests/testthat/test-ggplot-coord.R | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-ggplot-coord.R b/tests/testthat/test-ggplot-coord.R index 0c5b29e62a..96469aa8f2 100644 --- a/tests/testthat/test-ggplot-coord.R +++ b/tests/testthat/test-ggplot-coord.R @@ -15,12 +15,8 @@ expect_traces <- function(gg, n_traces, name) { 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() +p <- ggplot(mtcars, aes(mpg, qsec)) + 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") @@ -28,14 +24,14 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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) + x_range <- range(p$data$mpg, na.rm = TRUE) + y_range <- range(p$data$qsec, 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) +p <- ggplot(dat, aes(mpg, qsec)) + 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") @@ -43,8 +39,8 @@ test_that("coord_fixed() is translated to the right height-width ratio", { 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) + x_range <- range(p$data$mpg, na.rm = TRUE) + y_range <- range(p$data$qsec, 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) })