From 9de0a922c4dd65956a169a4facd5e8e14b91f854 Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Fri, 30 May 2014 11:25:49 -0400 Subject: [PATCH 1/9] Implement conversion that works in a simple case --- R/ggplotly.R | 40 +++++++++++++++++++++++++++++++++------- 1 file changed, 33 insertions(+), 7 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 48156fc029..5ebfad174e 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -128,7 +128,16 @@ toBasic <- },line=function(g){ g$data <- g$data[order(g$data$x),] group2NA(g, "path") - },ribbon=function(g){ + }, + histogram=function(g) { + xdim <- g$aes + x1 <- xdim[["x"]] + g$data <- NULL + g$data$x <- g$plot[[x1]] + g$plot <- NULL + g + }, + ribbon=function(g){ stop("TODO") }) @@ -182,6 +191,13 @@ geom2trace <- type="scatter", mode="lines", line=paramORdefault(params, aes2line, line.defaults)) + }, + histogram=function(data, params) { + list(x=data$x, + xbins=list(size=params$binwidth), + name=params$name, + text=data$text, + type="histogram") } ) @@ -197,7 +213,8 @@ markLegends <- path=c("linetype", "size", "colour"), polygon=c("colour", "fill", "linetype", "size", "group"), bar=c("fill"), - step=c("linetype", "size", "colour")) + step=c("linetype", "size", "colour"), + histogram=c("colour")) markUnique <- as.character(unique(unlist(markLegends))) @@ -242,6 +259,7 @@ gg2list <- function(p){ geom_type <- p$layers[[layer.i]]$geom geom_type <- strsplit(capture.output(geom_type), "geom_")[[1]][2] geom_type <- strsplit(geom_type, ": ")[[1]] + ## Barmode. layout$barmode <- "group" if (geom_type == "bar") { @@ -260,6 +278,12 @@ gg2list <- function(p){ ## Extract data from built ggplots built <- ggplot2::ggplot_build(p) + + if (geom_type == "histogram") { # or "bar" with stat_bin + # Need actual data (distribution) + trace.list$plot <- built$plot$data + } + ranges <- built$panel$ranges[[1]] for(i in seq_along(built$plot$layers)){ ## This is the layer from the original ggplot object. @@ -306,7 +330,7 @@ gg2list <- function(p){ } ## This extracts essential info for this geom/layer. - traces <- layer2traces(L, df, misc) + traces <- layer2traces(L, df, misc, trace.list$plot) ## Do we really need to coord_transform? ##g$data <- ggplot2:::coord_transform(built$plot$coord, g$data, @@ -412,6 +436,7 @@ gg2list <- function(p){ if(length(trace.list) == 1){ stop("No exportable traces") } + trace.list$plot <- NULL trace.list } @@ -421,9 +446,10 @@ gg2list <- function(p){ #' @param misc named list. #' @return list representing a layer, with corresponding aesthetics, ranges, and groups. #' @export -layer2traces <- function(l, d, misc){ +layer2traces <- function(l, d, misc, plot=NULL){ g <- list(geom=l$geom$objname, - data=d) + data=d, + plot=plot) ## needed for when group, etc. is an expression. g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k))) @@ -532,9 +558,9 @@ layer2traces <- function(l, d, misc){ for(data.i in seq_along(data.list)){ data.params <- data.list[[data.i]] tr <- do.call(getTrace, data.params) - for(v.name in c("x", "y")){ + for (v.name in c("x", "y")) { vals <- tr[[v.name]] - if(is.na(vals[length(vals)])){ + if (length(vals) > 0 && is.na(vals[length(vals)])) { tr[[v.name]] <- vals[-length(vals)] } } From bcdd08aba44b5a477b2bd08c6b101268374d89ef Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Fri, 13 Jun 2014 13:26:48 -0400 Subject: [PATCH 2/9] Overwrite default xbins values --- R/ggplotly.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 5ebfad174e..b99a66fe9f 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -130,11 +130,15 @@ toBasic <- group2NA(g, "path") }, histogram=function(g) { + bin_start <- min(g$data$xmin) + bin_end <- max(g$data$xmax) xdim <- g$aes x1 <- xdim[["x"]] g$data <- NULL g$data$x <- g$plot[[x1]] g$plot <- NULL + g$params$xstart <- bin_start + g$params$xend <- bin_end g }, ribbon=function(g){ @@ -194,10 +198,13 @@ geom2trace <- }, histogram=function(data, params) { list(x=data$x, - xbins=list(size=params$binwidth), + xbins=list(start=params$xstart, + end=params$xend, + size=params$binwidth), name=params$name, text=data$text, - type="histogram") + type="histogram", + autobinx=FALSE) } ) From 4374f587abbb67b5b1c69631ea3ac3f4cc952c69 Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Fri, 13 Jun 2014 16:11:29 -0400 Subject: [PATCH 3/9] Include support for geom_bar and for non-numeric data --- R/ggplotly.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index b99a66fe9f..29caf3d6fb 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -269,11 +269,11 @@ gg2list <- function(p){ ## Barmode. layout$barmode <- "group" - if (geom_type == "bar") { + if (geom_type == "bar" || geom_type == "histogram") { stat_type <- capture.output(p$layers[[layer.i]]$stat) stat_type <- strsplit(stat_type, ": ")[[1]] - if (!grepl("identity", stat_type)) { - stop("Conversion not implemented for ", stat_type) + if (grepl("bin", stat_type)) { + geom_type <- "histogram" } pos <- capture.output(p$layers[[layer.i]]$position) if (grepl("identity", pos)) { @@ -286,7 +286,7 @@ gg2list <- function(p){ ## Extract data from built ggplots built <- ggplot2::ggplot_build(p) - if (geom_type == "histogram") { # or "bar" with stat_bin + if (geom_type == "histogram") { # Need actual data (distribution) trace.list$plot <- built$plot$data } @@ -471,6 +471,10 @@ layer2traces <- function(l, d, misc, plot=NULL){ data.vec <- l$data[[col.name]] if(inherits(data.vec, "POSIXt")){ data.vec <- strftime(data.vec, "%Y-%m-%d %H:%M:%S") + } else if (inherits(data.vec, "factor")) { + ## Re-order data so that Plotly gets it right from ggplot2. + g$data <- g$data[order(g$data[[a]]),] + data.vec <- data.vec[match(g$data[[a]], as.numeric(data.vec))] } g$data[[a]] <- data.vec } From f8f44206094f0a4699f70e2133e13bdb97fbd1ce Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Fri, 13 Jun 2014 16:31:28 -0400 Subject: [PATCH 4/9] Add basic tests for histograms --- R/ggplotly.R | 1 + tests/testthat/test-ggplot-histogram.R | 25 +++++++++++++++++++++++++ 2 files changed, 26 insertions(+) create mode 100644 tests/testthat/test-ggplot-histogram.R diff --git a/R/ggplotly.R b/R/ggplotly.R index 29caf3d6fb..37c857a075 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -274,6 +274,7 @@ gg2list <- function(p){ stat_type <- strsplit(stat_type, ": ")[[1]] if (grepl("bin", stat_type)) { geom_type <- "histogram" + warning("You may want to use geom_histogram.") } pos <- capture.output(p$layers[[layer.i]]$position) if (grepl("identity", pos)) { diff --git a/tests/testthat/test-ggplot-histogram.R b/tests/testthat/test-ggplot-histogram.R new file mode 100644 index 0000000000..6763b03cbf --- /dev/null +++ b/tests/testthat/test-ggplot-histogram.R @@ -0,0 +1,25 @@ +context("Histogram") + +# Non-numeric data +noram <- data.frame(country=c("MEX", "CDN", "USA", "CDN", "MEX", "MEX")) + +test_that("default position is translated to barmode=stack", { + hist <- ggplot(noram, aes(country)) + geom_bar() + L <- gg2list(hist) + expect_equal(length(L), 2) + expect_identical(L$kwargs$layout$barmode, "stack") +}) + +# Numeric data +x <- rnorm(50) +df <- data.frame(index=seq(1:length(x)), x=x) +# Binwidth +bw <- 0.8 +gg <- ggplot(df, aes(x)) + +test_that("binwidth is translated into xbins.size", { + hist <- gg + geom_histogram(binwidth=bw) + L <- gg2list(hist) + expect_equal(length(L), 2) + expect_equal(L[[1]]$xbins$size, bw) +}) From b953fe7e6edf3411a0e41cfc01d0c4c47c4063cf Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Fri, 13 Jun 2014 17:52:53 -0400 Subject: [PATCH 5/9] Skip confusing step in retrieving x dimension --- R/ggplotly.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 37c857a075..5a680faf32 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -132,10 +132,9 @@ toBasic <- histogram=function(g) { bin_start <- min(g$data$xmin) bin_end <- max(g$data$xmax) - xdim <- g$aes - x1 <- xdim[["x"]] + xdim <- g$aes[["x"]] g$data <- NULL - g$data$x <- g$plot[[x1]] + g$data$x <- g$plot[[xdim]] g$plot <- NULL g$params$xstart <- bin_start g$params$xend <- bin_end From 94635ca64c3c5719fd1a49389a08f3a9b00ed05d Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Mon, 16 Jun 2014 14:18:16 -0400 Subject: [PATCH 6/9] Default to autobinx True when binwidth not available (non-numeric data) --- R/ggplotly.R | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 5a680faf32..06d0c93c03 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -196,14 +196,20 @@ geom2trace <- line=paramORdefault(params, aes2line, line.defaults)) }, histogram=function(data, params) { - list(x=data$x, - xbins=list(start=params$xstart, - end=params$xend, - size=params$binwidth), - name=params$name, - text=data$text, - type="histogram", - autobinx=FALSE) + L <- list(x=data$x, + name=params$name, + text=data$text, + type="histogram", + fillcolor=toRGB(params$fill)) + if (is.null(params$binwidth)) { + L$autobinx <- TRUE + } else { + L$autobinx <- FALSE + L$xbins=list(start=params$xstart, + end=params$xend, + size=params$binwidth) + } + L } ) @@ -220,7 +226,7 @@ markLegends <- polygon=c("colour", "fill", "linetype", "size", "group"), bar=c("fill"), step=c("linetype", "size", "colour"), - histogram=c("colour")) + histogram=c("fill")) markUnique <- as.character(unique(unlist(markLegends))) @@ -262,10 +268,8 @@ gg2list <- function(p){ p$layers[[layer.i]]$data <- p$data } } - geom_type <- p$layers[[layer.i]]$geom - geom_type <- strsplit(capture.output(geom_type), "geom_")[[1]][2] - geom_type <- strsplit(geom_type, ": ")[[1]] + geom_type <- p$layers[[layer.i]]$geom$objname ## Barmode. layout$barmode <- "group" if (geom_type == "bar" || geom_type == "histogram") { @@ -273,6 +277,7 @@ gg2list <- function(p){ stat_type <- strsplit(stat_type, ": ")[[1]] if (grepl("bin", stat_type)) { geom_type <- "histogram" + p$layers[[layer.i]]$geom$objname <- "histogram" warning("You may want to use geom_histogram.") } pos <- capture.output(p$layers[[layer.i]]$position) From 77018e73ef0a52e27a9ded01493eb86910d63523 Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Tue, 17 Jun 2014 11:55:38 -0400 Subject: [PATCH 7/9] Do not force default geom_bar into histogram (yet) --- R/ggplotly.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 06d0c93c03..1a40251d70 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -277,7 +277,6 @@ gg2list <- function(p){ stat_type <- strsplit(stat_type, ": ")[[1]] if (grepl("bin", stat_type)) { geom_type <- "histogram" - p$layers[[layer.i]]$geom$objname <- "histogram" warning("You may want to use geom_histogram.") } pos <- capture.output(p$layers[[layer.i]]$position) From efeb853d0892689317b841d89c7516325609950a Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Tue, 17 Jun 2014 12:41:52 -0400 Subject: [PATCH 8/9] Fix condition --- R/ggplotly.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 1a40251d70..02f2f135a1 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -272,13 +272,15 @@ gg2list <- function(p){ geom_type <- p$layers[[layer.i]]$geom$objname ## Barmode. layout$barmode <- "group" - if (geom_type == "bar" || geom_type == "histogram") { + if (geom_type == "bar") { stat_type <- capture.output(p$layers[[layer.i]]$stat) stat_type <- strsplit(stat_type, ": ")[[1]] if (grepl("bin", stat_type)) { geom_type <- "histogram" warning("You may want to use geom_histogram.") } + } + if (geom_type == "bar" || geom_type == "histogram") { pos <- capture.output(p$layers[[layer.i]]$position) if (grepl("identity", pos)) { layout$barmode <- "overlay" From 78aac123568e8bc84032750f9fc46b0187b7f885 Mon Sep 17 00:00:00 2001 From: Marianne Corvellec Date: Tue, 17 Jun 2014 12:59:51 -0400 Subject: [PATCH 9/9] Support multiple traces for histogram type in the future --- R/ggplotly.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 02f2f135a1..e2c6d25ce5 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -226,7 +226,7 @@ markLegends <- polygon=c("colour", "fill", "linetype", "size", "group"), bar=c("fill"), step=c("linetype", "size", "colour"), - histogram=c("fill")) + histogram=c("colour", "fill")) markUnique <- as.character(unique(unlist(markLegends)))