Search code examples
rshinyplotlyggplotly

Problem getting a value from barplot in interactive plot with ggplotly in shiny


I want to do an app in shiny with a selectInput to select a Doctor, which generates a column-plot for different lymphoma types (lymphoma_types var, character) for this doctor. Then, I want a second plot when clicking in the bars of the plot, that gives all the doctors that had this particular lymphoma. For this, I used event_register("plotly_click") with observeEvent(event_data("plotly_click"), {clicked_value(event_data("plotly_click")$x) }). Problem is that the clicked value returned is not the value I want (lymphoma_types), but rather the column position (a number).

This is my code:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(forcats)

set.seed(123)
name <- c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Henry", "Ivy", "Jack", "Kate", "Liam", "Mia", "Noah", "Olivia")
lymphoma_types <- sample(c("DLBCL", "FL", "CLL"), 15, replace = TRUE)
Doctor <- sample(c("Quentin", "Rachel", "Samuel"), 15, replace = TRUE)

cdt<- data_frame(name, Doctor, lymphoma_types)    # My dataframe

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("Doc", "Doctor", choices = cdt$Doctor)
    ),
    mainPanel(
      plotlyOutput("colplot"),
      plotlyOutput("second_plot")
    )
  )
)

server <- function(input, output, session) {
  selected <- reactive({
    cdt %>%
      filter(Doctor == input$Doc)
  })
  
  clicked_value <- reactiveVal(NULL)
  
  output$colplot <- renderPlotly({
    if (nrow(selected()) == 0) {
      return(NULL)
    }
    
    p <- ggplot(selected(), aes(x = fct_rev(fct_infreq(lymphoma_types)), fill = lymphoma_types)) +
      geom_bar() +
      coord_flip() +
      theme_minimal()
    
    ggplotly(p) %>%
      event_register("plotly_click")
  })
  
  observeEvent(event_data("plotly_click"), {
    clicked_value(event_data("plotly_click")$x)
  })
  
  output$second_plot <- renderPlotly({
    clicked_count <- clicked_value()
    
    if (is.null(clicked_count)) {
      return(NULL)
    }
    
    clicked <- event_data("plotly_click")$x
    
    # Debugging statement
    print(clicked)
    
    # Find the corresponding lymphoma_types value based on the clicked position
    clicked_lymphoma_types <- unique(cdt$lymphoma_types)[round(clicked)]
    
    # Filter the dataset based on the selected lymphoma_types
    filtered_data <- cdt %>%
      filter(lymphoma_types == clicked_lymphoma_types)
    
    # Create a column plot with frequency of Médico
    p <- ggplot(filtered_data, aes(x = Doctor)) +
      geom_bar() +
      theme_minimal() +
      labs(title = paste("Frequency of doctors for", clicked_lymphoma_types))
    
    ggplotly(p)
  })
}
shinyApp(ui, server)

The first part works fine. Even when I hover over the column it indicates the correct value, but I am not able to get that value with event_data("plotly_click")$x.

Any ideas?


Solution

  • Add key = lymphoma_types in aes of the ggplot. This key can then be accessed by event_data("plotly_click")$key and used for filtering.

    library(shiny)
    library(ggplot2)
    library(plotly)
    library(dplyr)
    library(forcats)
    
    set.seed(123)
    name <- c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Henry", "Ivy", "Jack", "Kate", "Liam", "Mia", "Noah", "Olivia")
    lymphoma_types <- sample(c("DLBCL", "FL", "CLL"), 15, replace = TRUE)
    Doctor <- sample(c("Quentin", "Rachel", "Samuel"), 15, replace = TRUE)
    
    cdt <- data.frame(name, Doctor, lymphoma_types)    # My dataframe
    
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          selectInput("Doc", "Doctor", choices = cdt$Doctor)
        ),
        mainPanel(
          plotlyOutput("colplot"),
          plotlyOutput("second_plot")
        )
      )
    )
    
    server <- function(input, output, session) {
      selected <- reactive({
        cdt %>%
          filter(Doctor == input$Doc)
      })
      
      clicked_value <- reactiveVal(NULL)
      
      output$colplot <- renderPlotly({
        if (nrow(selected()) == 0) {
          return(NULL)
        }
        
        p <- ggplot(selected(), aes(x = fct_rev(fct_infreq(lymphoma_types)), fill = lymphoma_types,
                                    key = lymphoma_types)) +
          geom_bar() +
          coord_flip() +
          theme_minimal()
        
        ggplotly(p) %>%
          event_register("plotly_click")
      })
      
      observeEvent(event_data("plotly_click"), {
        clicked_value(event_data("plotly_click")$x)
      })
      
      output$second_plot <- renderPlotly({
        clicked_count <- clicked_value()
        
        if (is.null(clicked_count)) {
          return(NULL)
        }
        
        clicked_lymphoma_types <- event_data("plotly_click")$key
        
        # Filter the dataset based on the selected lymphoma_types
        filtered_data <- cdt %>%
          filter(lymphoma_types == clicked_lymphoma_types)
        
        # Create a column plot with frequency of Médico
        p <- ggplot(filtered_data, aes(x = Doctor)) +
          geom_bar() +
          theme_minimal() +
          labs(title = paste("Frequency of doctors for", clicked_lymphoma_types))
        
        ggplotly(p)
      })
    }
    shinyApp(ui, server)