Fix ggplot2 dev

.travis.yml

@@ -9,6 +9,7 @@ before_install:
 
 install:
   - ./travis-tool.sh install_deps
+  - ./travis-tool.sh install_github hadley/scales hadley/ggplot2
 
 before_script:
   - git config --global user.name "cpsievert"

DESCRIPTION

@@ -23,7 +23,7 @@ Description: Create interactive web-based graphs via plotly's API.
 URL: https://github.com/ropensci/plotly
 BugReports: https://github.com/ropensci/plotly/issues
 Depends:
-    ggplot2
+    ggplot2 (> 1.0.1)
 Imports:
     scales,
     httr,

R/ggplotly.R

@@ -116,15 +116,18 @@ markUnique <- as.character(unique(unlist(markLegends)))
 
 markSplit <- c(markLegends,list(boxplot=c("x")))
 
+# obtain the "type" of geom/position/etc.
+type <- function(x, y) {
+  sub(y, "", tolower(class(x[[y]])[[1]]))
+}
+
+
 #' Convert a ggplot to a list.
 #' @import ggplot2
 #' @param p ggplot2 plot.
 #' @return figure object (list with names "data" and "layout").
 #' @export
 gg2list <- function(p) {
-  if(length(p$layers) == 0) {
-    stop("No layers in plot")
-  }
   # Always use identity size scale so that plot.ly gets the real
   # units for the size variables.
   original.p <- p
@@ -139,11 +142,14 @@ gg2list <- function(p) {
   })
   layout <- list()
   trace.list <- list()
+  # ggplot now applies geom_blank() (instead of erroring) when no layers exist
+  if (length(p$layers) == 0) p <- p + geom_blank()
 
   # Before building the ggplot, we would like to add aes(name) to
   # figure out what the object group is later. This also copies any
   # needed global aes/data values to each layer, so we do not have to
   # worry about combining global and layer-specific aes/data later.
+
   for(layer.i in seq_along(p$layers)) {
     layer.aes <- p$layers[[layer.i]]$mapping
     if(p$layers[[layer.i]]$inherit.aes){
@@ -293,7 +299,7 @@ gg2list <- function(p) {
     # This extracts essential info for this geom/layer.
     traces <- layer2traces(L, df, misc)
 
-    possible.legends <- markLegends[[L$geom$objname]]
+    possible.legends <- markLegends[[type(L, "geom")]]
     actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
     layer.legends[[paste(i)]] <- actual.legends
 
@@ -404,7 +410,7 @@ gg2list <- function(p) {
     grid <- theme.pars$panel.grid
     grid.major <- theme.pars$panel.grid.major
     if ((!is.null(grid$linetype) || !is.null(grid.major$linetype)) && 
-          c(grid$linetype, grid.major$linetype) %in% c(2, 3, "dashed", "dotted")) {
+        c(grid$linetype, grid.major$linetype) %in% c(2, 3, "dashed", "dotted")) {
       ax.list$gridcolor <- ifelse(is.null(grid.major$colour),
                                   toRGB(grid$colour, 0.1),
                                   toRGB(grid.major$colour, 0.1))
@@ -457,50 +463,35 @@ gg2list <- function(p) {
 
     # Translate axes labels.
     scale.i <- which(p$scales$find(xy))
-    ax.list$title <- if(length(scale.i)){
-      sc <- p$scales$scales[[scale.i]]
-      if(ax.list$type == "category"){
-        trace.order.list[[xy]] <- sc$limits
-        if(is.character(sc$breaks)){
-          if(is.character(sc$labels)){
-            trace.name.map[sc$breaks] <- sc$labels
-          }
-          ##TODO: if(is.function(sc$labels)){
-        }
-      }
-      if (is.null(sc$breaks)) {
-        ax.list$showticklabels <- FALSE
-        ax.list$showgrid <- FALSE
-        ax.list$ticks <- ""
-      }
-      if (is.numeric(sc$breaks)) {
-        dticks <- diff(sc$breaks)
-        dt <- dticks[1]
-        if(all(dticks == dt)){
-          ax.list$dtick <- dt
-          ax.list$autotick <- FALSE
-        }
-      }
-      ax.list$range <- if(!is.null(sc$limits)){
-        sc$limits
-      }else{
-        if(misc$is.continuous[[xy]]){
-          built$panel$ranges[[1]][[s("%s.range")]] #TODO: facets!
-        }else{ # for a discrete scale, range should be NULL.
-          NULL
-        }
-      }
-      if(is.character(sc$trans$name) && sc$trans$name == "reverse"){
-        ax.list$range <- sort(-ax.list$range, decreasing = TRUE)
-      }
-      if(!is.null(sc$name)){
-        sc$name
-      }else{
-        p$labels[[xy]]
+    sc <- tryCatch(p$scales$scales[[scale.i]], 
+                   error = function(e) list())
+    ax.list$title <- sc$name %||% p$labels[[xy]] %||% p$labels[[xy]]
+
+    if (ax.list$type == "category") {
+      trace.order.list[[xy]] <- sc$limits
+      if (is.character(sc$breaks) && is.character(sc$labels))
+        trace.name.map[sc$breaks] <- sc$labels
+      ##TODO: if(is.function(sc$labels)){
+    }
+    if (is.null(sc$breaks)) {
+      ax.list$showticklabels <- FALSE
+      ax.list$showgrid <- FALSE
+      ax.list$ticks <- ""
+    }
+    if (is.numeric(sc$breaks)) {
+      dticks <- diff(sc$breaks)
+      dt <- dticks[1]
+      if (all(dticks == dt)) {
+        ax.list$dtick <- dt
+        ax.list$autotick <- FALSE
       }
-    }else{
-      p$labels[[xy]]
     }
+    ax.list$range <- sc$limits %||% 
+      #TODO: facets!
+      if (misc$is.continuous[[xy]]) 
+        built$panel$ranges[[1]][[s("%s.range")]] %||%
+      if (is.character(sc$trans$name) && sc$trans$name == "reverse")
+        sort(-ax.list$range, decreasing = TRUE)
 
     ax.list$zeroline <- FALSE  # ggplot2 plots do not show zero lines
     # Lines drawn around the plot border.
@@ -938,7 +929,8 @@ gg2list <- function(p) {
   # each axis.
   flipped.traces <- named.traces
   flipped.layout <- layout
-  if("flip" %in% attr(built$plot$coordinates, "class")){
+  coord_cl <- sub("coord", "", tolower(class(built$plot$coordinates)))
+  if("flip" %in% coord_cl){
     if(!inherits(p$facet, "null")){
       stop("coord_flip + facet conversion not supported")
     }

R/plotly_POST.R

@@ -35,7 +35,7 @@ plotly_POST <- function(x) {
   # filename & fileopt are keyword arguments required by the API
   # (note they can also be specified by the user)
   if (!is.null(x$url) || !is.null(kwargs$filename)) kwargs$fileopt <- "overwrite"
-  if (is.null(kwargs$filename)) {
+  if (is.null(kwargs$filename) || kwargs$filename == "") {
     kwargs$filename <- 
       as.character(kwargs$layout$title) %||% 
       paste(

R/trace_generation.R

@@ -5,15 +5,13 @@
 #' @return list representing a layer, with corresponding aesthetics, ranges, and groups.
 #' @export
 layer2traces <- function(l, d, misc) {
-  not.na <- function(df){
-    na.mat <- is.na(df)
-    to.exclude <- apply(na.mat, 1, any)
-    df[!to.exclude, ]
-  }
-  g <- list(geom=l$geom$objname,
-            data=not.na(d),
-            prestats.data=not.na(l$prestats.data))
 
+  g <- list(
+    geom = type(l, "geom"),
+    data = na.omit(d),
+    prestats.data = na.omit(l$prestats.data)
+  )
+  #if (grepl("line", g$geom)) browser()
   # 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)
@@ -41,11 +39,6 @@ layer2traces <- function(l, d, misc) {
       g$geom <- "smoothLine"
     }
   }
-  # histogram is essentially a bar chart with no gaps (after stats are computed)
-  if (g$geom == "histogram") {
-    g$geom <- "bar"
-    bargap <- 0
-  }
 
   # For non-numeric data on the axes, we should take the values from
   # the original data.
@@ -139,11 +132,7 @@ layer2traces <- function(l, d, misc) {
 
   # First convert to a "basic" geom, e.g. segments become lines.
   convert <- toBasic[[g$geom]]
-  basic <- if(is.null(convert)){
-    g
-  }else{
-    convert(g)
-  }
+  basic <- if (is.null(convert)) g else convert(g)
   # Then split on visual characteristics that will get different
   # legend entries.
   data.list <- if (basic$geom %in% names(markSplit)) {
@@ -195,12 +184,12 @@ layer2traces <- function(l, d, misc) {
                            names=basic$params$name)
   }
   getTrace <- geom2trace[[basic$geom]]
-  if(is.null(getTrace)){
-    warning("Conversion not implemented for geom_",
-            g$geom, " (basic geom_", basic$geom, "), ignoring. ",
-            "Please open an issue with your example code at ",
-            "https://github.com/ropensci/plotly/issues")
-    return(list())
+  if (is.null(getTrace)) {
+    getTrace <- geom2trace[["blank"]]
+    warning("geom_", g$geom, " has yet to be implemented in plotly.\n",
+            "  If you'd like to see this geom implemented,\n",
+            "  Please open an issue with your example code at\n",
+            "  https://github.com/ropensci/plotly/issues")
   }
   traces <- NULL
   names.in.legend <- NULL
@@ -250,16 +239,17 @@ layer2traces <- function(l, d, misc) {
 
     # special handling for bars
     if (g$geom == "bar") {
-      tr$bargap <- if (exists("bargap")) bargap else "default"
-      pos <- l$position$.super$objname
+      is_hist <- misc$is.continuous[["x"]]
+      tr$bargap <- if (is_hist) 0 else "default"
+      pos <- type(l, "position")
       tr$barmode <-
-        if (pos %in% "identity" && tr$bargap == 0) {
+        if (pos %in% "identity" && is_hist) {
           "overlay" 
         } else if (pos %in% c("identity", "stack", "fill")) {
           "stack"
         } else {
-        "group"
-      }
+          "group"
+        }
     }
 
     traces <- c(traces, list(tr))
@@ -341,6 +331,51 @@ toBasic <- list(
     g$data <- g$data[order(g$data$x), ]
     group2NA(g, "path")
   },
+  abline=function(g) {
+    m <- g$data$slope
+    b <- g$data$intercept
+    # replicate each row twice (since each line needs 2 points)
+    idx <- rep(seq_len(nrow(g$data)), 2)
+    g$data <- g$data[idx, ]
+    g$data <- cbind(
+      g$data,
+      x = with(g$prestats.data, c(globxmin, globxmax)),
+      y = with(g$prestats.data, c(globxmin * m + b, globxmax * m + b))
+    )
+    g$data <- g$data[order(g$data$x), ]
+    group2NA(g, "path")
+  },
+  hline=function(g) {
+    if (is.factor(g$data$x)) {
+      xstart <- as.character(sort(g$data$x)[1])
+      xend <- as.character(sort(g$data$x)[length(g$data$x)])
+    } else {
+      xstart <- min(g$prestats.data$globxmin)
+      xend <- max(g$prestats.data$globxmax)
+    }
+    int <- g$data$yintercept
+    # replicate each row twice (since each line needs 2 points)
+    idx <- rep(seq_len(nrow(g$data)), 2)
+    g$data <- g$data[idx, ]
+    g$data <- cbind(
+      g$data,
+      x = int[idx],
+      y = c(xstart, xend)
+    )
+    group2NA(g, "path")
+  },
+  vline=function(g) {
+    int <- g$data$xintercept
+    # replicate each row twice (since each line needs 2 points)
+    idx <- rep(seq_len(nrow(g$data)), 2)
+    g$data <- g$data[idx, ]
+    g$data <- cbind(
+      g$data,
+      x = int[idx],
+      y = with(g$prestats.data, c(globymin, globymax))
+    )
+    group2NA(g, "path")
+  },
   boxplot=function(g) {
     # Preserve default colour values usign fill:
     if (!is.null(g$data$fill)) {
@@ -369,26 +404,6 @@ toBasic <- list(
     g$data <- g$prestats.data
     g
   },
-  abline=function(g) {
-    g$params$xstart <- min(g$prestats.data$globxmin)
-    g$params$xend <- max(g$prestats.data$globxmax)
-    g
-  },
-  hline=function(g) {
-    if (is.factor(g$data$x)) {
-      g$params$xstart <- as.character(sort(g$data$x)[1])
-      g$params$xend <- as.character(sort(g$data$x)[length(g$data$x)])
-    } else {
-      g$params$xstart <- min(g$prestats.data$globxmin)
-      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)
@@ -509,6 +524,17 @@ ribbon_dat <- function(dat) {
 
 # Convert basic geoms to traces.
 geom2trace <- list(
+  blank=function(data, params) {
+    list(
+      x=data$x,
+      y=data$y,
+      name=params$name,
+      text=data$text,
+      type="scatter",
+      mode="markers",
+      marker=list(opacity = 0)
+    )
+  },
   path=function(data, params) {
     list(x=data$x,
          y=data$y,
@@ -667,13 +693,14 @@ geom2trace <- list(
                                               params$alpha)))
   },
   abline=function(data, params) {
-    list(x=c(params$xstart, params$xend),
-         y=c(params$intercept + params$xstart * params$slope,
-             params$intercept + params$xend * params$slope),
-         name=params$name,
-         type="scatter",
-         mode="lines",
-         line=paramORdefault(params, aes2line, line.defaults))
+    list(
+      x = params$ablines$x,
+      y = params$ablines$y,
+      name = params$name,
+      type = "scatter",
+      mode = "lines",
+      line = paramORdefault(params, aes2line, line.defaults)
+    )
   },
   hline=function(data, params) {
     list(x=c(params$xstart, params$xend),

R/utils.R

@@ -118,7 +118,8 @@ try_file <- function(f, what) {
 
 # preferred defaults for toJSON mapping
 to_JSON <- function(x, ...) {
-  jsonlite::toJSON(x, digits = 50, auto_unbox = TRUE, force = TRUE, ...)
+  jsonlite::toJSON(x, digits = 50, auto_unbox = TRUE, 
+                   force = TRUE, null = "null", na = "null", ...)
 }
 
 # preferred defaults for toJSON mapping