img - Crear un número dinámico de elementos de entrada con R/Shiny
tags$style shiny (3)
Estoy escribiendo una aplicación Shiny para visualizar planes de beneficios de seguro en mi compañía. Esto es lo que me gustaría que suceda:
- Tendré un
selectInputosliderInputdonde el usuario elegirá el número de personas en su plan médico - Aparecerá un número coincidente de deslizadores de doble cara (uno para cada miembro)
- Luego pueden ingresar sus estimados para los gastos médicos del mejor / peor caso para cada miembro en su plan
- Tengo un código que tomará esas estimaciones y creará gráficos paralelos que ilustrarán el costo del pronóstico en las tres ofertas del plan para que puedan decidir cuál es el menos costoso según sus estimaciones
Aquí está mi archivo ui.R actual con entradas codificadas, simulando una familia de cuatro:
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"))
)
)))
Esto es lo que parece (las secciones finales transparentes son el resultado de las contribuciones HSA de dos de los planes. Pensé que era una buena manera de mostrar tanto las primas como los gastos médicos al tiempo que mostraba el impacto de la contribución HSA de la empresa. simplemente compare la longitud de los colores sólidos).
He visto ejemplos como este donde la entrada de UI en sí es fija (en este caso, existe una checkboxGroupInput GroupInput, pero su contenido se adapta según la elección de otra entrada de UI), pero no he visto ejemplos de adaptar el número ( o, digamos, escribir) de elementos de entrada engendrados como resultado de los contenidos de otra entrada UI.
Alguna sugerencia sobre esto (¿es posible?)
Mi último recurso será crear, digamos, 15 controles deslizantes de entrada e inicializarlos a cero. Mi código funcionará bien, pero me gustaría limpiar la interfaz al no tener que crear tantos controles deslizantes solo para el usuario ocasional que tiene una familia muy grande.
Actualización basada en la respuesta de Kevin Ushay
Traté de ir al server.R route y tengo esto:
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)
})
})
})
Inmediatamente después, intento extraer los valores de input para los gastos de cada individuo:
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))
})
Por último, tengo dos funciones que crean objetos para almacenar un marco de datos para trazar en función de las estimaciones de gastos médicos bajos y altos. Se llaman best_case y worst_case y ambos necesitan los expenses para funcionar, así que lo llamo mi primera línea, como aprendí de esta pregunta.
best_case <- reactive({
expenses <- expenses()
...
)}
Obtuve algunos errores, así que usé el browser() para pasar por el bit de expenses y noté cosas peculiares como la input$ind1 no parecía existir desde dentro de la función de expenses .
También jugué con varias declaraciones de print() para ver qué estaba pasando. Lo más llamativo es cuando print(names(input)) como la primera línea en la función:
[1] "class" "max_pred" "members"
[1] "class" "ind1" "ind2" "max_pred" "members"
Obtengo dos resultados, que creo que se deben a la definición de los expenses y la consiguiente convocatoria. Extrañamente ... No obtengo un tercero cuando worst_case utiliza la misma línea de expenses <- expense() .
Si hago algo como print(expenses) dentro de mi función de expenses , también obtengo duplicados:
# the first
mins maxs
1 NA NA
2 NA NA
# the second
mins maxs
1 0 500
2 0 500
¿Alguna sugerencia sobre por qué mis elementos de input para ind1 e ind2 no aparecerán hasta que se llamen los expenses segunda vez y así evitar que el marco de datos se cree correctamente?
Podría manejar la generación del elemento UI en server.R , por lo que tiene algo como:
ui.R
----
shinyUI( pageWithSideBar(
...
selectInput("numIndividuals", ...)
uiOutput("sliders"),
...
))
y
server.R
--------
shinyServer( function(input, output, session) {
output$sliders <- renderUI({
numIndividuals <- as.integer(input$numIndividuals)
lapply(1:numIndividuals, function(i) {
sliderInput(...)
})
})
})
Cuando tengo elementos de UI que dependen de valores de otros elementos de UI, me resulta más fácil generarlos en server.R .
Es útil comprender que todas las funciones _Input solo generan HTML . Cuando desee generar ese HTML dinámicamente , tiene sentido moverlo a server.R . Y quizás la otra cosa que vale la pena destacar es que está bien devolver una list de ''elementos'' HTML en una llamada renderUI .
Puede acceder a las variables dinámicamente con nombre de brillante usando esta sintaxis:
input[["dynamically_named_element"]]
Entonces, en su ejemplo anterior, si inicializa los elementos del control deslizante como tal
# 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")
Puede imprimir los valores en una tabla usando la siguiente
# 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")
Vea here un ejemplo brillante de trabajo. Gist de trabajo here .
Fuente: primera respuesta de Joe Cheng, a mitad de camino de este hilo
Puede generar la barra lateral con do.call y lapply , algo así como:
# 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)