Создайте блестящий динамически отображаемый пользовательский интерфейс с реактивными входными данными

Question

Я хочу иметь возможность иметь блестящие входы пользовательского интерфейса, которые обновляются в зависимости от предыдущего выбора пользователя. Итак, в приведенном ниже примере предполагаемое поведение будет заключаться в том, что пользователь выбирает из cyl, vs или carb, который затем

1. отфильтрует набор данных mtcars, который используется для создания график, т.е. пользователь настраивает график в соответствии с критериями фильтра и
2. обновляет оставшиеся варианты ввода в других фильтрах, чтобы они соответствовали оставшимся вариантам на основе фильтра, который уже установлен.

Вот что я пробовал:

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(
  fluidRow(
    box(
      title = "Filter",
      uiOutput(outputId = "cyl_dynamic_input"),
      uiOutput(outputId = "vs_dynamic_input"),
      uiOutput(outputId = "carb_dynamic_input")
    ),
    box(
      title = "Plot of mtcars",
      plotlyOutput("carplot")
    )
  ),
)

# create server
server <- function(input, output, session) {
  # create reactive filters of the mtcars table
  mtcars.reactive <- 
    reactive({
      mtcars %>%
        filter(mpg %in% input$cyl_input_rendered &
                 vs %in% input$vs_input_rendered &
                 carb %in% input$carb_input_rendered
        )})
  ## create rendered inputs
  # for cyl
  output$cyl_dynamic_input <- renderUI({
    pickerInput(inputId = "cyl_input_rendered",
                label = "CYL",
                choices = unique(mtcars$cyl),
                multiple = T,
                selected = mtcars.reactive()$cyl,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} cyl selected"
                ))
  })
  # for vs
  output$vs_dynamic_input <- renderUI({
    pickerInput(inputId = "vs_input_rendered",
                label = "VS",
                choices = unique(mtcars$vs),
                multiple = T,
                selected = mtcars.reactive()$vs,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} vs selected"
                ))
  })
  # for carb
  output$carb_dynamic_input <- renderUI({
    pickerInput(inputId = "carb_input_rendered",
                label = "CARB",
                choices = unique(mtcars$carb),
                multiple = T,
                selected = mtcars.reactive()$carb,
                options = list(
                  `actions-box` = TRUE,
                  `selected-text-format`= "count",
                  `count-selected-text` = "{0} out of {1} carb selected"
                ))
  })
  ## create the plot output
  # Start Barplot Emissionen here 
  output$carplot<-
    renderPlotly({
    # create plot
    plot<-ggplot(mtcars.reactive(), aes(wt, mpg))+
      geom_point()
    # convert to plotly
    ggplotly(plot)
  })
  
  
  
}

shinyApp(ui, server)

Я предполагаю, что это не может работать, потому что фильтр для таблицы mtcars ссылается на визуализированные входные данные и наоборот, который каким-то образом создает пустой информация l oop

Я уже смотрел официальную документацию Shiny , которая также предоставляет некоторую справочную информацию , но весь topi c не совсем интуитивен для новичка. Вот как-то аналогичный вопрос , но он не воспроизводится полностью.

Answer 1

Следующее делает то, что вы хотите, без иерархии, но с использованием pickerInput и условных операторов в операторе observeEvent. Сначала он выглядит сложным, но делает то, что должен.

library(shiny)
library(dplyr)
library(plotly)

data("mtcars")

# create ui
ui <- fluidPage(fluidRow(
  box(
    title = "Filter",
    pickerInput(
      inputId = "cyl_pickerinput",
      label = "CYL",
      choices = levels(as.factor(mtcars$cyl)),
      multiple = T,
      selected = levels(as.factor(mtcars$cyl)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} cyl selected"
      )
    ),
    pickerInput(
      inputId = "vs_pickerinput",
      label = "VS",
      choices = levels(as.factor(mtcars$vs)),
      multiple = T,
      selected = levels(as.factor(mtcars$vs)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} vs selected"
      )
    ),
    pickerInput(
      inputId = "carb_pickerinput",
      label = "CARB",
      choices = levels(as.factor(mtcars$carb)),
      multiple = T,
      selected = levels(as.factor(mtcars$carb)),
      options = list(
        `live-search` = TRUE,
        #`actions-box` = TRUE,
        `selected-text-format` = "count",
        `count-selected-text` = "{0} out of {1} carb selected"
      )
    ),
  ),
  box(title = "Plot of mtcars",
      plotlyOutput("carplot"))
),)

# create server
server <- function(input, output, session) {
  #(1) Create PickerInput Updates
  observeEvent(
    # define pickerinputs to be observed
    c(
      input$vs_pickerinput,
      input$carb_pickerinput,
      input$cyl_pickerinput
    ),
    {
      ## filter the data based on the pickerinputs
      # include an ifelse condition first to check wheter at least one value is choosen in all of the filters.
      mtcars2 <-
        if (!is.null(input$cyl_pickerinput) &
            !is.null(input$vs_pickerinput) &
            !is.null(input$carb_pickerinput)) {
          mtcars %>%
            filter(cyl %in% input$cyl_pickerinput) %>% # filters
            filter(vs %in% input$vs_pickerinput) %>%
            filter(carb %in% input$carb_pickerinput)
        } 
      else{
           mtcars
         }

      ## update PickerInput based on a condition that requires the user to choose at least one input, else reset all filters
      # for cyl 
      if (!is.null(input$cyl_pickerinput)) {
        updatePickerInput(
          session,
          "cyl_pickerinput",
          choices = levels(factor(mtcars$cyl)),
          selected = unique(mtcars2$cyl))
      } else{
      }
      # for carb
      if (!is.null(input$carb_pickerinput)) {
        updatePickerInput(
          session,
          "carb_pickerinput",
          choices = levels(factor(mtcars$carb)),
          selected = unique(mtcars2$carb)
        )
      } 
      # for vs 
      if (!is.null(input$vs_pickerinput)) {
        updatePickerInput(
          session,
          "vs_pickerinput",
          choices = levels(factor(mtcars$vs)),
          selected  = unique(mtcars2$vs)
        )
      } 
    },
    ignoreInit = TRUE,
    ignoreNULL = F
  )
  
  # (2) Create reactive object with filtered data
  # update mtcars table based on filters
  mtcars.reactive <-
    reactive({
      if (!is.null(input$vs_pickerinput))
        # one condition should be enough.
      {
        mtcars %>% # filters
          filter(
            cyl %in% input$cyl_pickerinput &
              vs %in% input$vs_pickerinput &
              carb %in% input$carb_pickerinput
          )
      } else
      {
        mtcars
      }
    })
  
  # (3) create the plot output
  output$carplot <-
    renderPlotly({
      # create plot
      plot <- ggplot(mtcars.reactive()) +
        geom_point(aes(wt, mpg, color = factor(vs)))
      # convert to plotly
      ggplotly(plot)
    })
  
  
  
}

shinyApp(ui, server)