使用多个过滤条件时,表子集不会以闪亮的方式进行反应

时间:2019-08-28 11:35:13

标签: r shiny dplyr dt flexdashboard

我有一个数据集:

vru_line    call_id customer_id priority    type    date
AA0101  38080   50395060    2   PS  4/1/2019
AA0101  38080   50395060    0   PS  4/1/2019
AA0101  38081   50353564    2   NW  4/1/2019
AA0102  38082   13000567    2   PS  4/2/2019
AA0102  38083   50395060    1   NW  4/2/2019
AA0102  38084   50353564    0   PS  4/2/2019
AA0103  38085   50353564    1   NW  4/3/2019
AA0103  38086   13000567    1   PS  4/3/2019
AA0103  38087   13000567    0   NW  4/3/2019

此处的日期为(mm / dd / yyyy)格式。

我要使用flexdashboard and shiny来做的是根据条件对数据集进行子集化:

  • 过滤“ ALL” vru_line或从下拉列表中选择的一个 菜单。
  • 在选定的日期范围之间进行过滤

以下代码来自我正在从事的项目:

library(DT)
library(data.table)
library(dplyr)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(stringr)
library(lubridate)
library(anytime)

# this will create a "File Upload" button
fileInput("file1", "Load File:",
          accept = c("text/csv", "text/comma-separated-values, text/plain", ".csv", "text/tab-separated-values", ".tsv") )
checkboxInput("header", "Is first row the Header?", TRUE)

data_set <- reactive({
    req(input$file1)
    inFile <- input$file1
    data_set <- read.csv(inFile$datapath, header=input$header, stringsAsFactors = F)
})


# Date input placeholder for date selection
dateRangeInput("dateRange", "Select Start & End Dates:",
               start = "2019-04-01", end = "2019-04-02",
               separator = " - ", format = "yyyy-mm-dd")

hr()

observe({
    require(dplyr)
    req(input$file1)
    choices = c("ALL", unique(as.character(data_set()$vru_line)))

    updateSelectInput(session,"VarRep",
                             label = "Select VRU",
                             choices = choices, selected=choices[1])

})

selectInput(inputId = "VarRep", label = "Select VRU", 
            multiple = FALSE, choices = list("ALL"), selected = "ALL" )

hr()

# click button
actionButton("displayRes","Display")

# Should select the sebset of data depending on the coditions above and below
eventReactive(input$displayRes, {
  output$VarReptbl <- renderDataTable({ 
    if(input$VarRep == "ALL") {
      data_set() %>% select(everything()) %>%
        filter(anydate(data_set()$date) >= anydate(input$dateRange[1])  &
                 anydate(data_set()$date) <= anydate(input$dateRange[2])) %>% datatable()
    } else {
      data_set() %>% select(everything()) %>%
        filter(as.character(data_set()$vru_line) == input$VarRep) %>%
        filter(anydate(data_set()$date) >= anydate(input$dateRange[1])  &
                 anydate(data_set()$date) <= anydate(input$dateRange[2])) %>% datatable()
    }
  })
})


hr()
dataTableOutput("VarReptbl")

正在显示的代码没有错误,当我导入数据并单击显示按钮时,没有返回表。

不确定我在哪里做错了吗?该代码看起来还可以。

如果我从下拉菜单中选择一个选项并选择两个日期,那么应该将数据过滤为子集并显示为数据表。

2 个答案:

答案 0 :(得分:2)

任何反应式内部的输出绑定都不是好习惯,并且几乎不需要。这就是您可能需要的。 -

some_data <- eventReactive(input$displayRes, {
  data_set() %>%
    filter(as.character(vru_line) == input$VarRep | input$VarRep == "ALL") %>%
    filter(anydate(date) >= anydate(input$dateRange[1])  &
             anydate(date) <= anydate(input$dateRange[2]))
  }
})

output$VarReptbl <- renderDataTable({
  some_data() %>% datatable()
})

答案 1 :(得分:0)

虽然很懒,而且不苗条,但是这种解决方案似乎对我有用(感谢上面的Shree):

some_data <- eventReactive(input$displayRes, {
  testD <- subset(data_set(), vru_line= =input$VarRep | input$VarRep == "ALL") %>%
    select(vru_line, date, text)
  testD$date <- lubridate::mdy(testD$date)
  testD1 <- subset(testD, date >= input$dateRange[1]  &
                    date <= input$dateRange[2])
  return(testD1)
})