在Shiny App中动态更新选择列表

debugcn 发表于 Dev

DJC

我有一个应用程序，允许用户指定他们将要预测多少个预测变量，并相应地选择每个预测变量。谁能告诉我如何使每个后续预测变量的选择反映先前的预测变量选择？

例如，如果Predictor 1 = cyl，则Predictor 2的选择为{disp，drat，hp，mpg}。然后，如果Predictor 2 = hp，则Predictor 3的选择为{disp，drat，mpg}。

## libraries
library(tidyverse)
library(shiny)

## store variable names
var_names <- mtcars %>% select(1:5) %>% colnames

ui <- fluidPage(
  ## select number of variables to use
  numericInput(inputId = "n_preds", 
               label = "Number Predictors", 
               value = 1, 
               min = 1,
               max = length(var_names)),
  ## store UI object for future use
  uiOutput("vars")
)

server <- function(input, output, session) {
  ## create objects to store individual predictors
  predictors <- reactive(paste0("Predictor ", seq_len(input$n_preds)))
  ## generate dynamic UI
  output$vars <- renderUI({
    map(predictors(), ~ selectInput(inputId = .x, 
                                    label = .x, 
                                    choices = var_names,
                                    selected = isolate(input[[.x]])) %||% "")
  })
}

shinyApp(ui, server)

斯塔贾

这是与@cwthom相似的答案，但我并不总是删除每个输入并再次添加它，而是动态插入/删除新输入。这样做的优点是保留了先前为预测变量选择的值。另外，我需要更少observer的，可能会更快一些。

library(tidyverse)
library(shiny)

## store variable names
var_names <- mtcars %>% select(1:5) %>% colnames

ui <- fluidPage(
    ## select number of variables to use
  numericInput(inputId = "n_preds", 
               label = "Number Predictors", 
               value = 1, 
               min = 1,
               max = length(var_names)),
  # anchor where the inputs get added
  div(id = "add_vars")
)

server <- function(input, output, session) {
  current_n_preds <- 0
  
  observeEvent(input$n_preds, {
    
    # add inputs
    if (input$n_preds > current_n_preds) {
      for (i in (current_n_preds + 1):input$n_preds) {
        possible_choices <- setdiff(var_names, preds_selected())
        insertUI(
          selector = "#add_vars",
          ui = div(
            id = paste0("Predictor_", i),
            selectInput(inputId = paste0("Predictor_", i),
                        label = paste0("Predictor ", i),
                        choices = possible_choices,
                        selected = possible_choices[1])
          )
        )
        
        current_n_preds <<- current_n_preds + 1
      }
    } else {
      # remove inputs
      for (i in current_n_preds:(input$n_preds + 1)) {
        removeUI(
          selector = paste0("#Predictor_", i)
        )
        current_n_preds <<- current_n_preds - 1
      }
    }
    
  })
  
  # vector of selected predictors
  preds_selected <- reactive({
    unlist(lapply(seq_len(input$n_preds), function(i) {
      input[[paste0("Predictor_", i)]]
    }))
  })
  
  # update the inputs
  observeEvent(preds_selected(), {
    lapply(seq_len(input$n_preds), function(i) {
      updateSelectInput(session,
                        inputId = paste0("Predictor_", i),
                        choices = c(input[[paste0("Predictor_", i)]],
                                    setdiff(var_names, preds_selected())))
    })
  })
}

shinyApp(ui, server)

编辑

在这里，您可以为每个输入选择以下所有选择的解决方案：

library(tidyverse)
library(shiny)

## store variable names
var_names <- mtcars %>% select(1:5) %>% colnames

ui <- fluidPage(
  ## select number of variables to use
  numericInput(inputId = "n_preds", 
               label = "Number Predictors", 
               value = 1, 
               min = 1,
               max = length(var_names)),
  # anchor where the inputs get added
  div(id = "add_vars")
)

server <- function(input, output, session) {
  current_n_preds <- 0
  
  observeEvent(input$n_preds, {
    
    # add inputs
    if (input$n_preds > current_n_preds) {
      for (i in (current_n_preds + 1):input$n_preds) {
        if (i == 1) {
          possible_choices <- var_names
        } else {
          possible_choices <- setdiff(var_names, preds_selected()[1:(i - 1)])
        }
        insertUI(
          selector = "#add_vars",
          ui = div(
            id = paste0("Predictor_", i),
            selectInput(inputId = paste0("Predictor_", i),
                        label = paste0("Predictor ", i),
                        choices = possible_choices,
                        selected = possible_choices[1])
          )
        )
        
        current_n_preds <<- current_n_preds + 1
      }
    } else {
      # remove inputs
      for (i in current_n_preds:(input$n_preds + 1)) {
        removeUI(
          selector = paste0("#Predictor_", i)
        )
        current_n_preds <<- current_n_preds - 1
      }
    }
    
  })
  
  # vector of selected predictors
  preds_selected <- reactive({
    unlist(lapply(seq_len(input$n_preds), function(i) {
      input[[paste0("Predictor_", i)]]
    }))
  })
  
  # update the inputs
  observeEvent(preds_selected(), {
    lapply(seq_len(input$n_preds), function(i) {
      if (!is.null(input[[paste0("Predictor_", i)]])) {
        if (i == 1) {
          possible_choices <- var_names
        } else {
          possible_choices <- setdiff(var_names, preds_selected()[1:(i - 1)])
        }
        if (input[[paste0("Predictor_", i)]] %in% possible_choices) {
          new_value <- input[[paste0("Predictor_", i)]]
        } else {
          new_value <- possible_choices[1]
        }
        updateSelectInput(session,
                          inputId = paste0("Predictor_", i),
                          choices = possible_choices,
                          selected = new_value)
      }
    })
  })
}

shinyApp(ui, server)