rshinyplotlyr-plotlyparallel-coordinates

Looking to trigger an observeEvent after manually reordering the dimensions of a plotly parcoord plot

I am using the plotly parcoords to generate a parallel coordinate plot. Now, the idea is when the user drags the column axes and manually changes the order of the dimensions in the plot, I want to generate a text displaying some value based on that column order. But I am not sure how to do that. I am not even sure if that's possible at all. I know I have to use an observeEvent, but not exactly sure what to observe. I am quite new to R Shiny. Please help!

UI:

fluidRow(
    textOutput(outputId = "PlotScoreText")),
fluidRow(
  plotlyOutput("ParallelChart"))

Server:

observeEvent(input$ParallelChart, {
output$PlotScoreText <- renderText(getScoreText())})
output$ParallelChart <- renderPlotly({
  getParallelChart()
})

getParallelChart <- function() {
    
    p <- plot_ly(type = 'parcoords', line = list(color = 'blue'),
         dimensions = list(
           list(range = c(1,5),
                constraintrange = c(1,2),
                label = 'A', values = c(1,4)),
           list(range = c(1,5),
                tickvals = c(1.5,3,4.5),
                label = 'B', values = c(3,1.5)),
           list(range = c(1,5),
                tickvals = c(1,2,4,5),
                label = 'C', values = c(2,4),
                ticktext = c('text 1', 'text 2', 'text 3', 'text 4')),
           list(range = c(1,5),
                label = 'D', values = c(4,2))
           )
         )
    
    p
}

For example, after the above plot gets rendered, if the user drags dimension C to be in front of B, I want the observeEvent for the output$PlotScoreText to get triggered. Is there any way to do this?

Solution

  • We can use plotly's event_data() to access the current axes order (modifying the order results in a restyle event):

    library(shiny)
library(plotly)

ui <- fluidPage(
  fluidRow(textOutput(outputId = "PlotScoreText")),
  fluidRow(textOutput(outputId = "renderTextOutput")),
  fluidRow(plotlyOutput("ParallelChart"))
)

server <- function(input, output, session) {
  
  output$ParallelChart <- renderPlotly({
    p <- plot_ly(type = 'parcoords', line = list(color = 'blue'),
                 dimensions = list(
                   list(range = c(1,5),
                        constraintrange = c(1,2),
                        label = 'A', values = c(1,4)),
                   list(range = c(1,5),
                        tickvals = c(1.5,3,4.5),
                        label = 'B', values = c(3,1.5)),
                   list(range = c(1,5),
                        tickvals = c(1,2,4,5),
                        label = 'C', values = c(2,4),
                        ticktext = c('text 1', 'text 2', 'text 3', 'text 4')),
                   list(range = c(1,5),
                        label = 'D', values = c(4,2))
                 ), source = "pcoords_events") %>%
      event_register("plotly_restyle")
  })
  
  axesOrder <- reactiveVal(paste("Axes order:", paste(c(LETTERS[1:4]), collapse = ", ")))
  
  observeEvent(event_data("plotly_restyle", source = "pcoords_events"), {
    d <- event_data("plotly_restyle", source = "pcoords_events")
    axesOrder(paste("Axes order:", paste(d[[1]]$dimensions[[1]]$label, collapse = ", ")))
  })
  
  output$PlotScoreText <- renderText({
    axesOrder()
  })
  
  output$renderTextOutput <- renderText({
    d <- event_data("plotly_restyle", source = "pcoords_events")
    paste("renderTextOutput: Axes order:", paste(d[[1]]$dimensions[[1]]$label, collapse = ", "))
  })
}

shinyApp(ui, server)

    result