你需要一个额外的
if
条件
input$schools != ""
如果你想在应用程序首次加载时停用“预览”按钮。如果稍后学校被清除,预览按钮将再次被禁用。同样,我也让
datatable
如果没有选择学校,则消失。这在下面实现。
library(renv)
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
),
actionButton(
inputId = "runButton",
label = "Preview",
disabled = TRUE
),
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) {
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 = ""
)
updateActionButton(session, "runButton", disabled = TRUE)
updateActionButton(session, "downButton", disabled = TRUE)
}
}, ignoreNULL = FALSE)
observeEvent(input$schools, {
if (!is.null(input$schools) &&
length(input$schools) > 0 && any(input$schools != "")) {
updateActionButton(inputId = "runButton",
disabled = FALSE)
} else {
updateActionButton(inputId = "runButton",
disabled = TRUE)
updateActionButton(inputId = "downButton",
disabled = TRUE)
}
}, ignoreNULL = FALSE)
observeEvent(input$runButton, {
if (input$runButton > 0) {
updateActionButton(inputId = "downButton",
disabled = FALSE)
}
})
output$early_reading <- renderDataTable({
if (is.null(input$schools) ||
any(input$schools == "") || 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)
