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

Question

I'm trying to create a dynamic UI that produces N amount of sections based on the number of selected variables from a selectInput() command.我正在尝试创建一个动态 UI，该 UI 根据selectInput()命令中所选变量的数量生成 N 个部分。 For each variable selected, I want to have its own section that lets you further specify other attributes for that variable (eg if it's numeric or character, how to impute missing values, etc.)对于选择的每个变量，我希望有自己的部分，让您进一步指定该变量的其他属性（例如，如果它是数字或字符，如何估算缺失值等）

I have experience with insertUI() and removeUI() and was able to produce a small example of what I want it to look like.我有使用insertUI()和removeUI()的经验，并且能够制作一个我希望它看起来像的小例子。 The section of my code that does this looks like this:执行此操作的代码部分如下所示：

    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")
      )
    )

What I want to accomplish is to make the section above robust and dynamic in the sense that if the user only selects 2 variables, then I'd only want to create sections h4("Covariate 1 (example)") and h4("Covariate 2 (example)") .我想要完成的是使上面的部分变得健壮和动态，如果用户只选择 2 个变量，那么我只想创建部分h4("Covariate 1 (example)")和h4("Covariate 2 (example)") 。 For example, if age and sex were selected then I'd want my section to look like:例如，如果选择了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")
                    
      )
    )

I was initially going to approach this by looping over the variables in the selected input and creating a long character string of the desired output (ie the chunks of h4(Covariate N) ), and then passing that through eval(parse(text="...")) .我最初打算通过遍历所选输入中的变量并创建所需 output 的长字符串（即h4(Covariate N)的块），然后通过eval(parse(text="...")) 。 Something that in the end will look like this:最终会是这样的：

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

where the "..." section are the chunks of h4("Covariate N) treated as a character string. Now, I don't know if this will work but it's the only approach I have at the moment. Is there a better way of approaching this problem, perhaps with some of the functions within shiny ? Any help or advice will be greatly appreciated. My mock example can be found below:其中"..."部分是将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

In the description page of insertUI function, it says:在insertUI function 的描述页面中，它说：

Unlike renderUI(), the UI generated with insertUI() is persistent: once it's created, it stays there until removed by removeUI().与 renderUI() 不同，使用 insertUI() 生成的 UI 是持久的：一旦创建，它就会一直保留在那里，直到被 removeUI() 删除。 Each new call to insertUI() creates more UI objects, in addition to the ones already there (all independent from one another).对 insertUI() 的每次新调用都会创建更多的 UI 对象，除了已经存在的对象（都相互独立）。 To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function.要更新 UI 的一部分（例如：输入对象），您必须使用适当的渲染 function 或自定义的反应式 function。

So you cannot use insertUI here.所以你不能在这里使用insertUI 。 Instead, use renderUI function with uiOutput to dynamically generate ui element.相反，使用renderUI的uiOutput来动态生成 ui 元素。

Next, to generate a ui multiple times based on selection, you can use lapply .接下来，要根据选择多次生成 ui，您可以使用lapply 。 Since the number of iteration will be dependent on the number of items in the vector, which is the input$ object;由于迭代次数将取决于向量中的项目数，即input$ object； the number of generated ui will be based on number of selection.生成的 ui 的数量将基于选择的数量。

I think the code below solves your problem:我认为下面的代码可以解决您的问题：

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

问题描述

1 个解决方案

解决方案1
1 已采纳 2020-06-24 06:56:33

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

问题描述

1 个解决方案

解决方案1 1 已采纳 2020-06-24 06:56:33

解决方案1
1 已采纳 2020-06-24 06:56:33