Update shinydashboard input value selected based on plotly click


#1

I'm trying to recreate the drill down functionality using shinydashboard and plotly based on Edgar's samples using HighCharter and r2d3. I'm trying to avoid the additional cost of highcharter and as a lone developer I don't think I can take on developing all the plots in d3.
Highcharts - https://edgarruiz.shinyapps.io/flights-dashboard/
r2d3 - https://edgarruiz.shinyapps.io/db-dashboard/

I've created a simple app to demonstrate what I'm trying to do. I'm trying to update the select input based on the plotly click that occurs on the line graph (similar to how it works in Edgar's highcharter example). I've played around with updateSelectInput, observe, observeEvent and custom js, but I haven't found the right solution. Any insight on what the right approach is to do this?


library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)
library(nycflights13)
library(shinyjs)
library(V8)

ui <-  dashboardPage(skin = "black",
                     dashboardHeader(
                       title="Test App"
                     ),
                     dashboardSidebar(sidebarMenu(id = "sidebar",
                                                  menuItem("Tab One", tabName = "tabOne", icon = icon("heartbeat")),
                                                  menuItem("Tab Two", tabName = "tabTwo", icon = icon("warning"))
                     )),
                     dashboardBody(
                       useShinyjs(),
                       extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
                       #extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
                       tabItems(
                         tabItem(tabName = "tabOne",
                                 fluidPage(
                                   shiny::column(width = 2,
                                                 selectInput("month","Month: ", unique(nycflights13::flights$month))
                                   ),
                                   shiny::column(width = 5,
                                                 plotlyOutput("plot1")
                                   ),
                                   shiny::column(width = 5,
                                                 plotlyOutput("plot2")
                                   )
                                 )
                         ),
                         tabItem(tabName = "tabTwo",
                                 h2("Test")
                         )
                       )
                     )
)


server <- function(input, output, session) {
  
  output$plot1 <- renderPlotly({
    
    result <- nycflights13::flights %>% 
      group_by(month) %>% 
      count()
    
    plot <- result %>% 
      ggplot(aes(x = month, y = n)) + 
      geom_point(aes(text = paste0("Flight Count: ", n)), size = 1.5) +
      geom_line(size = 1) + 
      labs(x="Month",y="")
    
    plot %>% 
      ggplotly(tooltip = c("text"), source = "month_select")
    
  })
  
  output$plot2 <- renderPlotly({
    
    # Get month based on click
    event_data <- event_data("plotly_click", source = "month_select")
    print(event_data)
    
    selected_month <- input$month
    if(!is.null(event_data)) {
      selected_month <- event_data[[3]]
    }
    
    print(selected_month)
    
    result <- nycflights13::flights %>% 
      filter(month == selected_month) %>% 
      group_by(carrier) %>% 
      count()

    
    plot <- result %>% 
      ggplot(aes(x = carrier, y = n)) + 
      geom_bar(stat="identity") + 
      labs(x="Airline",y="Flight Count")
    
    plot %>% 
      ggplotly()
    
  })
  
  observeEvent(input$month, {
    js$resetClick()
  })

 
}

# Run the application 
shinyApp(ui = ui, server = server)



#2

I finally figured out the solution, you can use observeEvent to watch the event_data. I added the following to my server code. Hope this helps someone else in the future.

  observeEvent(event_data("plotly_click", source = "month_select"), {
    
    event_data <- event_data("plotly_click", source = "month_select")
    
    updateVarSelectInput(session, "month", selected = event_data[[3]])
    
  })