调整Shiny应用代码 实现选择日历日期后展示对应散点图

原代码无法实现日期选择联动的核心原因有两点：

• 封装的function.cl函数中硬编码生成了固定日期2021-08-01的散点图，没有开放动态传入日期的能力
• 服务端的绘图渲染逻辑没有和日历选择器的输入值绑定，不管选择什么日期都只会调用提前生成好的固定图表

library(shiny)
library(shinythemes)
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)

# 工具函数仅返回原始数据，不再生成固定日期的图表
function.cl<-function(){
  df <- structure(
    list(date = c("2021-08-01","2021-08-01","2021-08-01","2021-08-01","2021-08-01",
                  "2021-08-08","2021-08-08","2021-08-08","2021-08-08","2021-08-08","2021-08-08",
                  "2021-08-13","2021-08-13","2021-08-13","2021-08-13","2021-08-13"),
         Week= c("Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday","Sunday",
                 "Sunday","Sunday","Sunday","Friday","Friday","Friday","Friday","Friday"),
         D1 = c(0,1,0,0,5,0,1,0,0,9,4,3,4,5,6,7), DR01 = c(2,1,0,0,3,0,1,0,1,7,2,3,4,6,7,8), 
         DR02 = c(2,0,0,0,4,2,1,0,1,4,2,3,4,5,6,7),  DR03 = c(2,0,0,2,6,2,0,0,1,5,2,2,4,5,7,5),
         DR04 = c(2,0,0,5,6,2,0,0,3,7,2,3,4,5,6,4),  DR05 = c(2,0,0,5,6,2,0,0,7,7,2,3,4,5,6,7), 
         DR06 = c(2,0,0,5,7,2,0,0,7,7,1,3,5,6,7,8),  DR07 = c(2,0,0,6,9,2,0,0,7,8,1,3,5,6,4,3)), 
    class = "data.frame", row.names = c(NA, -16L))
  return(df)
}

# 散点图生成函数单独封装，支持传入日期参数
scatter_date <- function(dt, dta) {
  dta %>%
    mutate(date = ymd(date)) %>%
    filter(date == ymd(dt)) %>%
    summarize(across(starts_with("DR"), sum)) %>%
    pivot_longer(everything(), names_pattern = "DR(.+)", values_to = "val") %>%
    mutate(name = as.numeric(name)) %>%
    plot(xlab = "Days", ylab = "Types", xlim = c(0, 7))
}  

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-12-31'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
    
    dateInput(input = "date", 
              label = "Select Date",
              min = min(data()$date),
              max = max(data()$date),
              value = max(data()$date),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
  })
  
  # 绘图逻辑绑定用户选择的日期参数
  output$Graph <- renderPlot({
    req(input$date)
    scatter_date(input$date, data())
  })
}

shinyApp(ui = ui, server = server)

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