在Shiny中动态过滤数据框

时间:2019-01-17 18:35:36

标签: dynamic filter shiny reactive dynamic-ui

我正在尝试根据材质开关动态过滤Shiny中的数据框,该材质开关激活用来过滤我的数据框的ConditionalPanels。如果所有过滤器都被禁用,我只希望应用非条件过滤器。

因此,只有在激活物料开关且过滤器可以组合的情况下,才应使用过滤器。

但是,我一次只能获得一个条件过滤器。当没有激活​​任何材料开关时,也不会生成图。

我制作了一个小应用程序,再现了我的问题:

全局:

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

ConversionRate<- data.frame(IDVendedor = c(1:12),
                   Date = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 12),
                   BirthDate = sample(seq(as.Date('1999/01/01'), as.Date('2000/01/01'), by="day"), 12),
                   Bank = sample(1:6, 12, replace = T),
                   Validity = c('Validity1', 'Validity4','Validity5','Validity6','Validity7','Validity1','Validity2','Validity3','Validity4','Validity5','Validity6','Validity7'),
                   LastStep = sample(1:7, 12, replace = T))

UI:

fluidPage(
  navbarPage(id = "Main", inverse=F, 
             title = "TESTAPP", 

             tabPanel("Conversion Rate",
                      column(4, wellPanel(
                        sliderInput("Datetest", label = "Date", 
                                    min = as.Date('1999-01-01'), 
                                    max = as.Date('2001-12-31'),
                                    value = c(as.Date('1999-08-01'), as.Date('1999-12-31')),
                                    ticks = F),
                        conditionalPanel(
                          condition = "input.BirthDateswitch1 == '1'",
                          uiOutput("BD1")
                        ),
                        materialSwitch(inputId = "BirthDateswitch1", label = "Toggle BirthDate", status = "primary", right = T, value = F),
                        conditionalPanel(
                          condition = "input.Bankswitch1 == '1'",
                          uiOutput("B1")
                        ),
                        materialSwitch(inputId = "Bankswitch1", label = "Toggle Bank", status = "primary", right = T, value = F)
                      )


                      ),
                      ### Plotpanel-----------------------------------------------------------------------------------------------------------------------------
                      column(8,wellPanel(
                        plotOutput("Plot")
                      )

                      )


             )
  )
)

服务器:

shinyServer(function(input, output) {

  output$BD1 <- renderUI({
    sliderInput("DateBirth", label = "Birthdate", 
                min = as.Date('1920-01-01'), 
                max = as.Date('2010-12-31'),
                value = c(as.Date('1945-08-01'), as.Date('2015-12-31')),
                ticks = F, animate = animationOptions(interval = 30, loop = T))
  })
  output$B1 <- renderUI({
    selectInput("Bank1", "Bank", choices = c(1:10), selected = c(1:2), selectize = TRUE, multiple = TRUE)
  })

  datasubCR1 <- reactive({
    if(input$BirthDateswitch1 == 1){
      ConversionRate[ConversionRate$BirthDate >= input$DateBirth[1] & ConversionRate$BirthDate <= input$DateBirth[2],]
    }

  })
  datasubCR1 <- reactive({
    if(input$Bankswitch1 == 1){
      datasubCR1()[datasubCR1$Bank %in% input$Bank1, ]
    }
  })


  output$Plot <- renderPlot({
    datasubCR1() %>%
      filter(Date >= input$Datetest[1] & Date <= input$Datetest[2]) %>%
      group_by(LastStep) %>%
      tally(LastStep >= 1) %>%
      ggplot(aes(LastStep, n)) +
      geom_col(colour = "#a96aef", fill = "#a96aef")

  })

})

在这一点上,我感觉要遵循完全错误的方法。

谢谢!

1 个答案:

答案 0 :(得分:1)

您似乎有两个以相同方式命名的反应堆(datasubCR1),第二个反应堆也引用了“自身”。我认为在这些方面采用更简单的方法可能会起作用(没有对其进行测试)。

  datasubCR1 <- reactive({
    out <- ConversionRate
    if(input$BirthDateswitch1 == 1) {
      out <- out[out$BirthDate >= input$DateBirth[1] & out$BirthDate <= input$DateBirth[2],]
    }
    if(input$Bankswitch1 == 1){
      out <- out[out$Bank %in% input$Bank1, ]
    }
   out
  })