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

Question

I'm writing a Shiny app for visualizing insurance benefit plans at my company. Here is what I'd like to happen:

• I'll have a selectInput or sliderInput where the user will choose the number of individuals on their medical plan
• A matching number of double sided sliders will appear (one for each member)
• They can then input their estimates for best/worst case medical expenses for each member on their plan
• I have code that will take those estimates and create side by side plots illustrating the forecast cost on the three plan offerings so they can decide which one is least expensive based on their estimates

Here's my current ui.R file with hard coded inputs, simulating a family of four:

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

Here's what it looks like (the transparent end sections are the result of HSA contributions from two of the plans. I thought it was a nice way to show both the premiums and medical expenses while showing the impact of the company HSA contribution. Thus, you'd just compare the length of the solid colors).

I've seen examples like this where the UI input itself is fixed (in this case, one checkboxGroupInput exists, but its contents are tailored based on the choice from another UI input), but I've not seen examples of tailoring the number (or, say, type) of input elements spawned as the result of another UI input's contents.

Any suggestions on this (is it even possible)?

---

My last resort will be to create, say, 15 input sliders and initialize them to zero. My code will work just fine, but I'd like to clean up the interface by not having to create that many sliders just for the occasional user who has a very large family.

---

Update based on Kevin Ushay's answer

I tried to go the server.R route and have this:

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

  })

})

Immediately afterwards, I try and extract the values out of input for each individual's expenses:

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

Lastly, I have two functions that create objects to store a data frame for plotting based on the low and high medical expense estimates. They're called best_case and worst_case and both need the expenses object to work, so I call it as my first line as I learned from this question

best_case <- reactive({

    expenses <- expenses()

    ...

)}

I got some errors, so I used browser() to step through the expenses bit and noticed peculiar things like input$ind1 not seeming to exist from within the expenses function.

I also played around with various print() statements in it to see what was happening. The most striking is when I do print(names(input)) as the very first line in the function:

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

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

I get two outputs, which I believe is due to the defining of expenses and subsequent calling of it. Strangely... I don't get a third when worst_case uses the exact same expenses <- expense() line.

If I do something like print(expenses) inside of my expenses function, I also get duplicates:

# the first
  mins maxs
1   NA   NA
2   NA   NA

# the second
  mins maxs
1    0  500
2    0  500

Any tips on why my input elements for ind1 and ind2 wouldn't show up until expenses is called the second time and thus prevent the data frame from being created correctly?

Answer 1

You could handle generation of the UI element in server.R , so you have something like:

ui.R
----

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

and

server.R
--------

shinyServer( function(input, output, session) {

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


})

When I have UI elements that depend on values from other UI elements, I find it easiest to generate them in server.R .

It's useful to understand that all of the _Input functions just generate HTML . When you want to generate that HTML dynamically it makes sense to move it to server.R . And perhaps the other thing worth emphasizing is that it's okay to return a list of HTML 'elements' in a renderUI call.

Answer 2

You can access dynamically named variables from shiny using this syntax:

input[["dynamically_named_element"]]

So in your example above, if you initialise your slider elements as so

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

You can print the values to a table using the following

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

See here for a working Shiny example. Working gist here .

Source: Joe Cheng's first answer, about half way down this thread

Answer 3

You could generate the sidebar with do.call and lapply , something like:

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