使用R / Shiny创建动态数量的输入元素

Question

我正在写一个Shiny应用程序，用于可视化我公司的保险福利计划。 这是我想要发生的事情：

• 我将有一个selectInput或sliderInput ，用户将在其中选择他们的医疗计划中的个人数量
• 将出现匹配数量的双面滑块（每个成员一个）
• 然后，他们可以输入他们对计划中每个成员的最佳/最差病例医疗费用的估计
• 我的代码将采用这些估算并创建并排图表，说明三个计划产品的预测成本，以便他们可以根据他们的估算确定哪一个最便宜

这是我当前的带有硬编码输入的ui.R文件，模拟一个四口之家：

shinyUI(pageWithSidebar(

  headerPanel("Side by side comparison"),

  sidebarPanel(

    selectInput(inputId = "class", label = "Choose plan type:",
                list("Employee only" = "emp", "Employee and spouse" = "emp_spouse",
                     "Employee and child" = "emp_child", "Employee and family" = "emp_fam")),

    sliderInput(inputId = "ind1", label = "Individual 1",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind2", label = "Individual 2",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind3", label = "Individual 3",
                min = 0, max = 20000, value = c(0, 2500), step = 250),

    sliderInput(inputId = "ind4", label = "Individual 4",
                min = 0, max = 20000, value = c(0, 2500), step = 250)
    ),

  mainPanel(
    tabsetPanel(  
    tabPanel("Side by Side", plotOutput(outputId = "main_plot", width = "100%")),
    tabPanel("Summary", tableOutput(outputId = "summary"))
  )
)))

这就是它的样子（透明的末端部分是两个计划的HSA贡献的结果。我认为这是一个很好的方式来显示保费和医疗费用，同时显示公司HSA贡献的影响。因此，你我只是比较纯色的长度。

我看到的例子这样其中UI输入本身是固定的（在这种情况下，一个checkboxGroupInput存在，但它的内容是根据从另一个UI输入的选择定制），但我还没有看到剪裁多个示例（或者说，输入元素作为另一个UI输入内容的结果而产生的输入元素。

对此有任何建议（甚至可能）？

---

我的最后一招是创建15个输入滑块并将它们初始化为零。 我的代码工作得很好，但是我想通过不必为偶尔拥有一个非常大的家庭的用户创建那么多滑块来清理界面。

---

根据Kevin Ushay的回答更新

我试着去server.R路由并有这个：

shinyServer(function(input, output) {

  output$sliders <- renderUI({
    members <- as.integer(input$members) # default 2
    max_pred <- as.integer(input$max_pred) # default 5000
    lapply(1:members, function(i) {
      sliderInput(inputId = paste0("ind", i), label = paste("Individual", i),
                  min = 0, max = max_pred, value = c(0, 500), step = 100)
    })

  })

})

紧接着，我尝试从每个人的费用中提取input值：

expenses <- reactive({
    members <- as.numeric(input$members)

    mins <- sapply(1:members, function(i) {
      as.numeric(input[[paste0("ind", i)]])[1]
    })

    maxs <- sapply(1:members, function(i) {
      as.numeric(input[[paste0("ind", i)]])[2]
    })

    expenses <- as.data.frame(cbind(mins, maxs))
})

最后，我有两个函数创建对象来存储数据框，以便根据低和高医疗费用估算进行绘图。 它们被称为best_case和worst_case并且都需要expenses对象才能工作，因此我将其称为我的第一行，因为我从这个问题中学到了

best_case <- reactive({

    expenses <- expenses()

    ...

)}

我有一些错误，所以我使用browser()来逐步完成expenses并注意到input$ind1类的特殊内容似乎不存在于expenses函数中。

我还在其中使用各种print()语句来查看发生了什么。 最引人注目的是当我print(names(input))作为函数的第一行时：

[1] "class"    "max_pred" "members" 

[1] "class"    "ind1"     "ind2"     "max_pred" "members" 

我得到两个输出，我认为这是由于expenses的定义和随后的调用。 奇怪的是......当worst_case使用完全相同的expenses <- expense()行时，我没有得到第三个。

如果我在expenses函数中执行类似print(expenses)的操作，我也会得到重复：

# the first
  mins maxs
1   NA   NA
2   NA   NA

# the second
  mins maxs
1    0  500
2    0  500

关于为什么我的ind1和ind2 input元素在第二次调用expenses之前不会出现的任何提示，从而阻止正确创建数据框？

Answer 1

你可以在server.R处理UI元素的server.R ，所以你有类似的东西：

ui.R
----

shinyUI( pageWithSideBar(
    ...
    selectInput("numIndividuals", ...)
    uiOutput("sliders"),
    ...
))

和

server.R
--------

shinyServer( function(input, output, session) {

  output$sliders <- renderUI({
    numIndividuals <- as.integer(input$numIndividuals)
    lapply(1:numIndividuals, function(i) {
      sliderInput(...)
    })
  })


})

当我拥有依赖于其他UI元素的值的UI元素时，我发现在server.R生成它们最容易。

理解所有_Input函数只生成HTML是有用的。 当您想要动态生成HTML时，将其移动到server.R 。 也许值得强调的另一件事是可以在renderUI调用中返回HTML'元素' list 。

Answer 2

您可以使用以下语法从shiny中访问动态命名的变量：

input[["dynamically_named_element"]]

因此，在上面的示例中，如果您初始化滑块元素

# server.R

output$sliders <- renderUI({
  members <- as.integer(input$members) # default 2
  max_pred <- as.integer(input$max_pred) # default 5000
  lapply(1:members, function(i) {
    sliderInput(inputId = paste0("ind", i), label = paste("Individual", i),
                min = 0, max = max_pred, value = c(0, 500), step = 100)
  })
})

# ui.R

selectInput("num", "select number of inputs", choices = seq(1,10,1))
uiOutput("input_ui")

您可以使用以下方法将值打印到表中

# server.R

output$table <- renderTable({
    num <- as.integer(input$num)

    data.frame(lapply(1:num, function(i) {
      input[[paste0("ind", i)]]
    }))
  })

# ui.R

tableOutput("table")

请看这里有一个有效的例子。 在这里工作要点。

资料来源：Joe Cheng的第一个答案，大约是这个帖子的一半

Answer 3

您可以使用do.call和lapply生成侧边栏，例如：

# create the first input, which isn't dynamic
sel.input = selectInput(inputId = "class", label = "Choose plan type:",
            list("Employee only" = "emp", "Employee and spouse" = "emp_spouse",
                 "Employee and child" = "emp_child", "Employee and family" = "emp_fam"))

num.individuals = 5  # determine the number of individuals here

# concatenate the select input and the other inputs
inputs = c(list(sel.input), lapply(1:num.individuals, function(i) {
    sliderInput(inputId = paste0("ind", i), label = paste("Individual", i), min = 0, max = 20000, value = c(0, 2500), step = 250)
}))

sidebar.panel = do.call(sidebarPanel, inputs)