Merge pull request #183 from ropensci/carson-smooth

geom_smooth()

Author: cpsievert

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 = "[email protected]"),
     person("Scott", "Chamberlain", role = "aut",

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.
 

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

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")
   }
 )
 

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")

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")
+})
+