J'aimerais trouver une ressource qui permettrait à ma fonction Shiny selectInput de s'étendre/se réduire en fonction des titres de catégories que j'ai créés. J'ai cherché dans certaines ressources bootstrap, mais je n'ai pas encore réussi. Veuillez pardonner mon exemple de travail minimal, je reconnais qu'il existe peut-être des moyens plus efficaces de fournir un MWE. Merci pour tout conseil que vous pourrez me donner.
library(shiny)
library(tidyverse)
#create a quick dataset to plot
schools <- as.data.frame(table(
c('Adams', 'Van Buren', 'Clinton', 'Douglas', 'Edwards',
'Franklin', 'Grant', 'Harrison', 'Ignatius', 'Justice',
'Kellogg', 'Lincoln'),
dnn = list("school")))
enrollment <- as.data.frame(table(
c(300, 305, 265, 400, 500, 450, 475, 900, 800, 850, 1200, 1500),
dnn = list("enrollment")))
schoolsDataframe <- schools %>%
bind_cols(enrollment) %>%
select(school, enrollment)
#define data elements for selectInput choices argument
elem <- c('Adams', 'Van Buren', 'Clinton', 'Douglas')
mid <- c('Edwards', 'Franklin', 'Grant')
high <- c('Harrison', 'Ignatius', 'Justice')
multi <- c('Kellogg', 'Lincoln')
# Define UI
ui <- fluidPage(
tags$style(".optgroup-header { color: #FFFFFF !important; background: #000000 !important; }"),
# Application title
titlePanel("Expandable selectInput"),
# Sidebar with a select input
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'schoolsInput',
label = 'Select a school',
choices = list('Elementary' = elem,
'Middle' = mid,
'High' = high,
'Multi-level' = multi),
selectize = TRUE)
),
# Show a plot
mainPanel(
plotOutput("myPlot")
)
)
)
# Define server logic required to draw a plot
server <- function(input, output) {
output$myPlot <- renderPlot({
#filter the data based on selectInput
schoolsDataframe <- schoolsDataframe %>%
filter(school == input$schoolsInput)
# draw the plot
ggplot(data = schoolsDataframe,
mapping = aes(x = school,
y = enrollment))+
geom_col()
})
}
# Run the application
shinyApp(ui = ui, server = server)