Parallel coordinates plot not triggering events with Shiny

Hi,

There is a bug regarding the events sent by parallel coordinates plot in shiny.
As far as I understand it, parallel coordinates are really different from usual plotly plots, as their axis, labels etc. do not work the same way as the others.
The events are also affected, as they aren't emmited the same way as in other plots.

Here's an adapted version of the example given in Shiny Gallery.

suppressPackageStartupMessages(library(plotly))
library(shiny)

ui <- fluidPage(
  plotlyOutput("parcoords"),
  verbatimTextOutput("hover"),
  verbatimTextOutput("click"),
  verbatimTextOutput("brush"),
  verbatimTextOutput("zoom")
)

server <- function(input, output, session) {
  
  output$parcoords <- renderPlotly({
    p <- plot_ly(data = iris, 
                type = 'parcoords',
                dimensions = list(
                list(range = c(min(iris$Sepal.Width), max(iris$Sepal.Width)),
                     label = 'Sepal Width', values = ~Sepal.Width),
                list(range = c(min(iris$Sepal.Length), max(iris$Sepal.Length)),
                     label = 'Sepal Length', values = ~Sepal.Length),
                list(range = c(min(iris$Petal.Width), max(iris$Petal.Width)),
                     label = 'Petal Width', values = ~Petal.Width),
                list(range = c(min(iris$Petal.Length), max(iris$Petal.Length)),
                     label = 'Petal Length', values = ~Petal.Length)
              )
      )
    p
  })
  
  output$hover <- renderPrint({
    d <- event_data("plotly_hover")
    if (is.null(d)) "Hover events appear here (unhover to clear)" else d
  })
  
  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" else d
  })
  
  output$brush <- renderPrint({
    d <- event_data("plotly_selected")
    if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d
  })
  
  output$zoom <- renderPrint({
    d <- event_data("plotly_relayout")
    if (is.null(d)) "Relayout (i.e., zoom) events appear here" else d
  })
  
}

shinyApp(ui, server)

Created on 2018-08-10 by the reprex package (v0.2.0).

As you can see when running this, whatever you do, no event is ever triggered (the 4 verbatim outputs remain with their default text).
This is because in parallel coordinates plots, none of plotly_hover, plotly_click, plotly_selected or plotly_relayout are ever called.

What's called, when brushing a selection, is the js plotly_restyle event.

But this event contains not many significant thing, that is, only the last brushed selection, thus, not enabling to have a clear vision of what's selected.
Here's a demo app, using a custom binding with htmlwidgets::onRender(), showing the content of the event :

suppressPackageStartupMessages(library(plotly))
library(htmlwidgets)
library(shiny)

ui <- fluidPage(
  plotlyOutput("parcoords"),
  verbatimTextOutput("restyle")
)

server <- function(input, output, session) {
  
  output$parcoords <- renderPlotly({
    p <- plot_ly(data = iris, 
                 type = 'parcoords',
                 dimensions = list(
                   list(range = c(min(iris$Sepal.Width), max(iris$Sepal.Width)),
                        label = 'Sepal Width', values = ~Sepal.Width),
                   list(range = c(min(iris$Sepal.Length), max(iris$Sepal.Length)),
                        label = 'Sepal Length', values = ~Sepal.Length),
                   list(range = c(min(iris$Petal.Width), max(iris$Petal.Width)),
                        label = 'Petal Width', values = ~Petal.Width),
                   list(range = c(min(iris$Petal.Length), max(iris$Petal.Length)),
                        label = 'Petal Length', values = ~Petal.Length)
                 )
    )
    onRender(p, "function(el, x) {
    el.on('plotly_restyle', function(d) {
      console.log(d);
      Shiny.setInputValue('plotly_restyle', JSON.stringify(d));
    });
  }"
             )
  })

  output$restyle <- renderPrint({
    d <- input$plotly_restyle
    if (is.null(d)) "Restyle events appear here" else d
  })
}

shinyApp(ui, server)

Created on 2018-08-10 by the reprex package (v0.2.0).

As you can see, only the last selected dimension is shown, resulting in this json object:

[
  {
    "dimensions[2].constraintrange": [
      [
        0.08125,
        0.6906249999999999
      ]
    ]
  },
  [
    0
  ]
]

Stringified, this results in this R string : ``` r
"[{"dimensions[2].constraintrange":[[0.08125,0.6906249999999999]]},[0]]"

So, using the content of `plotly_restyle` is not enough, as it only gives informations on the lastly selected dimension.

For my part, as a workaround, I'm using a custom js function, so that all the filters are returned :

``` js
function(el, x) {
   el.on('plotly_restyle', function(d) {
     var dimensionsBrushed = el.data[0].dimensions.map(function(x){return({label: x.label, constraintrange: x.constraintrange})});
     Shiny.setInputValue('plotly_brushed', JSON.stringify(dimensionsBrushed));
   });
 }

I should note that I stringify this content instead of returning the js object directly because jsonlite conversions loose many informations about the object here. So, I have to do a custom R handling of this string, resulting in this demo app :

suppressPackageStartupMessages(library(plotly))
library(htmlwidgets)
library(shiny)
library(tibble)
library(purrr)

ui <- fluidPage(
  plotlyOutput("parcoords"),
  verbatimTextOutput("restyle"),
  tableOutput("brushed")
)

server <- function(input, output, session) {
  
  output$parcoords <- renderPlotly({
    p <- plot_ly(data = iris, 
                 type = 'parcoords',
                 dimensions = list(
                   list(range = c(min(iris$Sepal.Width), max(iris$Sepal.Width)),
                        label = 'Sepal Width', values = ~Sepal.Width),
                   list(range = c(min(iris$Sepal.Length), max(iris$Sepal.Length)),
                        label = 'Sepal Length', values = ~Sepal.Length),
                   list(range = c(min(iris$Petal.Width), max(iris$Petal.Width)),
                        label = 'Petal Width', values = ~Petal.Width),
                   list(range = c(min(iris$Petal.Length), max(iris$Petal.Length)),
                        label = 'Petal Length', values = ~Petal.Length)
                 )
    )
    onRender(p, "function(el, x) {
    el.on('plotly_restyle', function(d) {
      var dimensionsBrushed = el.data[0].dimensions.map(function(x){return({label: x.label, constraintrange: x.constraintrange})});
      Shiny.setInputValue('plotly_brushed', JSON.stringify(dimensionsBrushed));
    });
  }")
  })

  output$restyle <- renderPrint({
    d <- input$plotly_brushed
    if (is.null(d)) "Brushed events appear here" else d
  })
  
  output$brushed <- renderTable({
    if (is.null( input$plotly_brushed)){
      "Dataframed-brushed events appear here"
    } else {
      inputJSON <- input$plotly_brushed
      filterDF <- jsonlite::fromJSON(txt = inputJSON,
                                     simplifyMatrix = FALSE,
                                     simplifyDataFrame = FALSE) %>%
        purrr::compact(.x = ., "constraintrange") %>%
        tibble(listcol = .) %>%
        mutate(var = map_chr(listcol, "label")) %>%
        mutate(range = map(listcol, "constraintrange")) %>%
        select(-listcol) %>%
        mutate(min = map_dbl(range, 1),
               max = map_dbl(range, 2)) %>%
        select(-range)
      filterDF
    }
  })
}

shinyApp(ui, server)

Created on 2018-08-10 by the reprex package (v0.2.0).

Of course, this solution isn't optimal, because :

• With current R transformation of the json, it doens't handle multi-selections, ie. multiple brush on a single dimension
• The plotly_restyle seems to be meaning different things among plotly plots, and thus, using such a code wouldn't be generic among plots for this R package.

Yet, eventhough I currently don't have time to work on a PR (I just discovered plotly, and can't spend many time trying to understand the bindings with R right now), it would be fantastic if you could take this issue into consideration, and maybe use my "findings" (related to how events work with parallel coordinates) to fix this troublesome issue.

先从提供的 Shiny 复现示例和 event_data() 调用开始，然后将它们与针对 plotly_restyle 的自定义 htmlwidgets::onRender() 处理程序进行比较。跟踪平行坐标事件如何到达 R/Shiny binding。完成的标准是：文档化的事件输入能够报告相关的 hover、click、selection 或 relayout 变化，并在支持的情况下包含完整的 brush 状态。