Shiny应用优化：Plotly多点击点存储与SUBSET触发子集化
2026-8-11
优化Shiny应用：支持多选中点后批量子集化
需求背景
现有Shiny应用实现了单点击图表点后自动子集化其他图表的功能，需优化为：
- 支持在任意Plotly图表中多选多个点
- 点击
SUBSET按钮后，才执行数据子集化操作 - 保留原有的
RESET重置功能
修改后的完整代码
library(shiny) library(shinydashboard) library(plotly) library(dplyr) library(ggplot2) library(bupaR) pr59<-structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689", "WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068", "WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110, 120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877", "WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950", "WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308", "WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"), activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", "BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning", "SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419", "3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030", "C3-090", "C3-080"), timestamp = structure(c(1606964400, 1607115480, 1607435760, 1607568120, 1607630220, 1607670780, 1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct", "POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog", "log", "tbl_df", "tbl", "data.frame"), spec = structure(list( cols = list(case_id = structure(list(), class = c("collector_character", "collector")), lifecycle = structure(list(), class = c("collector_double", "collector")), action = structure(list(), class = c("collector_character", "collector")), activity = structure(list(), class = c("collector_character", "collector")), resource = structure(list(), class = c("collector_character", "collector")), timestamp = structure(list(), class = c("collector_character", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp") ui <- tags$body( dashboardPage( header = dashboardHeader(), sidebar = dashboardSidebar( actionButton("sub","SUBSET"), actionButton("res","RESET") ), body = dashboardBody( plotlyOutput("plot1"), plotlyOutput("plot2"), plotlyOutput("plot3") ) ) ) server <- function(input, output, session) { # 存储用户选中的日期（多选） selected_dates <- reactiveVal(NULL) # 存储最终用于过滤的数据 filtered_data <- reactiveVal(pr59) # 监听三个图表的多选事件 observe({ sel1 <- event_data("plotly_selected", source = "myPlotSource1") sel2 <- event_data("plotly_selected", source = "myPlotSource2") sel3 <- event_data("plotly_selected", source = "myPlotSource3") # 合并三个图表的选中日期，去重 all_sel_dates <- c( if(!is.null(sel1)) as.Date(sel1$customdata), if(!is.null(sel2)) as.Date(sel2$customdata), if(!is.null(sel3)) as.Date(sel3$customdata) ) %>% unique() if(length(all_sel_dates) > 0){ selected_dates(all_sel_dates) } else { selected_dates(NULL) } }) # SUBSET按钮点击事件：应用选中的日期过滤数据 observeEvent(input$sub, { if(!is.null(selected_dates())){ filtered_data(subset(pr59, as.Date(timestamp) %in% selected_dates())) } else { filtered_data(pr59) } }) # RESET按钮点击事件：重置选中状态和过滤数据 observeEvent(input$res, { selected_dates(NULL) filtered_data(pr59) # 清空Plotly的选中状态 plotlyProxy("plot1", session) %>% plotlyProxyInvoke("restyle", "selectedpoints", list(NULL)) plotlyProxy("plot2", session) %>% plotlyProxyInvoke("restyle", "selectedpoints", list(NULL)) plotlyProxy("plot3", session) %>% plotlyProxyInvoke("restyle", "selectedpoints", list(NULL)) }) # 通用图表生成函数，减少重复代码 generate_plot <- function(data, title, y_label, source){ dat <- data %>% group_by(date = as.Date(timestamp)) %>% bupaR::n_cases() p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) + geom_area(fill = "#69b3a2", alpha = 0.4) + geom_line(color = "#69b3a2", size = 0.5) + geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() + labs(title = title, x = "timestamp", y = y_label) ggplotly(p, source = source) %>% layout(selectmode = "multiple") # 启用多选模式 } # 渲染三个图表 output$plot1 <- renderPlotly({ generate_plot(filtered_data(), "Cases per month", "Cases", "myPlotSource1") }) output$plot2 <- renderPlotly({ generate_plot(filtered_data(), "Cases per month", "events", "myPlotSource2") }) output$plot3 <- renderPlotly({ generate_plot(filtered_data(), "Cases per month", "objects", "myPlotSource3") }) } shinyApp(ui, server)
关键修改说明
- 启用多选模式：将原
plotly_click事件替换为plotly_selected，并在ggplotly中添加layout(selectmode = "multiple")支持框选或点击多选 - 统一状态管理：新增
selected_dates存储所有选中的日期，合并三个图表的选中结果并去重 - 延迟子集化：只有点击
SUBSET按钮时，才将选中的日期应用到filtered_data，实现按需子集化 - 代码复用：封装
generate_plot函数，避免三个图表的重复代码 - 完善重置逻辑：重置时不仅清空数据和选中状态，还通过
plotlyProxy清除图表上的选中标记
内容的提问来源于stack exchange，提问作者firmo23
相关产品推荐
相关产品推荐
