3 votes

Expand/Collapse Shiny selectFonction d'entrée

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)

enter image description here

enter image description here

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X