Eu tenho o aplicativo brilhante abaixo e quero:
1.Quando o aplicativo é carregado pela primeira vez, os widgets não devem ter seleções e os botões de ação devem estar desativados.
2.Quando um distrito for selecionado, atualize as opções de escola.
3.Ative o botão de ação "Visualizar" quando pelo menos uma escola for selecionada.
4.Ative o botão de ação "Download" somente após clicar em "Visualizar".
5.Se todas as seleções forem desmarcadas, ambos os botões de ação deverão ser desativados novamente.
Fiz todos eles funcionarem, exceto que o botão Visualizar é inicialmente ativado e, se todas as seleções forem desmarcadas, o botão Visualizar é desativado novamente.
library(renv)
# library(AzureRMR)
# library(AzureStor)
#source(here::here("code/functions/momentmn_functions.R"))
library(dplyr)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyr)
early <- structure(list(district_name = c("Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Aitkin Public School District", "Minneapolis Public School Dist.",
"Minneapolis Public School Dist."), school_name_unique = c("Ascension Catholic School 0001-33-012",
"Risen Christ 0001-33-015", "St. Helena Catholic School 0001-33-036",
"Al-Amal School 0014-31-006", "St. Mary's Mission 0038-31-001",
"St. Joseph 0110-31-001", "Immanuel Lutheran School 0113-31-100",
"St. Joseph's Catholic 0196-31-007", "St. John The Baptist 0200-31-002",
"Our Lady Of Grace 0273-31-007", "St. Henry 0549-31-001", "St. Paul's Lutheran 0549-31-002",
"Talmud Torah 0625-31-879", "St. Dominic School 0659-31-012",
"Hills Christian 0671-31-001", "St. Paul's Lutheran 0719-31-003",
"St. Elizabeth Ann Seton School 0742-31-020", "Prince Of Peace Lutheran School 0742-31-022",
"St. Francis Xavier 0748-31-001", "Community Christian 0912-31-001",
"Fond Du Lac Ojibwe School 1094-34-030", "Bug-O-Nay-Ge-Shig 1115-34-010",
"Circle Of Life 1435-34-010", "Nay-Ah-Shing 1480-34-010", "Sacred Heart Area School 2170-31-001",
"St. Anne's 2397-31-001", "St. Mary Of Mt. Carmel 2753-31-002",
"Rippleside Elementary 0001-01-002", "Armatage Elementary 0001-03-103",
"Lake Harriet Lower Elementary 0001-03-104")), row.names = c(NA,
-30L), spec = structure(list(cols = list(temp_record_id = structure(list(), class = c("collector_character",
"collector")), district_number = structure(list(), class = c("collector_character",
"collector")), district_type = structure(list(), class = c("collector_character",
"collector")), school_number = structure(list(), class = c("collector_character",
"collector")), grade = structure(list(), class = c("collector_character",
"collector")), subject = structure(list(), class = c("collector_character",
"collector")), group_category = structure(list(), class = c("collector_character",
"collector")), student_group = structure(list(), class = c("collector_character",
"collector")), school_year = structure(list(), class = c("collector_double",
"collector")), denominator = structure(list(), class = c("collector_double",
"collector")), numerator = structure(list(), class = c("collector_double",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), delim = ","), class = "col_spec"), class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame"))
all_districts <- unique(sort(early$district_name))
all_schools <- unique(sort(early$school_name_unique))
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("EPC Civic Infrastructure Assessment File Prep"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
h2("Select Schools to Include"),
shinyWidgets::pickerInput(inputId = "districts",
label = "Districts:",
choices = all_districts,
options = list(`actions-box` = TRUE),
multiple = TRUE),
shinyWidgets::pickerInput(inputId = "schools",
label = "Schools:",
choices = "",
options = list(`actions-box` = TRUE),
selected = "",
multiple = TRUE),
shiny::actionButton(inputId = "runButton", label = "Preview", disabled = TRUE),
shiny::actionButton(inputId = "downButton", label = "Download", disabled = TRUE)),
# Show a plot of the generated distribution
mainPanel(
dataTableOutput("early_reading")#,
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
shiny::observeEvent(input$districts, {
if(!is.null(input$districts) && length(input$districts) > 0){
shinyWidgets::updatePickerInput(session = session, inputId = "schools",
choices = early %>% dplyr::arrange(district_name, school_name_unique) %>% dplyr::filter(district_name %in% input$districts) %>% dplyr::select(school_name_unique) %>% unique() %>% pull())
} else {
shinyWidgets::updatePickerInput(session = session, inputId = "schools",
choices = "",
options = list(`actions-box` = TRUE),
selected = "")
shiny::updateActionButton(session, "runButton", disabled = TRUE)
shiny::updateActionButton(session, "downButton", disabled = TRUE)
}
}, ignoreNULL = FALSE)
shiny::observeEvent(input$schools, {
if(!is.null(input$schools) && length(input$schools) > 0){
shiny::updateActionButton(inputId = "runButton",
disabled = FALSE)
} else {
shiny::updateActionButton(inputId = "runButton",
disabled = TRUE)
shiny::updateActionButton(inputId = "downButton",
disabled = TRUE)
}
}, ignoreNULL = FALSE)
shiny::observeEvent(input$runButton, {
if(input$runButton > 0){
shiny::updateActionButton(inputId = "downButton",
disabled = FALSE)
}
})
output$early_reading <- renderDataTable({
if(input$runButton == 0){return()}
else{
early <- early %>%
dplyr::filter(district_name %in% input$districts, school_name_unique %in% input$schools)
datatable(early)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Você precisa de uma
ifcondição adicionalinput$schools != ""se quiser que o botão 'Visualizar' seja desativado quando o aplicativo for carregado pela primeira vez. E se posteriormente as escolas forem limpas, o botão de visualização será desativado novamente. Da mesma forma, também deixodatatabledesaparecer se nenhuma escola for selecionada. Isso é implementado abaixo.