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

Posted 2023-03-24

【中文标题】使用 R/Shiny 创建动态数量的输入元素

【英文标题】：Create dynamic number of input elements with R/Shiny

【发布时间】：2013-10-08 10:55:28

【问题描述】：

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

我将有一个 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 贡献的影响。因此，您只需比较纯色的长度）。

我见过 like this 的示例，其中 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 对象才能工作，所以我把它称为我从this question 学到的第一行

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 才会显示，从而阻止正确创建数据框的任何提示？

【问题讨论】：

您可以使用do.call(sidebarPanel, inputs)，其中inputs 是sliderInput 对象的列表。该列表又可以由lapply(1:4, function(i), sliderInput(inputId = paste0("ind", i), label = paste("Individual", i), min = 0, max = 20000, value = c(0, 2500), step = 250), 生成。这就是你要找的东西吗？

喜欢这个（没想到do.call！）...你愿意举个简单的例子吗？我会用其中的 15 个列表预先填充 inputs，然后根据他们的成员数量（称为 n）执行类似 do.call(sliderbarPanel, inputs[1:n]) 的操作吗？仍然不清楚动态命名它们或仅从列表中提取我想要的数字。

你在我评论的时候评论了。这就是我一直在寻找的东西，我会试一试，然后回复你。随意写下这个简短的例子，我很乐意接受，假设它有效:) 看起来很有希望，和我正在寻找的东西完全一样！

【参考方案1】：

您可以在server.R 中处理 UI 元素的生成，因此您可以：

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 是可以的。

【讨论】：

我喜欢把它放在server.R 中的想法，所以我做到了。从 UI 方面来看，一切似乎都很好，直到我编写代码来实际提取值。我编辑了答案以解释结果。你愿意看看我遇到的问题吗？非常感谢您的帮助！

Kevin，如果您添加一点关于检查动态创建的输入是否为NULL，我想接受这个答案，因为我更喜欢它在闪亮的服务器中作为一种编程选择.有关NULL 检查的更多信息，请参阅mailing list thread。 input$dynamic-name 对象在第一次运行时不存在，因此如果您尝试使用它执行 lapply() 之类的操作，则会收到错误，因为它还不存在。

我可以请您编辑我的答案吗？我不确定NULL 检查应该去哪里。你的意思是if (!(is.null(input$numIndividuals))) ... else return(NULL) 之类的吗？

另外，写你自己的答案是完全可以接受的（拿我的部分让你开始）并接受它是正确的。

哈！没想到。我仍然认为我的真实代码是一团糟，而且我没有掌握反应式输入的复杂性，但是由于您的帖子和邮件列表，它现在可以工作了。我认为它的运行速度很慢，因为如果input$obj 尚不存在（它在第一次运行时不存在），几乎任何可能导致错误的事情都必须执行if(is.null(input$obj)) else 行。

【参考方案2】：

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

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

请参阅here 以获取有效的 Shiny 示例。工作要点here.

来源：Joe Cheng的第一个答案，大约一半this thread

【讨论】：

将值保存为向量而不是 data.frame 的任何方向？

@JeffParker 也许这有帮助？ ***.com/questions/7070173/…

sapply(1:num, function(i) input[[paste0("ind", i)]] ) 成功了。

【参考方案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)

【讨论】：

我基本上使用了这个想法，但像上面凯文建议的那样把它放在server.R 中。不幸的是，我在实际访问结果中存储的值时遇到了问题。我编辑了我的答案以详细说明。

试试看这里：***.com/questions/22160372/…。该方法不需要提前知道 input$numIndividuals，而且，您可以保存之前的输入。