R 在Shiny应用程序中动态更新选择列表_R_Shiny

R 在Shiny应用程序中动态更新选择列表

r shiny

R 在Shiny应用程序中动态更新选择列表,r,shiny,R,Shiny,我有一个应用程序，允许用户指定他们将选择多少预测值，并相应地选择每个预测值。有谁能告诉我，我怎样才能为每个后续预测做出反映之前预测的选择预测选择例如，如果预测器1=cyl，那么预测器2的选择将是{disp，drat，hp，mpg}。然后，如果预测器2=hp，那么预测器3的选择将是{disp，drat，mpg} ## libraries library(tidyverse) library(shiny) ## store variable names var_names <- mtca

我有一个应用程序，允许用户指定他们将选择多少预测值，并相应地选择每个预测值。有谁能告诉我，我怎样才能为每个后续预测做出反映之前预测的选择预测选择

例如，如果预测器1=cyl，那么预测器2的选择将是{disp，drat，hp，mpg}。然后，如果预测器2=hp，那么预测器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)

您可以尝试使用conditionalPanel根据input$inputID变量反应性地显示不同的UI输入。这需要在UI函数上实现

或者，switch函数听起来也可以满足您的需要。

您可以尝试使用conditionalPanel根据您的input$inputID变量反应性地显示不同的UI输入。这需要在UI函数上实现

或者，switch函数听起来也可以满足您的需要。

实现这一点的方法可能比循环更优雅，但您可以使用insertUI和observeEvent的组合来动态创建所需的所有不同观察者。它有助于在UI中创建一个容器，在其中插入元素，并将每个selectInput包装在一个div中，以便在预测器的数量发生变化时轻松删除它们：

# 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)),
  
  # create container for predictors to live in
  div(id = "preds-container")
)

server <- function(input, output, session) {
  
  observeEvent(input$n_preds, {
    
    # clear out previous predictors
    removeUI(selector = ".pred", multiple = TRUE)
    
    # define function for updating select input
    updatePredictor <- function(session, input, i, var_names) {
      updateSelectInput(session, paste("predictor", i, sep = "_"),
                        
                        # get remaining possible options from previous inputs
                        choices = setdiff(
                          var_names, 
                          unlist(
                            reactiveValuesToList(input)[paste("predictor", 1:(i-1), sep = "_")]
                          ))
      )
    }
    
    # loop through each predictor
    for (i in seq_len(input$n_preds)) {
      
      # insert a new predictor
      insertUI(selector = "#preds-container",
               where = "beforeEnd",
               ui = div(class = "pred",
                        selectInput(inputId = paste("predictor", i, sep = "_"),
                                    label = paste("Predictor", i),
                                    choices = var_names)))
      
      # update to reflect previous choices
      updatePredictor(session, input, i, var_names)
      
      # create observers for each of the previous inputs to update the current one
      for (j in seq_len(i-1)) {
        observeEvent(
          
          # observe predictor j for j = 1, 2, ..., i-1
          eventExpr = input[[paste("predictor", j, sep = "_")]], 
          
          # update predictor i
          handlerExpr = updatePredictor(session, input, i, var_names),
          ignoreNULL = FALSE)
      }
    }
    
  })
  
}

shinyApp(ui, server)

如果您这样做，我可能会建议您使用一个按钮来触发任何依赖于不同预测器的计算/输出，否则，由于所有对updateSelectInput的调用，您可能会得到许多无意义的重新渲染。

可能有比循环更优雅的方法来实现这一点，但是您可以使用insertUI和observeEvent的组合来动态创建所需的所有不同的观察者。它有助于在UI中创建一个容器，在其中插入元素，并将每个selectInput包装在一个div中，以便在预测器的数量发生变化时轻松删除它们：

# 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)),
  
  # create container for predictors to live in
  div(id = "preds-container")
)

server <- function(input, output, session) {
  
  observeEvent(input$n_preds, {
    
    # clear out previous predictors
    removeUI(selector = ".pred", multiple = TRUE)
    
    # define function for updating select input
    updatePredictor <- function(session, input, i, var_names) {
      updateSelectInput(session, paste("predictor", i, sep = "_"),
                        
                        # get remaining possible options from previous inputs
                        choices = setdiff(
                          var_names, 
                          unlist(
                            reactiveValuesToList(input)[paste("predictor", 1:(i-1), sep = "_")]
                          ))
      )
    }
    
    # loop through each predictor
    for (i in seq_len(input$n_preds)) {
      
      # insert a new predictor
      insertUI(selector = "#preds-container",
               where = "beforeEnd",
               ui = div(class = "pred",
                        selectInput(inputId = paste("predictor", i, sep = "_"),
                                    label = paste("Predictor", i),
                                    choices = var_names)))
      
      # update to reflect previous choices
      updatePredictor(session, input, i, var_names)
      
      # create observers for each of the previous inputs to update the current one
      for (j in seq_len(i-1)) {
        observeEvent(
          
          # observe predictor j for j = 1, 2, ..., i-1
          eventExpr = input[[paste("predictor", j, sep = "_")]], 
          
          # update predictor i
          handlerExpr = updatePredictor(session, input, i, var_names),
          ignoreNULL = FALSE)
      }
    }
    
  })
  
}

shinyApp(ui, server)

如果您这样做，我可能会建议您使用一个按钮来触发任何依赖于不同预测值的计算/输出，否则您可能会由于所有对updateSelectInput的调用而得到许多无意义的重新渲染。

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

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)

这里有一个与@cwtom类似的答案，但我并不总是删除每个输入并再次添加，而是动态插入/删除新输入。这样做的优点是保留了先前为预测器选择的值。另外，我需要更少的观察员，这可能会快一点

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)

我认为insertUI/removeUI是一种很好的方法，但是您首先总是删除所有现有的输入，从而丢失以前选择的值。我认为你推荐的计算按钮非常好。@starja这是真的，肯定会更有效率。我认为可能的用户行为可能是首先为n确定一个值，因此在实践中我想知道这是否太重要了？我认为insertUI/removeUI是一个好方法，但是您首先总是删除所有现有的输入，从而丢失以前选择的值。我认为你推荐的计算按钮非常好。@starja这是真的，肯定会更有效率。我认为可能的用户行为可能是首先为n确定一个值，所以在实践中我想知道这是否太重要了？我认为这有一个缺陷，当你增加输入$n_preds时，你会失去预测值中的选项-如果你将其设置为5，那么预测值1必须是mpg，预测值2必须是cyl等等。这可能是因为，根据之后运行的计算，用户需要能够设置所有5个预测值，但顺序不同？编辑-我说缺陷，太强了-我的意思是它提供了不同的用户体验，可能不是预期的体验，即使有这种不同的体验，我认为这个解决方案最好地抓住了我想要的。一个好处是，即使添加或删除预测值，也会保留以前的选择。谢谢你们的回复。非常感谢@CWTOM感谢您的投入！我已经玩了一点，我想现在找到了解决办法。DJC我的编辑做你想要的吗？是的。作品great1@starja我只是想提一下，我刚才在这里问了另一个相关的问题-您的解决方案还没有实现，但很快就会实现：我认为这有一个缺陷，当您增加输入$n_preds时，您会失去预测值中的选项-如果您将其设置为5，那么pre

指令1必须是mpg，预测器2必须是cyl，依此类推。这可能是因为，根据之后运行的计算，用户需要能够设置所有5个预测值，但顺序不同？编辑-我说缺陷，太强了-我的意思是它提供了不同的用户体验，可能不是预期的体验，即使有这种不同的体验，我认为这个解决方案最好地抓住了我想要的。一个好处是，即使添加或删除预测值，也会保留以前的选择。谢谢你们的回复。非常感谢@CWTOM感谢您的投入！我已经玩了一点，我想现在找到了解决办法。DJC我的编辑做你想要的吗？是的。作品great1@starja我只是想提一下，我刚才在这里问了另一个相关问题-您的解决方案尚未实施，但很快就会实施：