使用 dateInput 值作为闪亮范围的数据框子集

Question

您好，我在下面有一个简单闪亮的应用程序。这是 df:

location = c("100 ail","16th and Whitmore","40AB01 - ANTWERPEN","100 ail","16th and Whitmore","40AB01 - ANTWERPEN") 
date = c("2015-09-01 00:00:00","2016-03-06 19:00:00","2016-11-22 15:00:00","2018-02-01 09:30:00", "2018-02-01 03:00:00", "2017-03-07 10:00:00") 
pm25=c("FALSE","FALSE","FALSE","FALSE","FALSE","FALSE")
pm10=c("TRUE","FALSE","FALSE","TRUE","FALSE","FALSE")
no2=c("TRUE","FALSE","FALSE")
latitude=c(47.932907,41.322470,36.809700,47.932907,41.322470,36.809700)
longitude=c(106.92139000,-95.93799000
            ,-107.65170000,106.92139000,-95.93799000
            ,-107.65170000)

df = data.frame(location, date,latitude,longitude,pm25,pm10,no2)

和应用程序：

ui = fluidPage(

  uiOutput("dt"),
  uiOutput("dt2"),
  submitButton(text = "Submit", icon = NULL, width = NULL),
  shiny::dataTableOutput("merged") 
)

#server.r

#df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {







  output$dt<-renderUI({

    dateInput('date',
              label = 'First Available Date',
              value = df$date
    )           


  })
  output$dt2<-renderUI({

    dateInput('date2',
              label = 'Last available Date',
              value = df$date
    )            


  })
  output$merged <- shiny::renderDataTable({
    df %>%
      filter(date >= input$dt & date <= input$dt2)
  })
}

shinyApp(ui = ui, server = server)

我想显示为数据表的 df 应该将 2 selectInput() 提供的日期作为范围的输入，并在每次更新时更改其外观。这可以做到吗？或者 dateInput() 只是显示从头开始取的数据，不能用于子集化？

Answer 1

首先，您需要将 date 列转换为 date 格式。（为此我使用了 lubridate。

library(lubridate)

df = data.frame(location, date = as_datetime(date),latitude,longitude,pm25,pm10,no2)

在这种情况下不需要使用 renderUI，因为您的数据不是动态的。（它也是这样工作的，只是不理想）。我只是简单地使用 dateInput:

dateInput('date',
            label = 'First Available Date',
            value = min(df$date)
)   ,
dateInput('date2',
          label = 'Last available Date',
          value = max(df$date)
)

此外，对于 dateInput 设置 value = df$date 会导致警告，因为 value 参数采用单个值，但 df$date 是 vector长度为 6。所以我改为 min(df$date) 和 max(df$date).

在您的 render 函数中，您需要指定 dateInput 的 id，因此请使用 input$date 和 input$date2 而不是 dt 和 dt2.

注意：使用dplyr filter时：不需要操作符&，您可以用逗号分隔过滤条件。

df %>%
      filter(as_date(date) >= input$date, as_date(date) <= input$date2)

还有一件事：我选择使用 as_date(date) 将 date_time 转换为 date 进行过滤。如果将 dates 与 date_time 进行比较，您可能会得到意想不到的结果，例如 2017-03-12 02:00 大于 2017-03-02。

完整代码：

library(dplyr)
library(shiny)
library(lubridate)

df = data.frame(location, date = as_datetime(date),latitude,longitude,pm25,pm10,no2)

ui = fluidPage(
  dateInput('date',
            label = 'First Available Date',
            value = min(df$date)
  )   ,
  dateInput('date2',
            label = 'Last available Date',
            value = max(df$date)
  ),
  submitButton(text = "Submit", icon = NULL, width = NULL),
  shiny::dataTableOutput("merged") 
)

server = function(input, output, session) {
  output$merged <- shiny::renderDataTable({
    df %>%
      filter(as_date(date) >= input$date, as_date(date) <= input$date2)
  })
}

shinyApp(ui = ui, server = server)

使用 dateInput 值作为闪亮范围的数据框子集

Subset a dataframe using dateInput values as range in shiny

date

shiny

reactive

完整代码：