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. diff --git a/R/ggplotly.R b/R/ggplotly.R index 524d091b35..fee32a633c 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -218,7 +218,7 @@ gg2list <- function(p){ # This extracts essential info for this geom/layer. 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 03bb1b0e7c..13939c4504 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -13,6 +13,7 @@ layer2traces <- function(l, d, misc) { g <- list(geom=l$geom$objname, data=not.na(d), prestats.data=not.na(misc$prestats.data)) + # 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) @@ -22,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_params$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") { @@ -187,7 +204,6 @@ 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(is.null(getTrace)){ warning("Conversion not implemented for geom_", @@ -282,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 @@ -378,6 +400,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") } ) 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") diff --git a/tests/testthat/test-ggplot-smooth.R b/tests/testthat/test-ggplot-smooth.R new file mode 100644 index 0000000000..7e5cbdb168 --- /dev/null +++ b/tests/testthat/test-ggplot-smooth.R @@ -0,0 +1,18 @@ +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) + save_outputs(p, "smooth") +}) + +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") +}) +