我想做一个闪亮的应用程序,带有 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
获取该值有什么想法吗?谢谢
在
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)