Get dplyr integration working again and introduce last_plot()

Author: cpsievert

NAMESPACE

@@ -12,6 +12,7 @@ export(ggplotly)
 export(group2NA)
 export(knit_print.offline)
 export(knit_print.plotly)
+export(last_plot)
 export(layer2traces)
 export(layout)
 export(offline)

R/offline.R

@@ -39,7 +39,7 @@
 #' }
 #' 
 
-offline <- function(p = get_plot(), height = 400, width = "100%", 
+offline <- function(p = last_plot(), height = 400, width = "100%", 
                     out_dir = NULL, open_browser = interactive()) {
   haz <- has_offline()
   if (!haz) offline_stop()

R/plotly.R

@@ -96,7 +96,7 @@ plot_ly <- function(data = data.frame(), ..., type = "scatter",
 #' @author Carson Sievert
 #' @export
 #' 
-add_trace <- function(p = get_plot(), ...,
+add_trace <- function(p = last_plot(), ...,
                       group, color, colors, symbol, symbols, size,
                       data = NULL, evaluate = FALSE) {
   # "native" plotly arguments
@@ -108,13 +108,13 @@ add_trace <- function(p = get_plot(), ...,
   if (!missing(symbol)) argz$symbol <- substitute(symbol)
   if (!missing(symbols)) argz$symbols <- substitute(symbols)
   if (!missing(size)) argz$size <- substitute(size)
-  p <- get_plot(p)
+  data <- data %||% if (is.data.frame(p)) p else list()
   tr <- list(
     args = argz,
-    # if data is missing, adopt the most recent data environment
-    env = if (is.null(data)) p$data[[length(p$data)]]$env else list2env(data),
+    env = list2env(data),
     enclos = parent.frame()
   )
+  p <- last_plot(p)
   p$data <- c(p$data, list(tr))
   if (evaluate) p <- plotly_build(p)
   hash_plot(data, p)
@@ -131,15 +131,15 @@ add_trace <- function(p = get_plot(), ...,
 #' @author Carson Sievert
 #' @export
 #' 
-layout <- function(p = get_plot(), ..., 
+layout <- function(p = last_plot(), ..., 
                    data = NULL, evaluate = FALSE) {
-  p <- get_plot(p)
+  data <- data %||% if (is.data.frame(p)) p else list()
   layout <- list(
     args = substitute(list(...)),
-    # if data is missing, adopt the most recent data environment
-    env = if (is.null(data)) p$data[[length(p$data)]]$env else list2env(data),
+    env = list2env(data),
     enclos = parent.frame()
   )
+  p <- last_plot(p)
   p$layout <- c(p$layout, list(layout))
   if (evaluate) p <- plotly_build(p)
   hash_plot(data, p)
@@ -158,8 +158,7 @@ layout <- function(p = get_plot(), ...,
 #' @author Carson Sievert
 #' @export
 #'
-style <- function(p = get_plot(strict = FALSE), ..., traces = 1, evaluate = FALSE) {
-  p <- get_plot(p)
+style <- function(p = last_plot(), ..., traces = 1, evaluate = FALSE) {
   idx <- traces >= length(p$data)
   if (any(idx)) warning("You've referenced non-existent traces", call. = FALSE)
   style <- list(
@@ -184,14 +183,14 @@ style <- function(p = get_plot(strict = FALSE), ..., traces = 1, evaluate = FALS
 #' 
 #' @param l a ggplot object, or a plotly object, or a list.
 #' @export
-plotly_build <- function(l = get_plot()) {
+plotly_build <- function(l = last_plot()) {
   # ggplot objects don't need any special type of handling
-  if (is.ggplot(l)) return(gg2list(l))
+  if (is.ggplot(l)) return(ggplotly(l))
   l <- get_plot(l)
   # plots without NSE don't need it either
   nms <- lapply(l$data, names)
   idx <- unique(unlist(lapply(l$data, names))) %in% c("args", "env")
-  if (sum(idx) != 2) return(struct(l, "plotly"))
+  if (sum(idx) != 2) return(structure(l, class = unique("plotly", class(l))))
   nms <- names(l)
   # assume unnamed list elements are data/traces
   idx <- nms %in% ""
@@ -307,7 +306,7 @@ plotly_build <- function(l = get_plot()) {
   # traces shouldn't have any names
   x$data <- setNames(x$data, NULL)
   # add plotly class mainly for printing method
-  struct(x, "plotly")
+  structure(x, class = unique("plotly", class(x)))
 }
 
 # returns a _list of traces_.

R/plotly_POST.R

@@ -28,7 +28,6 @@
 
 plotly_POST <- function(x) {
   x <- plotly_build(x)
-  
   # empty keyword arguments can cause problems
   kwargs <- x[get_kwargs()]
   kwargs <- kwargs[sapply(kwargs, length) > 0]

R/stream.R

@@ -0,0 +1,58 @@
+#' Stream objects
+#' 
+#' @param p a plotly or figure object.
+#' @examples
+#' 
+#' # generate 100 random observations
+#' n <- 100
+#' x <- rnorm(n)
+#' 
+#' # start a plotly stream
+#' s <- stream()
+#' # write to the stream 
+#' for (i in seq_len(50)) {
+#'   s$write(x = x)
+#'   x <- x[-n]
+#'   x[1] <- rnorm(1)
+#' }
+#' # close the stream
+#' s$close()
+#' 
+
+# Implementation of https://plot.ly/streaming/
+stream <- function(x) {
+  haz <- has_stream()
+  if (!haz) {
+    stop("To use plotly streams, you need to create streaming token(s). \n",
+         "To see how to create token(s), please visit: \n", 
+         "https://plot.ly/python/streaming-tutorial/#Get-your-stream-tokens \n",
+         "Once created, save these token(s) as an environment variable: \n",
+         "  Sys.setenv('plotly_streamtoken' = 'token1;token2;token3')")
+  }
+  # obtain streaming tokens
+  toks <- strsplit(names(haz), ";")[[1]]
+  if (length(toks)) {
+    warning("Multiple token handling coming soon!")
+    toks <- toks[1]
+  }
+  # request headers
+  headerz <- httr::add_headers(.headers = c(
+    "Transfer-Encoding" = "chunked",
+    "plotly-streamtoken" = toks
+  ))
+  # request body
+  st <- list(stream = list(token = toks, maxpoints = 500))
+  resp <- httr::POST(get_domain("stream"), headerz)
+  httr::stop_for_status(resp)
+  
+  
+  list(
+    write = function() {},
+    close = function() {}
+  )
+}
+
+has_stream <- function() {
+  token <- Sys.getenv("plotly_streamtoken")
+  setNames(token != "", token)
+}

R/subplots.R

@@ -22,7 +22,7 @@
 
 
 ## TODO: throw warning if geo and non-geo coordinates are used!!!
-subplot <- function(..., nrows = 1, which_layout = "merge", margin = 0.1 /nrows) {
+subplot <- function(..., nrows = 1, which_layout = "merge", margin = 0.02) {
   # note that dots is a _list of plotlys_
   dots <- lapply(list(...), plotly_build)
   # put existing plot anchors and domain information into a tidy format
@@ -125,11 +125,11 @@ subplot <- function(..., nrows = 1, which_layout = "merge", margin = 0.1 /nrows)
       # (but overwrite domain/anchor info)
       l <- dots[[info$plot]]$layout
       p$layout[[xaxis]] <- modifyList(
-        l[names(l) %in% "xaxis"],
+        if (any(idx <- names(l) %in% "xaxis")) l[idx][[1]] else list(),
         list(domain = xdom, anchor = info$yaxis)
       )
       p$layout[[yaxis]] <- modifyList(
-        l[names(l) %in% "yaxis"],
+        if (any(idx <- names(l) %in% "yaxis")) l[idx][[1]] else list(),
         list(domain = ydom, anchor = info$xaxis)
       )
       p$data[[i]]$xaxis <- info$xaxis

R/utils.R

@@ -30,6 +30,8 @@ plotlyEnv <- new.env(parent = emptyenv())
 hash_plot <- function(df, p) {
   if (missing(df) || is.null(df)) df <- data.frame()
   hash <- digest::digest(p)
+  # terrible hack to ensure we can always find the most recent hash
+  hash <- paste(hash, length(ls(plotlyEnv)), sep = "#")
   assign(hash, p, envir = plotlyEnv)
   attr(df, "plotly_hash") <- hash
   # add plotly class mainly for printing method
@@ -45,19 +47,33 @@ hash_plot <- function(df, p) {
 #' the last plotly object created in this R session is returned (if it exists).
 #' 
 #' @param data a data frame with a class of plotly (and a plotly_hash attribute).
-get_plot <- function(data = NULL, strict = TRUE) {
+#' @param last if no plotly attribute is found, return the last plot or NULL?
+get_plot <- function(data = NULL, last = FALSE) {
   hash <- attr(data, "plotly_hash")
   if (!is.null(hash)) {
     get(hash, envir = plotlyEnv)
-  } else if (is.data.frame(data)) {
-    # safe to just grab the most recent environment?
-    hash <- rev(ls(plotlyEnv))[1]
-    plotlyEnv[[hash]]
+  } else if (last) {
+    envs <- strsplit(ls(plotlyEnv), "#")
+    last_env <- ls(plotlyEnv)[which.max(sapply(envs, "[[", 2))]
+    get(last_env, envir = plotlyEnv)
   } else {
-    data
+    data %||% list()
   }
 }
 
+#' Retrive last plotly to be modified or created
+#' 
+#' @seealso \link{plotly_build}
+#' @export
+#' 
+last_plot <- function(...) {
+  p <- get_plot(..., last = TRUE)
+  structure(
+    p, 
+    class = unique(c("plotly", class(p)))
+  )
+}
+
 # Check for credentials/configuration and throw warnings where appropriate
 verify <- function(what = "username") {
   val <- grab(what)

man/add_trace.Rd

@@ -4,7 +4,7 @@
 \alias{add_trace}
 \title{Add a trace to a plotly visualization}
 \usage{
-add_trace(p = get_plot(), ..., group, color, colors, symbol, symbols, size,
+add_trace(p = last_plot(), ..., group, color, colors, symbol, symbols, size,
   data = NULL, evaluate = FALSE)
 }
 \arguments{

man/get_plot.Rd

@@ -4,10 +4,12 @@
 \alias{get_plot}
 \title{Obtain underlying data of plotly object}
 \usage{
-get_plot(data = NULL, strict = TRUE)
+get_plot(data = NULL, last = FALSE)
 }
 \arguments{
 \item{data}{a data frame with a class of plotly (and a plotly_hash attribute).}
+
+\item{last}{if no plotly attribute is found, return the last plot or NULL?}
 }
 \description{
 Given a data frame with a class of plotly, this function returns the arguments

man/last_plot.Rd

@@ -0,0 +1,15 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/utils.R
+\name{last_plot}
+\alias{last_plot}
+\title{Retrive last plotly to be modified or created}
+\usage{
+last_plot(...)
+}
+\description{
+Retrive last plotly to be modified or created
+}
+\seealso{
+\link{plotly_build}
+}
+