Add support for direct importing of plotly figures into DashR apps #71

rpkyle · 2019-03-28T20:31:46Z

This PR proposes to recursively crawl a DashR app's layout, identify components which supply an x$visdat sublist, then post-process these using the plotly_build function in the plotly R package. The goal is to import and mutate the resulting R object such that Plotly visualizations can be seamlessly included in a DashR app.

A brief demo app is included in a comment below.

Closes #62.

rpkyle · 2019-03-28T20:34:53Z

library(dashR)
library(plotly)
library(dashHtmlComponents)
library(dashCoreComponents)

app <- Dash$new(external_stylesheets = "https://codepen.io/chriddyp/pen/bWLwgP.css")

  app$layout(
    htmlDiv(list(
      htmlDiv(list(
        htmlH3("Plotly.js importing test using Edgar Anderson's iris data")
      ),
      className = 'row'),
      htmlDiv(list(
        dccDropdown(id = 'species-selector',
                    value = list('setosa', 'versicolor', 'virginica'),
                    options = list(list(value = "setosa",
                                        label = "Setosa"),
                                   list(value = "versicolor",
                                        label = "Versicolor"),
                                   list(value = "virginica",
                                        label = "Virginica")),
                    multi = TRUE)),
        className = 'row'),
      htmlDiv(list(
        htmlH4('Sepal width (cm) vs. sepal length (cm)', className = 'six columns'),
        htmlH4('Petal length (cm) vs. sepal length (cm)', className = 'six columns')
      ),
      className = 'row'),
      htmlDiv(list(
        htmlDiv(
          id = 'div-sepal-sepal',
          className = 'six columns'),
        htmlDiv(
          id = 'div-petal-sepal',
          className = 'six columns')), 
        className='row')
    )
    )
)
  
  app$callback(output=list(id='div-petal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                
                 dccGraph(id = 'graph-petal-sepal', figure = plot_ly(data = subdata, x = ~Sepal.Length, y = ~Petal.Length))
               }
  )
  
  app$callback(output=list(id='div-sepal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                 
                 dccGraph(id = 'graph-sepal-sepal', figure = plot_ly(data = subdata, x = ~Sepal.Length, y = ~Sepal.Width))
               }
  )
  
app$run_server()

rpkyle · 2019-03-28T21:28:27Z

...and here's a second example, but using ggplotly.

  app$callback(output=list(id='div-petal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                
                 ggiris <- qplot(Sepal.Length, Petal.Length, data = subdata, color = Species)
                 
                 dccGraph(id = 'graph-petal-sepal', figure = ggplotly(ggiris))
               }
  )
  
  app$callback(output=list(id='div-sepal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                 
                 ggiris <- qplot(Sepal.Length, Sepal.Width, data = subdata, color = Species)
                 
                 dccGraph(id = 'graph-sepal-sepal', figure = ggplotly(ggiris))
               }
  )

rpkyle · 2019-03-28T21:28:52Z

@KPhans

TahiriNadia · 2019-03-28T23:59:13Z

Error in the first example

app <- Dash$new(external_stylesheets = "https://codepen.io/chriddyp/pen/bWLwgP.css")

  app$layout(
    htmlDiv(list(
      htmlDiv(list(
        htmlH3("Plotly.js importing test using Edgar Anderson's iris data")
      ),
      className = 'row'),
      htmlDiv(list(
        dccDropdown(id = 'species-selector',
                    value = list('setosa', 'versicolor', 'virginica'),
                    options = list(list(value = "setosa",
                                        label = "Setosa"),
                                   list(value = "versicolor",
                                        label = "Versicolor"),
                                   list(value = "virginica",
                                        label = "Virginica")),
                    multi = TRUE)),
        className = 'row'),
      htmlDiv(list(
        htmlH4('Sepal width (cm) vs. sepal length (cm)', className = 'six columns'),
        htmlH4('Petal length (cm) vs. sepal length (cm)', className = 'six columns')
      ),
      className = 'row'),
      htmlDiv(list(
        htmlDiv(
          id = 'div-sepal-sepal',
          className = 'six columns'),
        htmlDiv(
          id = 'div-petal-sepal',
          className = 'six columns')), 
        className='row')
    )
    )
  )

rpkyle · 2019-03-29T03:13:09Z

Error in the first example

Yep, two extra close parens, just removed them. Thanks!

alexcjohnson · 2019-04-01T02:10:12Z

R/utils.R

+    element <- layout_objs[[i]]
+    if (is.list(element) && 
+        "x" %in% names(layout_objs) && 
+        "visdat" %in% names(layout_objs$x)) {


Why is this in the loop if it's going to replace the whole layout_objs? Couldn't we do something like

if ("x" %in% names(layout_objs) && "visdat" %in% names(layout_objs$x)) { obj <- suppressMessages(plotly::plotly_build(layout_objs[[something??]])$x) return obj[c("data", "layout")] } for (i in seq_along(layout_objs)) { element <- layout_objs[[i]] # the logic for the last two cases also seems backward as you have it # in any event you should only need to call is.list(element) once if (is.list(element) && any(sapply(element, is.list))) { layout_objs[[i]] <- encode_plotly(element) } }

# the logic for the last two cases also seems backward as you have it # in any event you should only need to call is.list(element) once

If it's a list that contains no other lists, and is also not a plotly object, we jump to the next value of i. If it's a nested list, we recurse. It probably makes more sense to rewrite, and omit the preceding else if:

else if (is.list(element) & any(sapply(element, is.list))) { layout_objs[[i]] <- encode_plotly(element) }

I believe we still need two references to is.list in the line above to check for nested list elements.

After a very helpful discussion with @alexcjohnson, the function is (hopefully) somewhat cleaner and should now handle figure objects which are themselves not nested within a larger list.

fixed in 2ca9b15

alexcjohnson · 2019-04-03T15:15:19Z

R/utils.R

+    obj <- suppressMessages(plotly::plotly_build(layout_objs)$x)
+    layout_objs <- obj[c("data", "layout")]
+    return(layout_objs)
+  } else {


Is there anything we can bail out on here, and not fall into seq_along at all? Like perhaps pop the is.list up above out to wrap everything else:

if(is.list(layout_objs)) { if("x" %in% names(layout_objs) && "visdat" %in% names(layout_objs$x)) { ... } else { for (i in seq_along(layout_objs)) { ... } } } layout_objs

I'm thinking particularly about simple values like strings making it here from callbacks.

(Thanks for the update BTW, this already looks much cleaner and I suspect will perform a good deal better as well)

Thanks for the feedback, this feels like a much cleaner, leaner implementation now. 🤞that this is ready to 💃

(hopefully) fixed in f1cc83f

alexcjohnson

💃 Looks good!

heoa · 2019-08-14T08:31:43Z

Is there any documentation or a working minimal example about ggplot2 objects in dashR?

rpkyle · 2019-08-14T12:16:24Z

Is there any documentation or a working minimal example about ggplot2 objects in dashR?

Greetings @heoa; yes, there is a working, minimal example (actually, it's contained within this PR above, but I'll include the complete version here).

library(dash)
library(plotly)
library(dashHtmlComponents)
library(dashCoreComponents)

app <- Dash$new(external_stylesheets = "https://codepen.io/chriddyp/pen/bWLwgP.css")

  app$layout(
    htmlDiv(list(
      htmlDiv(list(
        htmlH3("Plotly.js importing test using Edgar Anderson's iris data")
      ),
      className = 'row'),
      htmlDiv(list(
        dccDropdown(id = 'species-selector',
                    value = list('setosa', 'versicolor', 'virginica'),
                    options = list(list(value = "setosa",
                                        label = "Setosa"),
                                   list(value = "versicolor",
                                        label = "Versicolor"),
                                   list(value = "virginica",
                                        label = "Virginica")),
                    multi = TRUE)),
        className = 'row'),
      htmlDiv(list(
        htmlH4('Sepal width (cm) vs. sepal length (cm)', className = 'six columns'),
        htmlH4('Petal length (cm) vs. sepal length (cm)', className = 'six columns')
      ),
      className = 'row'),
      htmlDiv(list(
        htmlDiv(
          id = 'div-sepal-sepal',
          className = 'six columns'),
        htmlDiv(
          id = 'div-petal-sepal',
          className = 'six columns')), 
        className='row')
    )
    )
)

  app$callback(output=list(id='div-petal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                
                 ggiris <- qplot(Sepal.Length, Petal.Length, data = subdata, color = Species)
                 
                 dccGraph(id = 'graph-petal-sepal', figure = ggplotly(ggiris))
               }
  )
  
  app$callback(output=list(id='div-sepal-sepal', property='children'),
               params=list(
                 input(id='species-selector', property='value')),
               function(species)
               {
                 if (!(length(species))) {
                   subdata <- iris
                 } else {
                   subdata <- iris[which(iris$Species == species),]                 
                 }
                 
                 ggiris <- qplot(Sepal.Length, Sepal.Width, data = subdata, color = Species)
                 
                 dccGraph(id = 'graph-sepal-sepal', figure = ggplotly(ggiris))
               }
  )

app$run_server()

heoa · 2019-08-15T06:37:06Z

@rpkyle why did you use qplot in the minimal working example instead of ggplot in the minimal working example? Is qplot better supported than directly using ggplot?

https://ggplot2.tidyverse.org/reference/qplot.html

qplot is a shortcut designed to be familiar if you're used to base plot(). It's a convenient wrapper for creating a number of different types of plots using a consistent calling scheme. It's great for allowing you to produce plots quickly, but I highly recommend learning ggplot() as it makes it easier to create complex graphics.

so I guess there should be no big difference to use directly ggplot, instead of qplot, but I woud like to understand this clearly.

It would be super useful to see different kind of examples: this was categorial selection. I add some small working examples below I created.

Starting time slider

library(data.table)
library(dash)
library(plotly)
library(dashHtmlComponents)
library(dashCoreComponents)
library(ggthemes)

app <- Dash$new(external_stylesheets = "https://codepen.io/chriddyp/pen/bWLwgP.css")

app$layout(
  htmlDiv(list(
    htmlDiv(list(
      htmlH3("Plotly.js importing test using BOD data")
    ),
    className = 'row'),
    htmlDiv(list(
      dccSlider(id   = 'starting-time-slider',min  = 1,max  = 7,step = 1,value= 1)),
      className = 'row'),
    htmlDiv(list(
      htmlH4('Time selector', className = 'six columns')
    ),
    className = 'row'),
    htmlDiv(list(
      htmlDiv(
        id = 'div-ts',
        className = 'six columns')), 
      className='row')
  )
  )
)

app$callback(output=list(id='div-ts', property='children'),
             params=list(
               input(id='starting-time-slider', property='value')),
             function(StartTime)
             {
               subdata <- BOD[BOD$Time>StartTime,]                 
               ggts <- ggplot(subdata) + 
                 aes(x=Time, y=demand) + geom_point() + geom_smooth() + theme_economist()
               dccGraph(id = 'graph-ts', figure = ggplotly(ggts))
             }
)

app$run_server()

I moved the demos here: #118

rpkyle · 2019-08-15T12:23:19Z

@rpkyle why did you use qplot in the minimal working example instead of ggplot in the minimal working example? Is qplot better supported than directly using ggplot?

Either will work equally well; you can use ggplot2 or qplot, both are easy to insert into Dash for R apps. The same plot could be generated using ggplot with a few more characters:

ggplot(data=iris, aes(x = Sepal.Length, y = Petal.Length)) + geom_point(aes(color=Species)) +
    xlab("Sepal Length") +  ylab("Petal Length")

Both approaches create an object of class ggplot:

> irisplot <- qplot(Sepal.Length, Petal.Length, data = iris, color = Species)
> class(irisplot)
[1] "gg"     "ggplot"

TahiriNadia and others added 3 commits March 28, 2019 15:57

🚚 rename core* to dcc*

26627c8

➕ import plotly 📦 and update version

9135534

✨ add support for importing plot_ly objs

187b819

rpkyle requested a review from alexcjohnson March 28, 2019 20:35

rpkyle self-assigned this Mar 28, 2019

rpkyle added this to the DashR Launch milestone Mar 28, 2019

rpkyle added the enhancement label Mar 28, 2019

TahiriNadia self-requested a review March 28, 2019 22:44

alexcjohnson reviewed Apr 1, 2019

View reviewed changes

🔨 refactored encode_plotly

2ca9b15

alexcjohnson reviewed Apr 3, 2019

View reviewed changes

rpkyle and others added 3 commits April 9, 2019 15:39

🔨 clean up and simplify fn further

f1632fd

🐾 relocate list test to simplify one step further

f1cc83f

Merge branch 'master' into 0.0.5-issue62

86acc4a

rpkyle requested a review from alexcjohnson April 9, 2019 20:04

plotly deleted a comment from TahiriNadia Apr 9, 2019

alexcjohnson approved these changes Apr 9, 2019

View reviewed changes

rpkyle merged commit f184090 into master Apr 9, 2019

rpkyle deleted the 0.0.5-issue62 branch April 9, 2019 21:31

This was referenced Aug 14, 2019

Refactor current approach to importing ggplotly and plot_ly objects in DashR #60

Open

How to embed a full HTML document in Dash for R? #117

Closed

heoa mentioned this pull request Aug 15, 2019

R ggplot minimal working examples for dashR? #118

Closed

rpkyle mentioned this pull request Feb 19, 2020

Replace all instances of plot.ly with plotly.com. #180

Merged

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Add support for direct importing of plotly figures into DashR apps #71

Add support for direct importing of plotly figures into DashR apps #71

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

TahiriNadia commented Mar 28, 2019 •

edited by rpkyle

Loading

rpkyle commented Mar 29, 2019

alexcjohnson Apr 1, 2019

rpkyle Apr 1, 2019 •

edited

Loading

rpkyle Apr 3, 2019 •

edited

Loading

rpkyle Apr 3, 2019

alexcjohnson Apr 3, 2019

alexcjohnson Apr 3, 2019

rpkyle Apr 9, 2019

rpkyle Apr 9, 2019

alexcjohnson left a comment

heoa commented Aug 14, 2019 •

edited

Loading

rpkyle commented Aug 14, 2019 •

edited

Loading

heoa commented Aug 15, 2019 •

edited

Loading

rpkyle commented Aug 15, 2019 •

edited

Loading

Add support for direct importing of plotly figures into DashR apps #71

Add support for direct importing of plotly figures into DashR apps #71

Conversation

rpkyle commented Mar 28, 2019 • edited Loading

rpkyle commented Mar 28, 2019 • edited Loading

rpkyle commented Mar 28, 2019 • edited Loading

rpkyle commented Mar 28, 2019 • edited Loading

TahiriNadia commented Mar 28, 2019 • edited by rpkyle Loading

rpkyle commented Mar 29, 2019

alexcjohnson Apr 1, 2019

Choose a reason for hiding this comment

rpkyle Apr 1, 2019 • edited Loading

Choose a reason for hiding this comment

rpkyle Apr 3, 2019 • edited Loading

Choose a reason for hiding this comment

rpkyle Apr 3, 2019

Choose a reason for hiding this comment

alexcjohnson Apr 3, 2019

Choose a reason for hiding this comment

alexcjohnson Apr 3, 2019

Choose a reason for hiding this comment

rpkyle Apr 9, 2019

Choose a reason for hiding this comment

rpkyle Apr 9, 2019

Choose a reason for hiding this comment

alexcjohnson left a comment

Choose a reason for hiding this comment

heoa commented Aug 14, 2019 • edited Loading

rpkyle commented Aug 14, 2019 • edited Loading

heoa commented Aug 15, 2019 • edited Loading

rpkyle commented Aug 15, 2019 • edited Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

rpkyle commented Mar 28, 2019 •

edited

Loading

TahiriNadia commented Mar 28, 2019 •

edited by rpkyle

Loading

rpkyle Apr 1, 2019 •

edited

Loading

rpkyle Apr 3, 2019 •

edited

Loading

heoa commented Aug 14, 2019 •

edited

Loading

rpkyle commented Aug 14, 2019 •

edited

Loading

heoa commented Aug 15, 2019 •

edited

Loading

rpkyle commented Aug 15, 2019 •

edited

Loading