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 1:
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)