R Shiny - 如何使用函数 dateRangeInput 和 selectInput 创建反应式条形图

Question

我的问题可能很简单，但我没有找到答案。我生成了一个包含两种疾病（Diseases_1 和 Disease_2）的数据框（Surveillance）。我想制作一个根据日期和疾病选择做出反应的条形图. PS：我按周汇总数据。 我的用户界面在这里：

library(shiny) 
library(lubridate)
library(ggplot2)
library(scales)
library(dplyr) 

Surveillance <- data.frame(
  Date = seq(as.Date("2015/1/1"), as.Date("2015/12/31"), "days"),
  Disease_1 = as.numeric(sample(1:100,365,replace=T)), Disease_2 =as.numeric(sample(1:100,365,replace=T)))
Surveillance <- Surveillance %>% mutate(
  Week = format(Date, "%Y-%m-%U"))

ui <- fluidPage(
  dateRangeInput("daterange", "Choice the date",
                 start = min(Surveillance$Date),
                 end = max(Surveillance$Date),
                 min = min(Surveillance$Date),
                 max = max(Surveillance$Date),
                 separator = " - ", format = "dd/mm/yy",
                 startview = 'Week', language = 'fr', weekstart = 1),  
selectInput(inputId = 'Diseases',
            label='Diseases',
            choices=c('Disease_1','Disease_2'),
            selected='Disease_1'),
plotOutput("barplot"))

我的服务器在这里：

server <- function(input, output) {

  dateRangeInput<-reactive({
    dataset <- subset(Surveillance, Date >= input$daterange[1] & Date <= input$daterange[2])
    dataset = switch(input$Diseases,
                     "Disease_1" = Disease_1,
                     "Disease_2" = Disease_2)  
    dataset
  })

 output$barplot <-renderPlot({
    ggplot(data=dateRangeInput(), aes_string(x="Week",y=input$Diseases))  + 
      stat_summary(fun.y = sum, geom = "bar",colour="#56B4E9",fill="#56B4E9") +
      geom_bar(stat="identity") + 
      labs(title=input$Diseases, y ="Number") +
      theme_classic() + 
      theme(plot.title = element_text(hjust = 0.5))
  })

}
shinyApp (ui = ui, server = server)

当我运行程序时，R Shiny 显示：找不到错误对象“Disease_1”。 我多次更改程序，但我没有发现我的错误。你能帮帮我吗？谢谢你。

Answer 1

参考ggplot 文档，

1. ggplot 中的data 只能是dataframe
2. aes_string参数引用数据列

代码

library(shiny) 
library(lubridate)
library(ggplot2)
library(scales)
library(dplyr) 

Surveillance <- data.frame(
  Date = seq(as.Date("2015/1/1"), as.Date("2015/12/31"), "days"),
  Disease_1 = sample(1:100,365,replace=T), Disease_2 =sample(1:100,365,replace=T))
Surveillance <- Surveillance %>% mutate(
  Week = format(Date, "%Y-%m-%U"))

ui <- fluidPage(
  dateRangeInput("daterange", "Choice the date",
                 start = min(Surveillance$Date),
                 end = max(Surveillance$Date),
                 min = min(Surveillance$Date),
                 max = max(Surveillance$Date),
                 separator = " - ", format = "dd/mm/yy",
                 startview = 'Week', language = 'fr', weekstart = 1),  
  selectInput(inputId = 'Diseases',
              label='Diseases',
              choices=c('Disease_1','Disease_2'),
              selected='Disease_1'),
  plotOutput("barplot"))


server <- function(input, output) {

  dateRangeInput<-reactive({
    dataset <- subset(Surveillance, Date >= input$daterange[1] & Date <= input$daterange[2]) 
    dataset <- dataset[,c(input$Diseases, "Week")]
    dataset
  })


  output$barplot <-renderPlot({
    ggplot(data=dateRangeInput(), aes_string(x="Week",y=input$Diseases))  +
      stat_summary(fun.y = sum, geom = "bar",colour="#56B4E9",fill="#56B4E9") +
      geom_bar(stat="identity") +
      labs(title=input$Diseases, y ="Number") +
      theme_classic() +
      theme(plot.title = element_text(hjust = 0.5))
  })

}
shinyApp (ui = ui, server = server)

Answer 2

您没有任何名为 Disease_1 的变量，它只是 surveillance 数据框中的一列。当用户选择 Disease_1 作为他们的选择时，您需要传递一个数据框，这是您案例的默认选择。你一直在传递一个名为 Disease_1 的东西，它不存在，因此它失败了。

这是一个适合你的工作代码：

    library(shiny) 
    library(lubridate)
    library(ggplot2)
    library(scales)
    library(dplyr) 

    Surveillance <- data.frame(
      Date = seq(as.Date("2015/1/1"), as.Date("2015/12/31"), "days"),
      Disease_1 = as.numeric(sample(1:100,365,replace=T)), Disease_2                 =as.numeric(sample(1:100,365,replace=T)))

    Surveillance <- Surveillance %>% mutate(
      Week = format(Date, "%Y-%m-%U"))

    ui <- fluidPage(
      dateRangeInput("daterange", "Choice the date",
                     start = min(Surveillance$Date),
                     end = max(Surveillance$Date),
                     min = min(Surveillance$Date),
                     max = max(Surveillance$Date),
                     separator = " - ", format = "dd/mm/yy",        
                     startview = 'Week', language = 'fr', weekstart = 1),  

      selectInput(inputId = 'Diseases',
                  label='Diseases',
                  choices=c('Disease_1','Disease_2'),
                  selected='Disease_1'),

      plotOutput("barplot"))


    server <- function(input, output) {

      dateRangeInput<-reactive({
        dataset <- subset(Surveillance, Date >= input$daterange[1] & Date <=         input$daterange[2])
        dataset = switch(input$Diseases,
                         "Disease_1" =         Surveillance[,setdiff(colnames(Surveillance),'Disease_2')],
                         "Disease_2" =         Surveillance[,setdiff(colnames(Surveillance),'Disease_1')])  
        print(head(dataset))
        return(dataset)
      })

      output$barplot <-renderPlot({

        if(is.null(dateRangeInput())) return()

        ggplot(data=dateRangeInput(), aes_string(x="Week",y=input$Diseases))          + 
          stat_summary(fun.y = sum, geom =         "bar",colour="#56B4E9",fill="#56B4E9") +
          geom_bar(stat="identity") + 
          labs(title=input$Diseases, y ="Number") +
          theme_classic() + 
          theme(plot.title = element_text(hjust = 0.5))        
      })        

    }
    shinyApp (ui = ui, server = server)

Answer 3

删除

dataset = switch(input$Diseases,
                     "Disease_1" = Disease_1,
                     "Disease_2" = Disease_2) 

它会起作用的