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

使用R/s创建输入元素的动态数量,r,dynamic,input,shiny,R,Dynamic,Input,Shiny,我正在写一个闪亮的应用程序来可视化我公司的保险福利计划。以下是我希望发生的事情: 我将有一个selectInput或sliderInput,用户将在其中选择医疗计划中的人数 将出现匹配数量的双面滑块(每个成员一个) 然后,他们可以在计划中输入每个成员的最佳/最差医疗费用估算 我有一些代码,可以获取这些估算值,并创建并排图,说明三个计划产品的预测成本,以便他们可以根据估算值决定哪一个最便宜 下面是我当前的ui.R文件,其中包含硬编码输入,模拟了一个四口之家: shinyUI(pageWithS

我正在写一个闪亮的应用程序来可视化我公司的保险福利计划。以下是我希望发生的事情:

  • 我将有一个
    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)
    })

  })

})
最后,我有两个函数,它们创建对象来存储数据帧,以便根据低医疗费用和高医疗费用估算进行绘图。它们被称为
最佳情况
最差情况
,都需要
费用
对象来工作,因此我将其称为我从


我得到两个输出,我认为这是由于定义了
费用
并随后调用了它。奇怪的是。。。当
最坏情况
使用完全相同的
费用时,我没有第三个。您可以使用
do生成侧栏。调用
lappy
,类似于:

# 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)
ui.R
----

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

您可以在
server.R
中处理UI元素的生成,因此您有如下功能:

# 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)
ui.R
----

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

server.R
--------
shinyServer(功能(输入、输出、会话){

输出$sliders您可以使用以下语法从Shining访问动态命名的变量:

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

输出$sliders您可以使用
do.call(侧栏面板,输入)
,其中
inputs
sliderInput
对象的列表。该列表可以依次由
lappy(1:4,函数(i),sliderInput(inputId=paste0(“ind”,i),label=paste(“单个”,i),min=0,max=20000,value=c(0,2500),step=250)生成,
。这就是你要找的吗?喜欢这样(没有想到
do.call
!)…你想展示一个简单的例子吗?我会预先填充
inputs
,比如说其中的15个,然后根据他们的成员数量(称之为
n
)执行类似于
do.call(sliderbarPanel,inputs[1:n])
?仍然不清楚如何动态命名它们或仅从列表中提取我想要的数字。我在评论时您发表了评论。这就是我要找的,我会尝试一下,然后再给您回复。请随意写一个简短的示例,我很乐意接受,假设它有效:)看起来很有希望,和我想要的东西完全一样!我喜欢把它放在
server.R
中的想法,所以我就这么做了。从UI方面看,一切似乎都很好,直到我编写了代码来实际提取值。我编辑了我的答案来解释结果。你愿意看看我正在讨论的问题吗Entering?非常感谢您的帮助!Kevin,如果您添加一点关于检查动态创建的输入是否为
NULL
,我愿意接受这个答案,因为我更喜欢它如何在Shining server中作为一种编程选择。有关
NULL
检查的更多理解,请参阅。对象
input$dynamic name
第一次循环时不存在,因此如果您尝试使用它执行类似于
lappy()
的操作,您会得到一个错误,因为它还不存在。我可以请您编辑我的答案吗?我不太确定
NULL
检查应该放在哪里。您是指
if(!(is.NULL(input$numIndividuals)){…}或者{return(NULL)}
?或者,写自己的答案是完全可以接受的(以我让你开始的部分为例)我仍然认为我真正的代码是一团糟的,我没有掌握反应式输入的复杂性,但是现在它可以工作了,这要感谢你的帖子和邮件列表。我认为它运行得相当慢,就像人们不得不做的那样
if(is.null(input$obj)){}else{}
行,如果
input$obj
还不存在(在第一次运行时不存在),几乎任何可能导致错误的内容。我基本上使用了这个想法,但将其放在了服务器中。R
,就像Kevin在上面建议的那样。不幸的是,我在访问结果中存储的值时遇到了问题。我编辑了我的答案以进行详细说明。试着看一下这里:。这种方法不需要事先知道input$numIndividuals,而且,您可以保存以前的输入.关于将值保存为矢量而不是数据帧的任何方向?@JeffPark
server.R
--------

shinyServer( function(input, output, session) {

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


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