使用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()线时,我没有得到第三个.

如果我print(expenses)在我的expenses函数内部执行某些操作,我也会重复:

# the first
  mins maxs
1   NA   NA
2   NA   NA

# the second
  mins maxs
1    0  500
2    0  500

有关为什么我的input元素出现ind1和ind2不会出现的任何提示expenses被称为第二次,从而阻止正确创建数据框？

Answer 1

你可以处理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.也许值得强调的另一件事是,list在renderUI调用中返回HTML'元素'是可以的.

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)