使用闪亮的ggplotly从交互式图中的条形图中获取值时出现问题

Question

我想做一个闪亮的应用程序，带有 selectInput 来选择医生，它为该医生生成不同淋巴瘤类型（lymphoma_types var，character）的柱状图。然后，当单击图的条形时，我想要第二个图，它给出了所有患有这种特殊淋巴瘤的医生。为此，我使用了 event_register("plotly_click") 和observeEvent(event_data("plotly_click"), {clicked_value(event_data("plotly_click")$x) })。问题是，点击返回的值不是我想要的值（lymphoma_types），而是列位置（数字）。

这是我的代码：

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

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)

第一部分工作正常。即使当我将鼠标悬停在该列上时，它也会指示正确的值，但我无法使用 event_data("plotly_click")$x

获取该值

有什么想法吗？谢谢

Answer 1

在

key = lymphoma_types

的

aes

中添加

ggplot

。然后可以通过

key

访问此

event_data("plotly_click")$key

并用于过滤。

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)