Merge pull request #131 from ropensci/marianne-geom-vline

Support geom_vline() conversion

Author: mkcor

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: plotly
 Type: Package
 Title: Interactive, publication-quality graphs online.
-Version: 0.5.3
+Version: 0.5.4
 Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"),
     email = "[email protected]"),
     person("Scott", "Chamberlain", role = "aut",

NEWS

@@ -1,3 +1,7 @@
+0.5.4 -- 22 October 2014.
+
+Support conversion of geom_vline().
+
 0.5.3 -- 21 October 2014.
 
 Support conversion of geom_bar() with position_dodge().

R/ggplotly.R

@@ -98,6 +98,10 @@ gg2list <- function(p){
   xrange <- sapply(ggranges, `[[`, "x.range", simplify=FALSE, USE.NAMES=FALSE)
   ggxmin <- min(sapply(xrange, min))
   ggxmax <- max(sapply(xrange, max))
+  # Extract y.range
+  yrange <- sapply(ggranges, `[[`, "y.range", simplify=FALSE, USE.NAMES=FALSE)
+  ggymin <- min(sapply(yrange, min))
+  ggymax <- max(sapply(yrange, max))
 
   # Get global size range because we need some of its info in layer2traces
   if ("size.name" %in% name.names) {
@@ -168,6 +172,9 @@ gg2list <- function(p){
     # Add global x-range info
     misc$prestats.data$globxmin <- ggxmin
     misc$prestats.data$globxmax <- ggxmax
+    # Add global y-range info
+    misc$prestats.data$globymin <- ggymin
+    misc$prestats.data$globymax <- ggymax
 
     # Add global size info if relevant
     if ("size.name" %in% name.names) {

R/trace_generation.R

@@ -121,7 +121,7 @@ layer2traces <- function(l, d, misc) {
   }
   ## Then split on visual characteristics that will get different
   ## legend entries.
-  data.list <- if(basic$geom %in% names(markLegends)){
+  data.list <- if (basic$geom %in% names(markLegends)) {
     mark.names <- markLegends[[basic$geom]]
     ## However, continuously colored points are an exception: they do
     ## not need a legend entry, and they can be efficiently rendered
@@ -152,11 +152,24 @@ layer2traces <- function(l, d, misc) {
     }
   }
 
+  # Split hline and vline when multiple
+  if (g$geom == "hline" || g$geom == "vline") {
+    if (nrow(g$data) > 1) {
+      df.list <- split(basic$data, rep(1:nrow(g$data)))
+      data.list <- lapply(df.list, function(df) {
+        params <- basic$params
+        list(data=df,
+             params=params)
+      })
+    }
+  }
+  
   ## case of no legend, if either of the two ifs above failed.
   if(is.null(data.list)){
     data.list <- structure(list(list(data=basic$data, params=basic$params)),
                            names=basic$params$name)
   }
+  
   getTrace <- geom2trace[[basic$geom]]
   if(is.null(getTrace)){
     warning("Conversion not implemented for geom_",
@@ -167,7 +180,8 @@ layer2traces <- function(l, d, misc) {
   }
   traces <- NULL
   names.in.legend <- NULL
-  for(data.i in seq_along(data.list)){
+  
+  for (data.i in seq_along(data.list)) {
     data.params <- data.list[[data.i]]
     data.params$params$stat.type <- l$stat$objname
     tr <- do.call(getTrace, data.params)
@@ -303,6 +317,11 @@ toBasic <- list(
     g$params$xend <- max(g$prestats.data$globxmax)
     g
   },
+  vline=function(g) {
+    g$params$ystart <- min(g$prestats.data$globymin)
+    g$params$yend <- max(g$prestats.data$globymax)
+    g
+  },
   point=function(g) {
     if ("size" %in% names(g$data)) {
       g$params$sizemin <- min(g$prestats.data$globsizemin)
@@ -527,5 +546,13 @@ geom2trace <- list(
          type="scatter",
          mode="lines",
          line=paramORdefault(params, aes2line, line.defaults))
+  },
+  vline=function(data, params) {
+    list(x=c(data$xintercept, data$xintercept),
+         y=c(params$ystart, params$yend),
+         name=params$name,
+         type="scatter",
+         mode="lines",
+         line=paramORdefault(params, aes2line, line.defaults))
   }
 )

tests/testthat/test-ggplot-hline.R

@@ -1,19 +1,18 @@
 context("Hline")
-
 # Horizontal line
 
-test_that("Second trace be the hline", {
-  
-  x1 <- seq(from=0, to=3.5, by=0.5)
-  x2 <- x1 * 0.95
-  df <- data.frame("x1"=x1, "x2"=x2)
-  
-  gg <- ggplot(df) + geom_point(aes(x=x1, y=x2)) +
-    geom_hline(yintercept=1.1, colour="green", size=3)
+x1 <- seq(from=0, to=3.5, by=0.5)
+x2 <- x1 * 0.95
+df <- data.frame("x1"=x1, "x2"=x2)
+gg <- ggplot(df) + geom_point(aes(x=x1, y=x2))
+
+test_that("second trace be the hline", {
+  gg <- gg + geom_hline(yintercept=1.1, colour="green", size=3)
 
   L <- gg2list(gg)
 
   expect_equal(length(L), 3)
+  expect_equal(L[[2]]$y[1], 1.1)
   expect_true(L[[2]]$x[1] <= 0)
   expect_true(L[[2]]$x[2] >= 3.5)
   expect_identical(L[[2]]$mode, "lines")
@@ -22,4 +21,23 @@ test_that("Second trace be the hline", {
   expect_identical(L[[2]]$line$color, "rgb(0,255,0)")
 
   save_outputs(gg, "hline")
-})
+})
+
+test_that("vector yintercept results in multiple horizontal lines", {
+  gg <- gg + geom_hline(yintercept=1:3, colour="red", size=3)
+  
+  L <- gg2list(gg)
+  
+  expect_equal(length(L), 5)
+  expect_equal(L[[2]]$y[1], 1)
+  expect_equal(L[[3]]$y[1], 2)
+  expect_equal(L[[4]]$y[1], 3)
+  expect_true(L[[4]]$x[1] <= 0)
+  expect_true(L[[4]]$x[2] >= 3.325)
+  expect_identical(L[[3]]$mode, "lines")
+  expect_identical(L[[3]]$line$shape, "linear")
+  expect_equal(L[[3]]$line$width, 3)
+  expect_identical(L[[3]]$line$color, "rgb(255,0,0)")
+  
+  save_outputs(gg, "hline-multiple")
+})

tests/testthat/test-ggplot-vline.R

@@ -0,0 +1,42 @@
+context("Vline")
+# Vertical line
+
+x1 <- seq(from=0, to=3.5, by=0.5)
+x2 <- x1 * 0.95
+df <- data.frame("x1"=x1, "x2"=x2)
+gg <- ggplot(df) + geom_point(aes(x=x1, y=x2))
+
+test_that("second trace be the vline", {
+  gg <- gg + geom_vline(xintercept=1.1, colour="green", size=3)
+  
+  L <- gg2list(gg)
+  
+  expect_equal(length(L), 3)
+  expect_equal(L[[2]]$x[1], 1.1)
+  expect_true(L[[2]]$y[1] <= 0)
+  expect_true(L[[2]]$y[2] >= 3.325)
+  expect_identical(L[[2]]$mode, "lines")
+  expect_identical(L[[2]]$line$shape, "linear")
+  expect_equal(L[[2]]$line$width, 3)
+  expect_identical(L[[2]]$line$color, "rgb(0,255,0)")
+  
+  save_outputs(gg, "vline")
+})
+
+test_that("vector xintercept results in multiple vertical lines", {
+  gg <- gg + geom_vline(xintercept=1:2, colour="blue", size=3)
+  
+  L <- gg2list(gg)
+  
+  expect_equal(length(L), 4)
+  expect_equal(L[[2]]$x[1], 1)
+  expect_equal(L[[3]]$x[1], 2)
+  expect_true(L[[3]]$y[1] <= 0)
+  expect_true(L[[3]]$y[2] >= 3.325)
+  expect_identical(L[[3]]$mode, "lines")
+  expect_identical(L[[3]]$line$shape, "linear")
+  expect_equal(L[[3]]$line$width, 3)
+  expect_identical(L[[3]]$line$color, "rgb(0,0,255)")
+  
+  save_outputs(gg, "vline-multiple")
+})