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 の完全な状態も含めます。