Создание динамического количества элементов ввода с помощью R/Shiny

Я пишу приложение 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. Таким образом, вы просто сравниваете длину сплошных цветов).

Я видел примеры как это, где сам пользовательский интерфейс фиксирован (в этом случае один checkboxGroupInput существует, но его содержимое настраивается на основе выбора из другого ввода пользовательского интерфейса), но я не видел примеров подгонки количества (или, скажем, типа) входных элементов, порожденных в результате другого содержимого ввода пользовательского интерфейса.

Любые предложения по этому поводу (возможно ли это)?

Моим последним средством будет создание, скажем, 15 ползунков ввода и их инициализация до нуля. Мой код будет работать отлично, но я бы хотел очистить интерфейс, не создавая столько слайдеров только для случайного пользователя, у которого очень большая семья.

Обновление на основе ответа Кевина Ушая

Я попытался пройти маршрут 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 не будет вызван во второй раз и, таким образом, не будет корректно создан фрейм данных?

Ответы

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


})

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

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