In the shiny app below I have 2 shiny widgets related to each other and then a Preview button which is activated when we have values in shools widgets. When I click Preview also a text is displayed. The issue is that I want this text to be hidden when I have no values in my school widgets. And then displayed again when I have at least one school selected and click Preview.
library(renv)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyr)
early<-structure(list(temp_record_id = c("3_8", "3_14", "3_20", "3_35",
"3_45", "3_49", "3_59", "3_67", "3_72", "3_79"), district_number = c("0001",
"0001", "0001", "0014", "0038", "0110", "0113", "0196", "0200",
"0273"), district_type = c("33", "33", "33", "31", "31", "31",
"31", "31", "31", "31"), school_number = c("012", "015", "036",
"006", "001", "001", "100", "007", "002", "007"), grade = c("03",
"03", "03", "03", "03", "03", "03", "03", "03", "03"), subject = c("Reading",
"Reading", "Reading", "Reading", "Reading", "Reading", "Reading",
"Reading", "Reading", "Reading"), group_category = c("All Categories",
"All Categories", "All Categories", "All Categories", "All Categories",
"All Categories", "All Categories", "All Categories", "All Categories",
"All Categories"), student_group = c("All Students", "All Students",
"All Students", "All Students", "All Students", "All Students",
"All Students", "All Students", "All Students", "All Students"
), school_year = c(2015, 2015, 2015, 2015, 2015, 2015, 2015,
2015, 2015, 2015), denominator = c(40, 31, 21, 21, 12, 18, NA,
22, 14, 80), numerator = c(17, 12, 9, 10, 4, 13, NA, 19, 11,
68), school_name = c("Ascension Catholic School", "Risen Christ",
"St. Helena Catholic School", "Al-Amal School", "St. Mary's Mission",
"St. Joseph", "Immanuel Lutheran School", "St. Joseph's Catholic",
"St. John The Baptist", "Our Lady Of Grace"), district_name = c("Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School", "Nonpublic School", "Nonpublic School", "Nonpublic School",
"Nonpublic School"), county_name = c("Hennepin", "Hennepin",
"Hennepin", "Anoka", "Beltrami", "Carver", "Cass", "Dakota",
"Dakota", "Hennepin"), school_classification = c("00", "00",
"00", "40", "00", "00", "00", "00", "00", "00"), 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"), id = c("0001-33-012", "0001-33-015",
"0001-33-036", "0014-31-006", "0038-31-001", "0110-31-001", "0113-31-100",
"0196-31-007", "0200-31-002", "0273-31-007")), row.names = c(NA,
-10L), class = c("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("CIA Data 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(
fluidRow(
column(6,uiOutput("ear"))
)
)
)
)
# 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)
}
})
shiny::observeEvent(input$runButton, {
if (is.null(input$schools) ||
any(input$schools == "") || input$runButton == 0) {
output$ear <- renderUI({HTML("")})
}
else{
output$ear <- renderUI({
HTML("Early Reading Grades")
})
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
>Solution :
I split the observeEvent content on input$runButton into two observeEvent, one for rendering the empty text and one for rendering the non-empty text. It should fulfill all requirements now.
library(renv)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyr)
early <-
structure(
list(
temp_record_id = c(
"3_8",
"3_14",
"3_20",
"3_35",
"3_45",
"3_49",
"3_59",
"3_67",
"3_72",
"3_79"
),
district_number = c(
"0001",
"0001",
"0001",
"0014",
"0038",
"0110",
"0113",
"0196",
"0200",
"0273"
),
district_type = c("33", "33", "33", "31", "31", "31",
"31", "31", "31", "31"),
school_number = c(
"012",
"015",
"036",
"006",
"001",
"001",
"100",
"007",
"002",
"007"
),
grade = c("03",
"03", "03", "03", "03", "03", "03", "03", "03", "03"),
subject = c(
"Reading",
"Reading",
"Reading",
"Reading",
"Reading",
"Reading",
"Reading",
"Reading",
"Reading",
"Reading"
),
group_category = c(
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories",
"All Categories"
),
student_group = c(
"All Students",
"All Students",
"All Students",
"All Students",
"All Students",
"All Students",
"All Students",
"All Students",
"All Students",
"All Students"
),
school_year = c(2015, 2015, 2015, 2015, 2015, 2015, 2015,
2015, 2015, 2015),
denominator = c(40, 31, 21, 21, 12, 18, NA,
22, 14, 80),
numerator = c(17, 12, 9, 10, 4, 13, NA, 19, 11,
68),
school_name = c(
"Ascension Catholic School",
"Risen Christ",
"St. Helena Catholic School",
"Al-Amal School",
"St. Mary's Mission",
"St. Joseph",
"Immanuel Lutheran School",
"St. Joseph's Catholic",
"St. John The Baptist",
"Our Lady Of Grace"
),
district_name = c(
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School",
"Nonpublic School"
),
county_name = c(
"Hennepin",
"Hennepin",
"Hennepin",
"Anoka",
"Beltrami",
"Carver",
"Cass",
"Dakota",
"Dakota",
"Hennepin"
),
school_classification = c("00", "00",
"00", "40", "00", "00", "00", "00", "00", "00"),
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"
),
id = c(
"0001-33-012",
"0001-33-015",
"0001-33-036",
"0014-31-006",
"0038-31-001",
"0110-31-001",
"0113-31-100",
"0196-31-007",
"0200-31-002",
"0273-31-007"
)
),
row.names = c(NA,
-10L),
class = c("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("CIA Data 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(fluidRow(column(6, uiOutput(
"ear"
))))
))
# 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)
}
})
observeEvent(input$schools, {
if (is.null(input$schools) || any(input$schools == "")) {
output$ear <- renderUI({
HTML("")
})
}
}, ignoreNULL = FALSE)
observeEvent(input$runButton, {
output$ear <- renderUI({
HTML("Early Reading Grades")
})
})
}
# Run the application
shinyApp(ui = ui, server = server)