From b0ca23028377e2ce62466b54ddc782a8a105936d Mon Sep 17 00:00:00 2001 From: cpsievert Date: Tue, 10 Mar 2015 00:42:59 -0500 Subject: [PATCH 1/9] Introducing geom_smooth() --- R/ggplotly.R | 15 ++++++++++++++- R/trace_generation.R | 28 ++++++++++++++++++++++++++-- tests/testthat/test-ggplot-smooth.R | 16 ++++++++++++++++ 3 files changed, 56 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-ggplot-smooth.R diff --git a/R/ggplotly.R b/R/ggplotly.R index 67622ba3ad..d43295edc1 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -206,7 +206,20 @@ gg2list <- function(p){ } # This extracts essential info for this geom/layer. - traces <- layer2traces(L, df, misc) + if (L$geom$objname == "smooth") { + # smooth is really a line + ribbon geom + misc$smoothRibbon <- TRUE + trace1 <- if (isTRUE(L$stat_params$se == FALSE)) { + NULL + } else { + layer2traces(L, df, misc) + } + misc$smoothRibbon <- FALSE + misc$smoothLine <- TRUE + traces <- c(trace1, layer2traces(L, df, misc)) + } else { + traces <- layer2traces(L, df, misc) + } possible.legends <- markLegends[[L$geom$objname]] actual.legends <- possible.legends[possible.legends %in% names(L$mapping)] diff --git a/R/trace_generation.R b/R/trace_generation.R index 03bb1b0e7c..977980808b 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -187,8 +187,13 @@ layer2traces <- function(l, d, misc) { data.list <- structure(list(list(data=basic$data, params=basic$params)), names=basic$params$name) } - - getTrace <- geom2trace[[basic$geom]] + if (isTRUE(misc$smoothLine)) { + getTrace <- geom2trace[["smoothLine"]] + } else if (isTRUE(misc$smoothRibbon)) { + getTrace <- geom2trace[["smoothRibbon"]] + } else { + getTrace <- geom2trace[[basic$geom]] + } if(is.null(getTrace)){ warning("Conversion not implemented for geom_", g$geom, " (basic geom_", basic$geom, "), ignoring. ", @@ -640,5 +645,24 @@ geom2trace <- list( type="scatter", mode="lines", line=paramORdefault(params, aes2line, line.defaults)) + }, + smoothRibbon=function(data, params) { + list(x=c(data$x[1], data$x, rev(data$x)), + y=c(data$ymin[1], data$ymax, rev(data$ymin)), + type="scatter", + line=paramORdefault(params, aes2line, ribbon.line.defaults), + fill="tonexty", + fillcolor=toFill(params$fill, ifelse(is.null(params$alpha), + 0.1, params$alpha))) + }, + smoothLine=function(data, params) { + line.defaults$colour <- "blue" + list(x=data$x, + y=data$y, + name=params$name, + text=data$text, + type="scatter", + mode="lines", + line=paramORdefault(params, aes2line, line.defaults)) } ) diff --git a/tests/testthat/test-ggplot-smooth.R b/tests/testthat/test-ggplot-smooth.R new file mode 100644 index 0000000000..2e2984204f --- /dev/null +++ b/tests/testthat/test-ggplot-smooth.R @@ -0,0 +1,16 @@ +context("smooth") + +p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth() + +test_that("geom_point() + geom_smooth() produces 3 traces", { + info <- gg2list(p) + expect_true(sum(names(info) == "") == 3) +}) + +p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE) + +test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", { + info2 <- gg2list(p2) + expect_true(sum(names(info2) == "") == 2) +}) + From 9b5bbf306ada7d25d2f7d778f2cb11f69fc437dd Mon Sep 17 00:00:00 2001 From: cpsievert Date: Tue, 10 Mar 2015 12:05:08 -0500 Subject: [PATCH 2/9] save_outputs of smooth tests --- tests/testthat/test-ggplot-smooth.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-ggplot-smooth.R b/tests/testthat/test-ggplot-smooth.R index 2e2984204f..7e5cbdb168 100644 --- a/tests/testthat/test-ggplot-smooth.R +++ b/tests/testthat/test-ggplot-smooth.R @@ -5,6 +5,7 @@ p <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth() test_that("geom_point() + geom_smooth() produces 3 traces", { info <- gg2list(p) expect_true(sum(names(info) == "") == 3) + save_outputs(p, "smooth") }) p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE) @@ -12,5 +13,6 @@ p2 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() + geom_smooth(se = FALSE) test_that("geom_point() + geom_smooth(se = FALSE) produces 2 traces", { info2 <- gg2list(p2) expect_true(sum(names(info2) == "") == 2) + save_outputs(p2, "smooth-se-false") }) From a5da68d9557a6a751e061cd8fd6b7950b9b93c7c Mon Sep 17 00:00:00 2001 From: cpsievert Date: Tue, 10 Mar 2015 14:21:38 -0500 Subject: [PATCH 3/9] Fix default line colour for smooth --- R/trace_generation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index 977980808b..c4a81b09fb 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -656,7 +656,7 @@ geom2trace <- list( 0.1, params$alpha))) }, smoothLine=function(data, params) { - line.defaults$colour <- "blue" + line.defaults$colour <- "#3366FF" list(x=data$x, y=data$y, name=params$name, From 91e6e3d6dc473e62a6ec2b67a46d29460adc3fca Mon Sep 17 00:00:00 2001 From: cpsievert Date: Tue, 10 Mar 2015 21:04:50 -0500 Subject: [PATCH 4/9] Add scatterplot cookbook tests; geom_smooth now respects group aes --- R/trace_generation.R | 39 ++++------- tests/testthat/test-cookbook-scatterplots.R | 74 +++++++++++++++++++++ 2 files changed, 87 insertions(+), 26 deletions(-) create mode 100644 tests/testthat/test-cookbook-scatterplots.R diff --git a/R/trace_generation.R b/R/trace_generation.R index c4a81b09fb..d2fd31b505 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -13,6 +13,10 @@ layer2traces <- function(l, d, misc) { g <- list(geom=l$geom$objname, data=not.na(d), prestats.data=not.na(misc$prestats.data)) + if (g$geom == "smooth") { + if (isTRUE(misc$smoothRibbon)) g$geom <- "smoothRibbon" + if (isTRUE(misc$smoothLine)) g$geom <- "smoothLine" + } # needed for when group, etc. is an expression. g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k))) # Partial conversion for geom_violin (Plotly does not offer KDE yet) @@ -187,13 +191,7 @@ layer2traces <- function(l, d, misc) { data.list <- structure(list(list(data=basic$data, params=basic$params)), names=basic$params$name) } - if (isTRUE(misc$smoothLine)) { - getTrace <- geom2trace[["smoothLine"]] - } else if (isTRUE(misc$smoothRibbon)) { - getTrace <- geom2trace[["smoothRibbon"]] - } else { - getTrace <- geom2trace[[basic$geom]] - } + getTrace <- geom2trace[[basic$geom]] if(is.null(getTrace)){ warning("Conversion not implemented for geom_", g$geom, " (basic geom_", basic$geom, "), ignoring. ", @@ -383,6 +381,14 @@ toBasic <- list( g$params$sizemax <- max(g$prestats.data$globsizemax) } g + }, + smoothLine=function(g) { + if (length(unique(g$data$group)) == 1) g$params$colour <- "#3366FF" + group2NA(g, "path") + }, + smoothRibbon=function(g) { + if (is.null(g$params$alpha)) g$params$alpha <- 0.1 + group2NA(g, "ribbon") } ) @@ -645,24 +651,5 @@ geom2trace <- list( type="scatter", mode="lines", line=paramORdefault(params, aes2line, line.defaults)) - }, - smoothRibbon=function(data, params) { - list(x=c(data$x[1], data$x, rev(data$x)), - y=c(data$ymin[1], data$ymax, rev(data$ymin)), - type="scatter", - line=paramORdefault(params, aes2line, ribbon.line.defaults), - fill="tonexty", - fillcolor=toFill(params$fill, ifelse(is.null(params$alpha), - 0.1, params$alpha))) - }, - smoothLine=function(data, params) { - line.defaults$colour <- "#3366FF" - list(x=data$x, - y=data$y, - name=params$name, - text=data$text, - type="scatter", - mode="lines", - line=paramORdefault(params, aes2line, line.defaults)) } ) diff --git a/tests/testthat/test-cookbook-scatterplots.R b/tests/testthat/test-cookbook-scatterplots.R new file mode 100644 index 0000000000..375fecdeee --- /dev/null +++ b/tests/testthat/test-cookbook-scatterplots.R @@ -0,0 +1,74 @@ +set.seed(955) +# Make some noisily increasing data +dat <- data.frame(cond = rep(c("A", "B"), each=10), + xvar = c(1.475957, -3.423712, 1.966129, 5.575364, 2.954719, 2.768286, 3.507499, 6.945000, 12.135050, 10.231673, 13.040393, 12.231689, 13.506993, 13.590874, 15.455178, 28.431185, 17.758937, 24.730797, 22.954238, 21.122766), + yvar = c(-1.315387, 3.323239, 4.452183, 4.597885, 5.697203, 5.991221, 5.764561, 10.163165, 14.805634, 11.447913, 12.163597, 10.930851, 13.491366, 11.800783, 19.246991, 13.870457, 11.031923, 22.700302, 24.877547, 22.520114)) +# cond xvar yvar +# A -4.252354091 3.473157275 +# A 1.702317971 0.005939612 +# ... +# B 17.793359218 19.718587761 +# B 19.319909163 19.647899863 + +g <- ggplot(dat, aes(x=xvar, y=yvar)) + + geom_point(shape=1) # Use hollow circles +save_outputs(g, "scatterplots-hollow") + +g <- ggplot(dat, aes(x=xvar, y=yvar)) + + geom_point(shape=1) + + geom_smooth(method=lm) # Add linear regression line +save_outputs(g, "scatterplots-smooth-lm") + +g <- ggplot(dat, aes(x=xvar, y=yvar)) + + geom_point(shape=1) + + geom_smooth(method=lm, se=FALSE) # Don't add shaded confidence region +save_outputs(g, "scatterplots-smooth-lm-se-false") + + +g <- ggplot(dat, aes(x=xvar, y=yvar)) + + geom_point(shape=1) + # Use hollow circles + geom_smooth() # Add a loess smoothed fit curve with confidence region +save_outputs(g, "scatterplots-loess") + +# Set color by cond +g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) +save_outputs(g, "scatterplots-color") + +# # Same, but with different colors and add regression lines +g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) + + scale_colour_hue(l=50) + # Use a slightly darker palette than normal + geom_smooth(method=lm, se=FALSE) +save_outputs(g, "scatterplots-scale-color-hue") + +# Extend the regression lines beyond the domain of the data +g <- ggplot(dat, aes(x=xvar, y=yvar, color=cond)) + geom_point(shape=1) + + scale_colour_hue(l=50) + + geom_smooth(method=lm, se=FALSE, fullrange=T) +save_outputs(g, "scatterplots-full-range") + +# Set shape by cond +g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() +save_outputs(g, "scatterplots-shape") + +# Same, but with different shapes +g <- ggplot(dat, aes(x=xvar, y=yvar, shape=cond)) + geom_point() + + scale_shape_manual(values=c(1,2)) # Use a hollow circle and triangle +save_outputs(g, "scatterplots-shape-manual") + +# Round xvar and yvar to the nearest 5 +dat$xrnd <- round(dat$xvar/5)*5 +dat$yrnd <- round(dat$yvar/5)*5 + +# Make each dot partially transparent, with 1/4 opacity +# For heavy overplotting, try using smaller values +g <- ggplot(dat, aes(x=xrnd, y=yrnd)) + + geom_point(shape=19, # Use solid circles + alpha=1/4) # 1/4 opacity +save_outputs(g, "scatterplots-overlap") + +# Jitter the points +# Jitter range is 1 on the x-axis, .5 on the y-axis +g <- ggplot(dat, aes(x=xrnd, y=yrnd)) + + geom_point(shape=1, # Use hollow circles + position=position_jitter(width=1,height=.5)) +save_outputs(g, "scatterplots-jitter") From 237865528658e886b634a43936c92e7be88f3cdb Mon Sep 17 00:00:00 2001 From: cpsievert Date: Tue, 10 Mar 2015 21:11:28 -0500 Subject: [PATCH 5/9] Bump version; update NEWS --- DESCRIPTION | 2 +- NEWS | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 04e93d0c83..53f7fb6af7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: plotly Type: Package Title: Interactive, publication-quality graphs online. -Version: 0.5.24 +Version: 0.5.25 Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"), email = "chris@plot.ly"), person("Scott", "Chamberlain", role = "aut", diff --git a/NEWS b/NEWS index 2c9b1b110c..d6834f7932 100644 --- a/NEWS +++ b/NEWS @@ -1,10 +1,14 @@ +0.5.25 -- 10 March 2015 + +Implemented geom_smooth() #183 + 0.5.24 -- 10 March 2015 -Implemented #167 +Implemented facet_wrap(scales="free") #167 0.5.23 -- 10 March 2015. -geom_ribbon now respects alpha transparency +geom_ribbon() now respects alpha transparency 0.5.22 -- 2 March 2015. From 7a3430c57fcc9fbc86adbf39adb3a611978fbbe8 Mon Sep 17 00:00:00 2001 From: cpsievert Date: Wed, 11 Mar 2015 22:11:27 -0500 Subject: [PATCH 6/9] Don't showlegend for line trace of geom_smooth --- R/ggplotly.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 4dbb1c1062..4de6ea2a1f 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -219,19 +219,22 @@ gg2list <- function(p){ # This extracts essential info for this geom/layer. if (L$geom$objname == "smooth") { # smooth is really a line + ribbon geom - misc$smoothRibbon <- TRUE - trace1 <- if (isTRUE(L$stat_params$se == FALSE)) { + # always draw the line + misc$smoothLine <- TRUE + trace1 <- layer2traces(L, df, misc) + trace1 <- lapply(trace1, function(x) { x$showlegend <- FALSE; x }) + misc$smoothLine <- FALSE + # draw ribbon unless se = FALSE + trace2 <- if (isTRUE(L$stat_params$se == FALSE)) { NULL } else { + misc$smoothRibbon <- TRUE layer2traces(L, df, misc) } - misc$smoothRibbon <- FALSE - misc$smoothLine <- TRUE - traces <- c(trace1, layer2traces(L, df, misc)) + traces <- c(trace1, trace2) } else { traces <- layer2traces(L, df, misc) } - possible.legends <- markLegends[[L$geom$objname]] actual.legends <- possible.legends[possible.legends %in% names(L$mapping)] layer.legends[[paste(i)]] <- actual.legends From 4ac88f0165a84d3a01957084dc8eb504b66d3d3a Mon Sep 17 00:00:00 2001 From: cpsievert Date: Wed, 11 Mar 2015 22:42:26 -0500 Subject: [PATCH 7/9] Draw ribbon first --- R/ggplotly.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 4de6ea2a1f..cfc15b73c4 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -219,18 +219,18 @@ gg2list <- function(p){ # This extracts essential info for this geom/layer. if (L$geom$objname == "smooth") { # smooth is really a line + ribbon geom - # always draw the line - misc$smoothLine <- TRUE - trace1 <- layer2traces(L, df, misc) - trace1 <- lapply(trace1, function(x) { x$showlegend <- FALSE; x }) - misc$smoothLine <- FALSE - # draw ribbon unless se = FALSE - trace2 <- if (isTRUE(L$stat_params$se == FALSE)) { + # draw ribbon (unless se = FALSE) + misc$smoothRibbon <- TRUE + trace1 <- if (isTRUE(L$stat_params$se == FALSE)) { NULL } else { - misc$smoothRibbon <- TRUE layer2traces(L, df, misc) } + misc$smoothRibbon <- FALSE + # always draw the line + misc$smoothLine <- TRUE + trace2 <- layer2traces(L, df, misc) + trace2 <- lapply(trace2, function(x) { x$showlegend <- FALSE; x }) traces <- c(trace1, trace2) } else { traces <- layer2traces(L, df, misc) From cbe301bf63a85b23b2a4a1ca1ca2b856b0262f21 Mon Sep 17 00:00:00 2001 From: cpsievert Date: Thu, 12 Mar 2015 15:22:11 -0500 Subject: [PATCH 8/9] Avoid geom specific code in ggplotly.R --- R/ggplotly.R | 20 ++--------------- R/trace_generation.R | 51 +++++++++++++++++++++++++++++++++++++++----- 2 files changed, 48 insertions(+), 23 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index cfc15b73c4..fee32a633c 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -217,24 +217,8 @@ gg2list <- function(p){ } # This extracts essential info for this geom/layer. - if (L$geom$objname == "smooth") { - # smooth is really a line + ribbon geom - # draw ribbon (unless se = FALSE) - misc$smoothRibbon <- TRUE - trace1 <- if (isTRUE(L$stat_params$se == FALSE)) { - NULL - } else { - layer2traces(L, df, misc) - } - misc$smoothRibbon <- FALSE - # always draw the line - misc$smoothLine <- TRUE - trace2 <- layer2traces(L, df, misc) - trace2 <- lapply(trace2, function(x) { x$showlegend <- FALSE; x }) - traces <- c(trace1, trace2) - } else { - traces <- layer2traces(L, df, misc) - } + traces <- layer2traces(L, df, misc) + possible.legends <- markLegends[[L$geom$objname]] actual.legends <- possible.legends[possible.legends %in% names(L$mapping)] layer.legends[[paste(i)]] <- actual.legends diff --git a/R/trace_generation.R b/R/trace_generation.R index d2fd31b505..ac648fc6ef 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -13,10 +13,7 @@ layer2traces <- function(l, d, misc) { g <- list(geom=l$geom$objname, data=not.na(d), prestats.data=not.na(misc$prestats.data)) - if (g$geom == "smooth") { - if (isTRUE(misc$smoothRibbon)) g$geom <- "smoothRibbon" - if (isTRUE(misc$smoothLine)) g$geom <- "smoothLine" - } + # needed for when group, etc. is an expression. g$aes <- sapply(l$mapping, function(k) as.character(as.expression(k))) # Partial conversion for geom_violin (Plotly does not offer KDE yet) @@ -26,6 +23,22 @@ layer2traces <- function(l, d, misc) { probability density estimation is not supported in Plotly yet.") } + # geom_smooth() means geom_line() + geom_ribbon() + # Note the line is always drawn, but ribbon is not if se = FALSE. + if (g$geom == "smooth") { + # If smoothLine has been compiled already, consider smoothRibbon. + if (isTRUE(misc$smoothLine)) { + misc$smoothLine <- FALSE + if (isTRUE(L$stat_param$se == FALSE)) { + return(NULL) + } else { + g$geom <- "smoothRibbon" + } + } else { + misc$smoothLine <- TRUE + g$geom <- "smoothLine" + } + } # Barmode and bargap barmode <- "group" if (g$geom == "bar" || g$geom == "histogram") { @@ -285,7 +298,13 @@ layer2traces <- function(l, d, misc) { } no.sort[[tr.i]]$sort <- NULL } - no.sort + # if line portion of geom_smooth was compiled, call layer2traces() + # again for ribbon portion + if (isTRUE(misc$smoothLine)) { + c(layer2traces(l, d, misc), no.sort) + } else { + no.sort + } }#layer2traces @@ -652,4 +671,26 @@ geom2trace <- list( mode="lines", line=paramORdefault(params, aes2line, line.defaults)) } +# smooth=function(data, params) { +# if (isTRUE(params$se == FALSE)) { +# L1 <- NULL +# } else { +# L1 <- list(x=c(data$x[1], data$x, rev(data$x)), +# y=c(data$ymin[1], data$ymax, rev(data$ymin)), +# type="scatter", +# line=paramORdefault(params, aes2line, ribbon.line.defaults), +# fill="tonexty", +# fillcolor=toFill(params$fill, ifelse(is.null(params$alpha), 1, +# params$alpha))) +# } +# # $showlegend <- FALSE +# c(L1, +# list(x=data$x, +# y=data$y, +# name=params$name, +# text=data$text, +# type="scatter", +# mode="lines", +# line=paramORdefault(params, aes2line, line.defaults))) +# } ) From a97ba2b6b71e3f335099d9e73cc13ea18a13e14e Mon Sep 17 00:00:00 2001 From: cpsievert Date: Thu, 12 Mar 2015 15:41:06 -0500 Subject: [PATCH 9/9] Fix typo; remove commented code --- R/trace_generation.R | 24 +----------------------- 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index ac648fc6ef..13939c4504 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -29,7 +29,7 @@ layer2traces <- function(l, d, misc) { # If smoothLine has been compiled already, consider smoothRibbon. if (isTRUE(misc$smoothLine)) { misc$smoothLine <- FALSE - if (isTRUE(L$stat_param$se == FALSE)) { + if (isTRUE(l$stat_params$se == FALSE)) { return(NULL) } else { g$geom <- "smoothRibbon" @@ -671,26 +671,4 @@ geom2trace <- list( mode="lines", line=paramORdefault(params, aes2line, line.defaults)) } -# smooth=function(data, params) { -# if (isTRUE(params$se == FALSE)) { -# L1 <- NULL -# } else { -# L1 <- list(x=c(data$x[1], data$x, rev(data$x)), -# y=c(data$ymin[1], data$ymax, rev(data$ymin)), -# type="scatter", -# line=paramORdefault(params, aes2line, ribbon.line.defaults), -# fill="tonexty", -# fillcolor=toFill(params$fill, ifelse(is.null(params$alpha), 1, -# params$alpha))) -# } -# # $showlegend <- FALSE -# c(L1, -# list(x=data$x, -# y=data$y, -# name=params$name, -# text=data$text, -# type="scatter", -# mode="lines", -# line=paramORdefault(params, aes2line, line.defaults))) -# } )