R Shiny dateInputRange函数打破直方图

时间:2017-01-27 20:35:44

标签: r shiny

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

当我启动应用程序时,控制台会给我这条消息:

==.default中的警告(c(”10/11/2016“,”2016年10月16日“,”2016年11月22日“,”2016年11月21日“,   较长的物体长度不是较短物体长度的倍数“

代码如下:

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)

1 个答案:

答案 0 :(得分:0)

这可能来自日期问题,因此请尝试使用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())
}