Shiny中实现日历选择日期联动生成对应散点图的实现方案咨询

核心修改说明 #

• 调整function.cl返回值：原函数仅返回date列，修改后返回完整数据集，方便提取D1、DR类字段做计算
• 补全绘图响应逻辑：监听日期选择控件的输入变化，自动按规则计算散点图的X、Y轴数值并渲染

完整可运行代码 #

rm(list=ls())
library(shiny)
library(shinythemes)

function.cl<-function(){
  df <- structure(
    list(date = c("2021-01-01","2021-01-01","2021-01-01","2021-01-02","2021-01-02","2021-01-02","2021-01-03",
                  "2021-01-03","2021-01-03","2021-01-03","2021-01-03","2021-01-04","2021-01-04","2021-01-04"),
         D1 = c(5,3,4,5,6,3,4,4,2,3,4,2,2,3), 
         DR1= c(2,4,5,8,9,3,4,4,3,2,3,1,5,4),
         DR2 = c(4,2,5,5,3,3,3,7,3,5,2,2,2,3), 
         DR3  = c(2,2,3,6,7,5,2,2,2,1,6,8,2,5),
         DR4  = c(3,5,6,3,4,5,1,3,2,1,2,7,5,6)),
    class = "data.frame", row.names = c(NA, -14L))
  # 修改返回完整数据集
  return(df)
}   

ui <- fluidPage(
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput("date"),
                                 br(),
                               ),
                               mainPanel(
                                 tabsetPanel(
                                   tabPanel("",plotOutput("Graph",width = "95%", height = "600"))),
                               ))
 )))

server <- function(input, output,session) {
  data <- reactive(function.cl())
  
  output$date <- renderUI({
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    
    dateInput(input = "date", 
              label = "选择日期",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  output$Graph <- renderPlot({
    # 校验日期输入存在，避免初始化报错
    req(input$date)
    # 转成字符串和数据集里的date格式匹配
    selected_date <- as.character(input$date)
    # 筛选对应日期的所有行
    filter_df <- data()[data()$date == selected_date,]
    # 计算Y值：选中日期D1字段总和
    y_val <- sum(filter_df$D1)
    # 提取四个DR列的所有值作为X轴取值
    x_vals <- unlist(filter_df[,c("DR1","DR2","DR3","DR4")])
    # 绘制散点图
    plot(
      x = x_vals,
      y = rep(y_val, length(x_vals)),
      main = paste0(selected_date," 散点图"),
      xlab = "DR系列字段取值",
      ylab = "D1字段总和",
      pch = 16,
      col = "#2c3e50",
      cex = 1.5
    )
  })
}

shinyApp(ui = ui, server = server)

效果说明 #

选中日期后散点图会自动刷新，完全匹配要求的规则：

• 每个散点的X值为选中日期所有行的DR1/DR2/DR3/DR4字段的单个取值
• 所有散点的Y值固定为选中日期所有行的D1字段总和

内容的提问来源于stack exchange，提问作者Antonio