Блестящий, с реактивными входами и кнопкой Go

У меня есть блестящее приложение, я хотел реагировать на выбор входов и отображать данные, когда я нажимаю кнопку «Go». Для входных данных я хочу иметь выбор между «Все значения» моей переменной и каждым значением. У меня проблема с исправлением моего приложения.

Первая попытка

library(shiny)
library(dplyr)
library(DT)

# my data
bdd <- tibble(BA = rep(LETTERS, 2), MA = as.character(1:52),
              YES = paste(BA, MA, sep = ""))



ui <- fluidPage(
  titlePanel("BA"),
  column(4,
         uiOutput("filter1"),
         uiOutput("filter2"),
         uiOutput("filter3"),
         actionButton("button", "GO")),
  column(8,
         DT::dataTableOutput("my_table"))
)

server <- function(input, output, session) {


  All_BA <- reactive({
    bdd %>% distinct(BA) 
  })
  # my reactives inputs for filter 1
  output$filter1 <- renderUI({
    selectInput("filter1", "Filtre numéro 1", 
                choices = c("All_BA", bdd %>% select(BA)))
  })

  All_MA <- reactive({
    bdd %>% filter(BA %in% input$filter1) %>%
      distinct(MA)
  }) 
  # my reactives inputs for filter 2
  output$filter2 <- renderUI({
    selectInput("filter2", "Filtre numéro 2",
                choices = c("All_MA", bdd %>% filter(BA %in% input$filter1) %>% select(MA)), 
                selected = "All_MA")
  })

  All_Y <- reactive({
    bdd %>% filter(BA %in% input$filter1 |
                     MA %in% input$filter2) %>% distinct(YES) 
  })
  # my reactives inputs for filter 3
  output$filter3 <- renderUI({
    selectInput("filter3", "Filtre numéro 3", 
                choices =  c("All_Y", bdd %>% filter(BA %in% input$filter1,
                                                     MA %in% input$filter2) %>% select(YES)),
                selected = "All_Y")
  })

  df <- eventReactive(input$button, {
    bdd %>% filter(BA %in% input$filter1,
                   MA %in% input$filter2,
                   YES %in% input$filter3)
  })


  output$my_table <- DT::renderDataTable({
    df()

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

вторая попытка (не сработала из-за проблемы с реактивностью, и код не кажется оптимизированным)

library(shiny)
library(dplyr)
library(DT)

# my data
bdd <- tibble(BA = rep(LETTERS, 2), MA = as.character(1:52),
              YES = paste(BA, MA, sep = ""))



ui <- fluidPage(
  titlePanel("BA"),
  column(4,
         uiOutput("filter1"),
         uiOutput("filter2"),
         uiOutput("filter3"),
         actionButton("button", "GO")),
  column(8,
         DT::dataTableOutput("my_table"))
)

server <- function(input, output, session) {


  All_BA <- reactive({
    bdd %>% distinct(BA) 
  })
  # my reactives inputs for filter 1
  if(input$filter1 == "All_BA"){
    bdd <- reactive({
      bdd %>%
        filter(BA %in% All_BA())
    })
  }else{
    bdd <- reactive({
      bdd %>%
        filter(BA %in% input$filter1)
    })
  }
  output$filter1 <- renderUI({
    selectInput("filter1", "Filtre numéro 1", 
                choices = c("All_BA", bdd() %>% select(BA)))
  })

  All_MA <- reactive({
    bdd() %>% filter(BA %in% input$filter1) %>%
      distinct(MA)
  }) 
  # my reactives inputs for filter 2
  if(input$filter2 == "All_MA"){
    bdd2 <- reactive({
      bdd() %>%
        filter(MA %in% All_MA())
    })
  }else{
    bdd2 <- reactive({
      bdd() %>%
        filter(MA %in% input$filter2)
    })
  }
  output$filter2 <- renderUI({
    selectInput("filter2", "Filtre numéro 2",
                choices = c("All_MA", bdd2() %>% select(MA)), 
                selected = "All_MA")
  })

  All_Y <- reactive({
    bdd2 %>% filter(BA %in% input$filter1 |
                      MA %in% input$filter2) %>% distinct(YES) 
  })
  # my reactives inputs for filter 3
  if(input$filter3 == "All_Y"){
    bdd3 <- reactive({
      bdd2() %>%
        filter(YES %in% All_Y())
    })
  }else{
    bdd3 <- reactive({
      bdd2() %>%
        filter(YES %in% input$filter3)
    })
  }
  output$filter3 <- renderUI({
    selectInput("filter3", "Filtre numéro 3", 
                choices =  c("All_Y", bdd3() %>% select(YES)),
                selected = "All_Y")
  })

  df <- eventReactive(input$button, {
    bdd %>% filter(BA %in% input$filter1,
                   MA %in% input$filter2,
                   YES %in% input$filter3)
  })


  output$my_table <- DT::renderDataTable({
    df()

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

r shiny shinyjs
person Mostafa    schedule 13.06.2017    source источник
comment
Решение здесь: stackoverflow.com/questions/ 44570404 /   -  person Mostafa    schedule 20.06.2017

Ответы (1)


arrow_upward
1
arrow_downward

Проблема заключается в фильтрации таблицы. Если ничего не выбрано, input$filter1 имеет значение 'All_BA', и фильтр не возвращает значения, и аналогично для других inputs.

Фактически фильтр работает, если выбраны все 3 входных значения.

Измените его на:

df <- eventReactive(input$button, {

    res <- bdd
    if(input$filter1 != "All_BA")
        res <- res %>% filter(BA %in% input$filter1)
    if(input$filter2 != "All_MA")
        res <- res %>% filter(MA %in% input$filter2)
    if(input$filter3 != "All_Y")
        res <- res %>% filter(MA %in% input$filter3)
    res
})

(Я работал над первым примером).

Надеюсь это поможет

person GGamba    schedule 13.06.2017
comment
Спасибо, ваш ответ, кажется, работает, но у меня проблема с фильтрами, они не обновляются, когда я выбираю определенные фильтры, вы можете мне помочь, пожалуйста - person Mostafa; 14.06.2017