Créer un nombre dynamique d'éléments d'entrée avec R / Shiny
J'écris une application Shiny pour visualiser les régimes de prestations d'assurance dans mon entreprise. Voici ce que j'aimerais arriver:
- Je vais avoir un
selectInputousliderInputoù l'utilisateur choisira le nombre de personnes sur son plan médical - Un nombre correspondant de curseurs double face apparaîtra (un pour chaque membre)
- Ils peuvent ensuite saisir leurs estimations des dépenses médicales dans le meilleur/pire cas pour chaque membre de leur plan
- J'ai un code qui prendra ces estimations et créera des graphiques côte à côte illustrant le coût prévu sur les trois offres de plan afin qu'ils puissent décider lequel est le moins cher en fonction de leurs estimations
Voici mon fichier ui.R Actuel avec des entrées codées en dur, simulant une famille de quatre:
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"))
)
)))
Voici à quoi cela ressemble (les sections d'extrémité transparentes sont le résultat des contributions HSA de deux des plans. Je pensais que c'était une belle façon de montrer les primes et les frais médicaux tout en montrant l'impact de la contribution HSA de l'entreprise. Ainsi, vous comparerais simplement la longueur des couleurs unies).
J'ai vu des exemples comme celui-ci où l'entrée d'interface utilisateur elle-même est fixe (dans ce cas, un checkboxGroupInput existe, mais son contenu est adapté en fonction du choix d'une autre entrée d'interface utilisateur), mais je n'ai pas vu d'exemples de personnalisation le nombre (ou, disons, type) d'éléments d'entrée générés à la suite du contenu d'une autre entrée d'interface utilisateur.
Des suggestions à ce sujet (est-ce même possible)?
Mon dernier recours sera de créer, disons, 15 curseurs d'entrée et de les initialiser à zéro. Mon code fonctionnera très bien, mais je voudrais nettoyer l'interface en n'ayant pas à créer autant de curseurs que pour l'utilisateur occasionnel qui a une très grande famille.
Mise à jour basée sur la réponse de Kevin Ushay
J'ai essayé de suivre la route server.R Et j'ai ceci:
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)
})
})
})
Immédiatement après, j'essaie d'extraire les valeurs de input pour les dépenses de chaque individu:
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))
})
Enfin, j'ai deux fonctions qui créent des objets pour stocker une trame de données pour le traçage en fonction des estimations de dépenses médicales élevées et faibles. Ils s'appellent best_case Et worst_case Et tous les deux ont besoin de l'objet expenses pour fonctionner, donc je l'appelle comme ma première ligne d'après ce que j'ai appris de cette question
best_case <- reactive({
expenses <- expenses()
...
)}
J'ai eu quelques erreurs, j'ai donc utilisé browser() pour parcourir le bit expenses et j'ai remarqué des choses particulières comme input$ind1 Ne semblant pas exister depuis le expenses une fonction.
J'ai également joué avec diverses instructions print() pour voir ce qui se passait. Le plus frappant est quand je fais print(names(input)) comme toute première ligne de la fonction:
[1] "class" "max_pred" "members"
[1] "class" "ind1" "ind2" "max_pred" "members"
J'obtiens deux sorties, ce qui, je pense, est dû à la définition de expenses et à son appel ultérieur. Étrangement ... Je n'obtiens pas de troisième lorsque worst_case Utilise exactement la même ligne expenses <- expense().
Si je fais quelque chose comme print(expenses) à l'intérieur de ma fonction expenses, j'obtiens également des doublons:
# the first
mins maxs
1 NA NA
2 NA NA
# the second
mins maxs
1 0 500
2 0 500
Tous les conseils sur la raison pour laquelle mes éléments input pour ind1 Et ind2 N'apparaîtraient pas jusqu'à ce que expenses soit appelé la deuxième fois et empêcherait ainsi la trame de données de en cours de création correctement?
Vous pouvez gérer la génération de l'élément d'interface utilisateur dans server.R, vous avez donc quelque chose comme:
ui.R
----
shinyUI( pageWithSideBar(
...
selectInput("numIndividuals", ...)
uiOutput("sliders"),
...
))
et
server.R
--------
shinyServer( function(input, output, session) {
output$sliders <- renderUI({
numIndividuals <- as.integer(input$numIndividuals)
lapply(1:numIndividuals, function(i) {
sliderInput(...)
})
})
})
Lorsque j'ai des éléments d'interface utilisateur qui dépendent des valeurs d'autres éléments d'interface utilisateur, je trouve qu'il est plus facile de les générer dans server.R.
Il est utile de comprendre que tous les _Input fonctions il suffit de générer du HTML. Lorsque vous voulez générer ce HTML dynamiquement il est logique de le déplacer vers server.R. Et peut-être que l'autre chose à souligner est qu'il est correct de retourner un list d'éléments HTML dans un appel renderUI.
Vous pouvez accéder à des variables nommées dynamiquement depuis shiny en utilisant cette syntaxe:
input[["dynamically_named_element"]]
Donc, dans votre exemple ci-dessus, si vous initialisez vos éléments de curseur comme tel
# 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")
Vous pouvez imprimer les valeurs dans un tableau à l'aide des éléments suivants
# 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")
Voir ici pour un exemple Shiny fonctionnel. Working Gist ici .
Source: première réponse de Joe Cheng, environ à mi-chemin ce fil
Vous pouvez générer la barre latérale avec do.call et lapply, quelque chose comme:
# 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)