plotly.R icon indicating copy to clipboard operation
plotly.R copied to clipboard

restyling a single point in a subplot using plotlyProxyInvoke does not work

Open JonP-16 opened this issue 3 years ago • 0 comments

I have a subplot comprised of multiple bar charts where I'm attempting to highlight single bars based on user input from another graphic; I'd like to highlight a bar in each of the subplots that the variable is present. I found that attempting to highlight only a single bar in a subplot does nothing; at least two variables need to be selected in order to highlight. Unfortunately, for my application, each subplot will have at most one instance of a variable so I'm unable to highlight a single bar.

This may be related to Targeting/Adding traces in subplot #1899, but with the obvious focus of restyling instead of adding traces.


library(shiny)
library(plotly)
library(tidyverse)

set.seed(1234)
my_data <- data.frame(
  xaxis = abs(rnorm(10)),
  yaxis = c(LETTERS[1:5], LETTERS[1:5]),
  group = rep(c('G1', 'G2'), each=5)
) %>%
  arrange(group, xaxis) %>%
  mutate_if(is.character, as.factor)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(width = 3,
               actionButton("button_1", "Highlight 1 bar"),
               actionButton("button_2", "Highlight 2 bar"),
               actionButton("button_reset", "Reset bars")),
  mainPanel(plotlyOutput("my_plot"))
))

server <- function(input, output, session) {
  output$my_plot <- renderPlotly({
    my_data %>%
      group_by(group) %>%
      do(
        p = highlight_key(., ~yaxis, group="temp_df-trellis") %>%
          plot_ly(., showlegend=FALSE, height = 2 * 200,
                  selected = list(marker = list(opacity = 1))) %>%
          add_trace(y = ~reorder(yaxis, xaxis), 
                    x = ~xaxis, 
                    color = ~group,
                    marker = list(opacity = .4, orientation = 'h'),
                    type='bar',
                    colors = c("#1F77B4FF", "#FF7F0EFF"))
      ) %>%
      subplot(nrows = NROW(.), titleX = TRUE, titleY = FALSE,
              shareX = TRUE, shareY = FALSE, margin = 0.015) %>%
      layout(showlegend = FALSE) 
  })
  
  observeEvent(input$button_reset, {
    plotlyProxy("my_plot", session) %>%
      plotlyProxyInvoke(method = "restyle",
                        list(selectedpoints = list(NULL)))
  },
  ignoreNULL = FALSE,
  ignoreInit = FALSE)
  
  observeEvent(input$button_1, {
    for (i in 1:2){
      plotlyProxy("my_plot", session) %>%
        plotlyProxyInvoke(method = "restyle", 
                          list(selectedpoints = list(
                            which(c(0, 0, 0, 0, 1) == TRUE) - 1
                          )), 
                          list(as.integer(i-1)))
    }
  },
  ignoreNULL = FALSE,
  ignoreInit = FALSE)
  
  observeEvent(input$button_2, {
    for (i in 1:2){
      plotlyProxy("my_plot", session) %>%
        plotlyProxyInvoke(method = "restyle", 
                          list(selectedpoints = list(
                            which(c(1, 0, 0, 0, 1) == TRUE) - 1
                          )), 
                          list(as.integer(i-1)))
    }
  },
  ignoreNULL = FALSE,
  ignoreInit = FALSE)
}

shinyApp(ui = ui, server = server)

JonP-16 avatar Sep 16 '22 16:09 JonP-16