R Shiny：从选定的输入创建动态 UI

Question

我正在尝试创建一个动态 UI，它根据从 selectInput() 命令中选择的变量数量生成 N 个部分。对于每个选定的变量，我希望有自己的部分，让您进一步指定该变量的其他属性（例如，如果它是数字或字符，如何估算缺失值等）

我有使用 insertUI() 和 removeUI() 的经验，并且能够生成一个我希望它看起来像的小示例。我执行此操作的代码部分如下所示：

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )

我想要完成的是使上面的部分变得健壮和动态，因为如果用户只选择 2 个变量，那么我只想创建部分 h4("Covariate 1 (example)") 和 h4("Covariate 2 (example)").例如，如果选择了 age 和 sex，那么我希望我的部分看起来像：

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Age"),
                    selectInput("age_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("age_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("age_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Sex"),
                    selectInput("sex_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("sex_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("sex_impute_default_level", "Impute default level","0")
                    
      )
    )

我最初打算通过遍历所选输入中的变量并创建所需输出的长字符串（即 h4(Covariate N) 的块），然后将其传递给 eval(parse(text="..."))。最终看起来像这样的东西：

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    eval(parse(text="..."))
      )
    )

其中 "..." 部分是 h4("Covariate N) 的块，被视为字符串。现在，我不知道这是否可行，但这是我目前唯一的方法。有没有更好的方法来解决这个问题，也许使用 shiny 中的一些函数？任何帮助或建议将不胜感激。我的模拟示例可以在下面找到：

library(shiny)
library(shinyjs)

ui <- shinyUI(fluidPage(
  shinyjs::useShinyjs(),
  navbarPage("Test",id="navbarPage",
             tabPanel("First tab", id = "first_tab",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE), 
                          actionButton("set.covariates","Set"),
                          tags$hr(),
                          tags$div(id = 'ui_test')
                        ),
                        mainPanel(
                          verbatimTextOutput("list")
                        )
                      )
             ))
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  
  observe({
    if (is.null(input$covariates) || input$covariates == "") {
      shinyjs::disable("set.covariates")
      
    } else {
      shinyjs::enable("set.covariates")
    }
  })
  
  observeEvent(input$set.covariates, {
    shinyjs::disable("set.covariates")
  })
  
  prep.list <- eventReactive(input$set.covariates,{
    cov <- input$covariates
    timeIndep.list <- NULL
    for(L0.i in seq_along(cov)){
      timeIndep.list[[L0.i]] <- list("categorical"=FALSE,
                                     "impute"=NA,
                                     "impute_default_level"=NA)
    }
    names(timeIndep.list) <- cov
    return(timeIndep.list)
  })
  
  output$list <- renderPrint({
    prep.list()
  })
  
  observeEvent(req(input$set.covariates), {
    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )})
  
  observeEvent({input$covariates}, {
    removeUI(selector = '#extra_criteria')
  })
  
  
})

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

在insertUI函数的描述页面中，它说：

Unlike renderUI(), the UI generated with insertUI() is persistent: once it's created, it stays there until removed by removeUI(). Each new call to insertUI() creates more UI objects, in addition to the ones already there (all independent from one another). To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function.

所以你不能在这里使用insertUI。相反，使用 renderUI 函数和 uiOutput 动态生成 ui 元素。

接下来，要根据选择多次生成ui，可以使用lapply。由于迭代次数将取决于向量中的项目数，即 input$ 对象；生成的数量 ui 将基于选择的数量。

我认为下面的代码可以解决您的问题：

library(shiny)
library(shinyjs)

ui <- shinyUI(fluidPage(
  shinyjs::useShinyjs(),
  navbarPage("Test",id="navbarPage",
             tabPanel("First tab", id = "first_tab",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE), 
                          actionButton("set.covariates","Set"),
                          tags$hr(),
                          uiOutput("covariateop")
                        ),
                        mainPanel(
                          verbatimTextOutput("list")
                        )
                      )
             ))
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  
  observe({
    if (is.null(input$covariates) || input$covariates == "") {
      shinyjs::disable("set.covariates")
      
    } else {
      shinyjs::enable("set.covariates")
    }
  })
  
  observeEvent(input$set.covariates, {
    shinyjs::disable("set.covariates")
  })
  
  prep.list <- eventReactive(input$set.covariates,{
    cov <- input$covariates
    timeIndep.list <- NULL
    for(L0.i in seq_along(cov)){
      timeIndep.list[[L0.i]] <- list("categorical"=FALSE,
                                     "impute"=NA,
                                     "impute_default_level"=NA)
    }
    names(timeIndep.list) <- cov
    return(timeIndep.list)
  })
  
  output$list <- renderPrint({
    prep.list()
  })
  
  observeEvent(req(input$set.covariates), {
    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )})
  
  observeEvent(req(input$set.covariates), {
    output$covariateop <- renderUI({  
      lapply(input$covariates, function(x){
      
        tags$div(id = paste0("extra_criteria_for_", x),
                 h4(x),
                 selectInput("cov_1_class", "Covariate class",
                             choices = c("numeric","character")),
                 selectInput("cov_1_impute", "Impute",
                             choices = c("default","mean","mode","median")),
                 textInput("cov_1_impute_default_level", "Impute default level","0"),
                 tags$hr()
        )
      })
    })
    
  })
  
  observeEvent({input$covariates}, {
    removeUI(selector = '#extra_criteria')
  })
  
  
})

# Run the application
shinyApp(ui = ui, server = server)

R Shiny：从选定的输入创建动态 UI

R Shiny: create dynamic UI from selected input

r

shiny

shiny-reactivity

shinyjs