I have the shiny app below and I want:
1.When the app is first loaded, the widgets should have no selections, and the action buttons should be disabled.
2.When a district is selected, update the school choices.
3.Enable the "Preview" action button when at least one school is selected.
4.Enable the "Download" action button only after "Preview" is clicked.
5.If all selections are cleared, both action buttons should be disabled again.
I have made all of them work except that the Preview button is initially activated and if all selections are cleared Preview button is disabled again.
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)
You need an additional if condition input$schools != "" if you want to have the 'Preview' button deactivated when the app is first loaded. And if later the schools are cleared, the preview button gets disabled again. Similarly I also let the datatable disappear if no school is selected. This is implemented below.
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)