R Shiny dateInputRange 函数破坏直方图

Question

我正在尝试使直方图对 dateInputRange 函数作出反应。我的应用程序已经在工作，只有一个年龄滑块输出到直方图，还有一个直方图下方的结果表。我将 dateInputRange 添加到我的代码中，并按我想要过滤的源数据中的列过滤输出（基于日期），并且应用程序仍然启动，但直方图不再绘图。 renderTable 仍然对滑块输入做出反应，但对于直方图，我只得到一个空白的灰色图。

当我启动应用程序时，控制台会显示以下消息：

“==.default(c("10/11/2016", "10/16/2016", "11/22/2016", "11/21/2016", 中的警告： 较长的对象长度不是较短对象长度的倍数"

代码如下：

ui <- fluidPage(


   titlePanel("ED Admissions"),


   sidebarLayout(
      sidebarPanel(
         sliderInput("AgeInput","Age",min = 3, max = 125, c(3,65)),

         dateRangeInput("DateInput", "Date")
          ),


      mainPanel(
         plotOutput("AgePlot"),
         br(), br(),
         tableOutput("ClientTable")


      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  output$AgePlot <- renderPlot({
    filtered <-
    edadmits %>%
      ##filtering is by variables in the dataset
      filter(Client_AGE >= input$AgeInput[1],
             Client_AGE <= input$AgeInput[2],
             Discharge_Claim_Start_Date == input$DateInput
             )

    ggplot(filtered, aes(Client_AGE))+
      geom_histogram()
  })

  output$ClientTable <- renderTable({
    filtered <-
      edadmits %>%

      filter(Client_AGE >= input$AgeInput[1],
             Client_AGE <= input$AgeInput[2])

    filtered
  })
}


shinyApp(ui = ui, server = server)

这是一个可重现的例子：

library(shiny)
library(ggplot2)
library(dplyr)

Name <- c("Person 1","Person 2","Person 3","Person 4","Person 5","Person 6","Person 7","Person 8",
            "Person 9","Person 10","Person 11","Person 12", "Person 13","Person 14","Person 15",
          "Person 16","Person 17","Person 18","Person 19","Person 20")

Diagnosis <- sample(1:10, 20, replace=TRUE)

Discharge.Date <- sample(seq(as.Date('2016/12/01'), as.Date('2016/12/31'), by="day"), 20)

Age <- sample(1:125, 20)

edadmits <- data.frame(Name, Diagnosis, Discharge.Date, Age)


# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("ED Admissions, 12.1.16-12.31.16"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      sliderInput("AgeInput","Age",min = 3, max = 125, c(3,65)),

      dateRangeInput("DateInput", "Date", start= "2016-12-01", end= "2016-12-31", 
                     min= "2016-12-01", max = "2016-12-31")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("AgePlot"),
      br(), br(),
      tableOutput("ClientTable")


    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  output$AgePlot <- renderPlot({
    filtered <-
      edadmits %>%
      ##filtering is by variables in the dataset
      filter(Age >= input$AgeInput[1],
             Age <= input$AgeInput[2],
             Discharge.Date >= input$DateInput[1],
             Discharge.Date <= input$DateInput[2]
      )

    ggplot(filtered, aes(Age))+
      geom_histogram()
  })

  output$ClientTable <- renderTable({
    filtered <-
      edadmits %>%
      ##filtering is by variables in the dataset
      filter(Age >= input$AgeInput[1],
             Age <= input$AgeInput[2],
             Discharge.Date >= input$DateInput[1],
             Discharge.Date <= input$DateInput[2])

    filtered
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

这可能来自日期问题，因此请尝试使用 strftime() 重新格式化它们。另外为了简化您的代码，您可以像这样使用reactive：

server <- function(input, output) {
  filtered_data <- reactive({
    edadmits %>%
      filter(Age >= input$AgeInput[1],
             Age <= input$AgeInput[2],
             Discharge.Date >= input$DateInput[1],
             Discharge.Date <= input$DateInput[2]) %>%
      mutate(Discharge.Date=strftime(Discharge.Date, "%Y/%m/%d"))
  })

  output$AgePlot <- renderPlot(ggplot(filtered_data(), aes(Age))+geom_histogram())

  output$ClientTable <- renderTable(filtered_data())
}