Question

我有以下与这个相对简单的代码无关的问题：

server.R

library(shiny)


server <- function(input, output) {

  list_of_stuff=c("Car","Cat","Dog","Hat","Baby","Tractor")
  reactive_stuff_list <- eventReactive({list(input$select_1,input$select_2,input$select_3)},{

    selection_1=input$select_1
    selection_2=input$select_2
    selection_3=input$select_3

    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_1]
    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_2]
    list_of_stuff=list_of_stuff[! list_of_stuff %in% selection_3]
    return(list_of_stuff)
  })

  output$select1 <- renderUI({
    selectInput(inputId = "select_1", label = "Select some stuff",
              choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })

  output$select2 <- renderUI({
    selectInput(inputId = "select_2", label = "Select some stuff",
                choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })

  output$select3 <- renderUI({
    selectInput(inputId = "select_3", label = "Select some stuff",
                choices=reactive_stuff_list(), selected = NULL, multiple = TRUE)
  })



}

ui.R

ui <- mainPanel(
  uiOutput('select1'),
  uiOutput('select2'),
  uiOutput('select3')
)

我想做什么： 我从一些元素列表开始。然后，只要我选择其中一个＆＃34; selectInputs＆＃34; （比如1号）初始列表也会在其他列表中更新，所以我无法选择我在2/3号的1号中选择的列表。

可悲的是，我不知道如何实现这个目标;尝试了一些东西，但没有任何可用的东西。

基本上我希望它们有点联系，所以它们是分开的但是一起工作。

如果我不清楚，我可以尝试以不同的方式解释它。非常感谢任何指导

Answer 1

您的代码的问题在于它的编写方式，每当任何输入发生更改时（即selectInput更改时），所有reactive_stuff_list()元素都会重新呈现。重新渲染会将选择更改回NULL，因为这是您在selectInput中renderUI次调用中设置的值。

以下是通过在更新可用选项时保留当前输入来解决该问题的实现。

library(shiny)

server <- function(input, output) {

  # Stuff lists

  LIST_OF_STUFF = c("Car", "Cat", "Dog", "Hat", "Baby", "Tractor")

  # Update available choices

  other_select <- function(inputId) {

    # Return a reactive list of input values from all 'select_#' input elements,
    # except for the input element given as the inputId argument.  This allows
    # updating a 'select_#' input element whenever any other 'select_#' input
    # element changes.

    reactive({
      select_ids <- grep("^select_\\d+$", names(input), value = T)
      other_select_ids <- setdiff(select_ids, inputId)

      # Single bracket indexing doesn't work for reactive lists: can't simply
      # select inputs based on character vector.  Work around by iterating with
      # double bracket indexing.

      purrr::map(other_select_ids, purrr::partial(`[[`, input))
    })

  }

  render_select <- function(i, label = "Select some stuff") {

    # A selectInput named 'select_<i>' that re-renders whenever _other_
    # selectInputs named 'select_#' change.  Removes choices that have been made
    # in the other selectInputs named 'select_#', while preserving the existing
    # selections.

    renderUI({

      # Save current input; isolated so that changing own input won't cause the
      # object to re-render.

      this_id <- paste0("select_", i)
      this_input <- isolate(input[[this_id]])

      # Update choices based on selections made in other 'select_#' elements.

      selected_elsewhere <- unlist(other_select(this_id)())
      available_choices <- setdiff(LIST_OF_STUFF, selected_elsewhere)

      selectInput(inputId = this_id, label = label, choices = available_choices, 
        selected = this_input, multiple = TRUE)
    })
  }

  output$select_1 <- render_select(1)
  output$select_2 <- render_select(2)
  output$select_3 <- render_select(3)

}

ui <- mainPanel(uiOutput("select_1"), uiOutput("select_2"), uiOutput("select_3"))

shinyApp(ui, server)

Answer 2

?updateSelectInput在这里是你的朋友......一个简单的例子：

stack.shiny <- function(){
  dat_set <- mtcars

  all_cars <- row.names(dat_set)

  car_brands <- unique(stri_extract_first_words(all_cars))



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

    output$car_brands <- renderUI({
      selectInput(inputId = 'select1', label = 'choose brand',
                  choices = car_brands)
    })

    output$cars <- renderUI({
      selectInput(inputId = 'select2', label = 'choose car',
                  choices = all_cars)
    })

    observeEvent(input$select1, {
      x <- input$select1
      find_pat <- sprintf('^%s', x)
      these_cars <- all_cars[grepl(find_pat, all_cars, perl = TRUE)]
      # Can also set the label and select items
      updateSelectInput(session, "select2",
                        choices = these_cars,
                        selected = NULL)
    })
  }

  ui <- fluidPage(
    uiOutput('car_brands'),
    uiOutput('cars')
  )

  shinyApp(ui, server)

}

动态更新Shiny中多个Select Inputs中使用的列表

2 个答案: