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

shiny-example

我见过示例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()行时，我没有得到第三个。

如果我在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的{{1}}元素在ind2第二次调用之前不显示的原因提示，从而阻止了数据框的出现正确创建了吗？

Answer 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是有意义的。也许值得强调的另一件事是，可以在list调用中返回renderUI个HTML'元素'。

Answer 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

的一半

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)

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

3 个答案: