Динамическая фильтрация Dataframe в Shiny - PullRequest
0 голосов
/ 17 января 2019

Я пытаюсь динамически фильтровать Dataframe в Shiny на основе переключателей материалов, которые активируют ConditionalPanels, которые фильтруют мой Dataframe. Если все фильтры отключены, я хочу, чтобы применялись только безусловные фильтры.

Таким образом, фильтры должны применяться, только если переключатель материала активирован и фильтры должны быть комбинируемыми.

Однако я могу получить только один условный фильтр за раз. Также не создается график, когда ни один из переключателей материалов не активирован.

Я сделал небольшое приложение, которое воспроизводит мою проблему:

Global:

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 голосов
/ 18 января 2019

Похоже, у вас есть два реактива, названных одинаково (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
  })
...