SelectizeInput фильтрации в R Shiny

Question

У меня есть 2 вопроса: 1) Я хотел бы знать, возможно ли сделать столбец выбора в зависимости от предыдущего ввода. Пожалуйста, ознакомьтесь с кодом, и я объясню, что я имею в виду:

library(shiny)

Country <- c("USA", "Mexico", "Canada", "China", "Vietnam", "India", "France", "Germany", "Poland")
Region <- c("Americas", "Americas", "Americas", "Asia", "Asia", "Asia", "Europe", "Europe", "Europe")
Product <- c(11, 22, 33, 44, 55, 66, 77, 88, 99)
Date <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
DF <- cbind(Region, Country, Product, Date)
DF <- as.data.frame(DF)

Region <- as.factor(sort(unique(DF$Region)))
Country <- as.factor(sort(unique(DF$Country)))

ui <- fluidPage(titlePanel("Filtering experiments"),
sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(width = 3,

           selectizeInput("RegionSelect", "Region", Region, selected = NULL, multiple = TRUE),
           selectizeInput("CountrySelect", "Country", Country, selected = NULL, multiple = TRUE)),

    # Main panel for displaying outputs ----
    mainPanel( fluidPage(  box(width = 12, tableOutput("table")) )     )    )   )server <- function(input, output) {

output$table <- renderTable({
    filtered <- DF
    if (!is.null(input$RegionSelect)) {filtered <- filtered %>% filter(Region == input$RegionSelect)}
    if (!is.null(input$CountrySelect)) {filtered <- filtered %>% filter(Country == input$CountrySelect)}

    Total <- data.frame(filtered$Product)
    ShowTable <- data.frame(cbind(Total))
    ShowTable
})}shinyApp(ui, server)

Всякий раз, когда Регион выбран как "Америка", пользователь все равно видит все страны, а не только США, Канаду и Мексику.

Я попытался исправить это, отфильтровав:

       selectizeInput("CountrySelect", "Country", as.factor(sort(unique(filtered$Country %>% filter(Region == input$RegionSelect)}))), selected = NULL, multiple = TRUE))

Но это не сработало, поэтому я надеюсь, что у вас есть некоторые идеи.

2) Даже если "множественный = ИСТИНА ", когда в одной и той же строке ввода выбрано 2 или более входов, приложение перестает работать.

Заранее спасибо!

Answer 1

Вы можете использовать updateSelectizeInput для обновления содержимого selectizeInput в соответствии со значением другого ввода.

Обратите внимание, что лучше использовать observeEvent, чем observe операторы (см. здесь для деталей).

library(shiny)
library(dplyr)

Country <- c("USA", "Mexico", "Canada", "China", "Vietnam", "India", "France", "Germany", "Poland")
Region <- c("Americas", "Americas", "Americas", "Asia", "Asia", "Asia", "Europe", "Europe", "Europe")
Product <- c(11, 22, 33, 44, 55, 66, 77, 88, 99)
Date <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
DF <- cbind(Region, Country, Product, Date)
DF <- as.data.frame(DF)

Region <- as.factor(sort(unique(DF$Region)))
Country <- as.factor(sort(unique(DF$Country)))

ui <- fluidPage(titlePanel("Filtering experiments"),
                sidebarLayout(
                  # Sidebar panel for inputs ----
                  sidebarPanel(
                    width = 3,

                    selectizeInput(
                      "RegionSelect",
                      "Region",
                      Region,
                      selected = NULL,
                      multiple = TRUE
                    ),
                    selectizeInput(
                      "CountrySelect",
                      "Country",
                      Country,
                      selected = NULL,
                      multiple = TRUE
                    )
                  ),

                  # Main panel for displaying outputs ----
                  mainPanel(fluidPage(
                    width = 12, tableOutput("table")
                  ))
                ))

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

  observeEvent(input$RegionSelect, {
    req(input$RegionSelect)
    test <- DF %>%
      filter(Region %in% input$RegionSelect) %>%
      select(Country)

    updateSelectizeInput(session, 
                         inputId = "CountrySelect",
                         choices = test)
  })

  output$table <- renderTable({
    # Uncomment the two lines with comments if you want to make it mandatory to chose a continent to show the table

    # req(input$RegionSelect)
    req(input$CountrySelect)
    DF %>%
      # filter(Region %in% input$RegionSelect) %>%
      filter(Country %in% input$CountrySelect)
  })}
shinyApp(ui, server)

Answer 2

Вы можете добавить updateSelectInput, например так:

     observe({

         region <- input$RegionSelect
         req(region)

         updateSelectInput(session, "CountrySelect", 
              choices = filter(DF, Region == !!region)$Country)

                    })

Также исправьте ваш (почти) рабочий пример: вам нужен library(dplyr) и удалите box (так как это только с shinydashboard, который вы не используете).