R Shiny - 使用 DateSlider 动态过滤 ggplot2 图表

Posted 2023-02-16

【中文标题】R Shiny - 使用 DateSlider 动态过滤 ggplot2 图表

【英文标题】：R Shiny - Dynamically filter ggplot2 chart using DateSlider

【发布时间】：2021-12-23 22:18:42

【问题描述】：

有很多这样的相关问题，我试过他们没有锻炼所以我发布一个新问题。

我的样本数据

Week_End    Product nts
2021-10-22  A   17
2021-10-15  B   12
2021-10-08  C   18
2021-10-01  A   37
2021-09-24  B   46
2021-09-17  C   27
2021-09-10  A   31
2021-09-03  A   45
2021-08-27  B   23
2021-08-20  B   12

我使用代码绘制了一个条形图

server <- function(input, output,session) 
    nt_data <- reactive(
        chart_nts <- perf_ind %>%
            filter(product %in% input$productid & (week_end >= input$start_dt & week_end <= input$end_dt)) %>%
            group_by(week_end,product) %>%
            summarise(c_nts = sum(nts))
    )
    
    observe(
        updateSelectizeInput(session,"productid",choices = prod_dim$prod_nm)
    )    
    
    
    output$ntsplot <- renderPlot(
        dateid<-input$dateid
        
        g <- ggplot(nt_data(),aes(y= c_nts, x = week_end))
        g + geom_bar(stat = "sum")
    )
    
 

我的 UI 代码看起来像

sidebarLayout(position = "left",
                  sidebarPanel(
                      selectizeInput("productid", "Select product","Names"),
                      sliderInput("dateid",
                                  "Slide your Date:",
                                  min = as.Date(date_range$start_dt,"%Y-%m-%d"),
                                  max = as.Date(date_range$end_dt,"%Y-%m-%d"),
                                  value=as.Date(date_range$asofdate,"%Y-%m-%d"),
                                  timeFormat="%Y-%m-%d")
                      ),
                  
                  mainPanel(
                      fluidRow(
                          splitLayout(cellWidths = c("50%", "50%"), plotOutput("ntsplot"), plotOutput(""))
                      )
                  )
                  )

我所需要的只是当我使用日期滑块时，我的图表应该相应地改变，因为我已经这样做了

output$ntplot <- renderPlot(
        dateid<-input$dateid
        data <- nt_data %>%
        filter (week_end >= input$start_dt & week_end <= input$end_dt) %>%  
        g <- ggplot(data(),aes(y= c_nts, x = week_end))
        g + geom_bar(stat = "sum")
    )

和

nt_data <- reactive(
        chart_nts <- perf_ind %>%
            filter(product %in% input$productid & (week_end >= input$start_dt & week_end <= input$end_dt)) %>%
            group_by(week_end,product) %>%
            summarise(c_nts = sum(nts))
    )

我正在从数据库中获取日期范围值。

当我执行时出现以下错误

Warning: Error in : Problem with `filter()` input `..1`.
x Input `..1` must be of size 4842 or 1, not size 0.

我在这里缺少的帮助我理解！谢谢你的帮助！！

【问题讨论】：

试试dplyr::filter(...)和dplyr::summarise，因为可能会有冲突。

我试过这不起作用:(

使用示例数据编辑，我正在尝试按周绘制条形图

什么是date_range 对象？

date_range 是 Start_dt = min(week_end) 和 End_dt = max(week_end) 和 asofdate = max(week_end) -7，这是我使用 dbGetQuery 从数据库表创建的

【参考方案1】：

不确定您想如何使用sliderInput。我将其替换为dateRangeInput()。试试这个

prod <- read.table(text=
"week_end    product nts
2021-10-22  A   17
2021-10-15  B   12
2021-10-08  C   18
2021-10-01  A   37
2021-09-24  B   46
2021-09-17  C   27
2021-09-10  A   31
2021-09-03  A   45
2021-08-27  B   23
2021-08-20  B   12", header=T)

ui <- fluidPage(
  sidebarLayout(position = "left",
                sidebarPanel(
                  selectizeInput("productid", "Select product","Names"),
                  dateRangeInput("date_range", "Period you want to see:",
                                 start = min(prod$week_end),
                                 end   = max(prod$week_end),
                                 min   = min(prod$week_end),
                                 max   = max(prod$week_end)
                  )#,
                  # sliderInput("dateid",
                  #             "Slide your Date:",
                  #             min = as.Date(date_range$start_dt,"%Y-%m-%d"),
                  #             max = as.Date(date_range$end_dt,"%Y-%m-%d"),
                  #             value=as.Date(date_range$asofdate,"%Y-%m-%d"),
                  #             timeFormat="%Y-%m-%d")
                ),
                
                mainPanel(
                  fluidRow(
                    splitLayout(cellWidths = c("50%", "50%"), plotOutput("ntplot"), DTOutput("t1"))
                  )
                )
  )
)

server <- function(input, output,session) 
  nt_data <- reactive(
    chart_nts <- prod %>%
      dplyr::filter(product %in% input$productid & (week_end >= input$date_range[1] & week_end <= input$date_range[2])) %>%
      group_by(week_end,product) %>%
      dplyr::summarise(c_nts = sum(nts))
    data.frame(chart_nts)
  )
  
  output$t1 <- renderDT(nt_data())
  
  observe(
    updateSelectizeInput(session,"productid",choices = prod$product)
  )    
  
  output$ntplot <- renderPlot(
    #dateid<-input$dateid
    data <- nt_data() # %>% dplyr::filter(week_end >= input$date_range[1] & week_end <= input$date_range[2]) 
    g <- ggplot(data,aes(y= c_nts, x = week_end)) +
           geom_bar(stat = "identity")
    g
  )

  
 

shinyApp(ui, server)

【讨论】：

DateRange 有三个变量 Start_dt = min(week_end), End_dt = Max(week_end) & Asofdate = max(week_end) -7

谢谢！！这个很好学！！