My app should follow this logic: If an action button is pressed, all inputs are disabled and a long computation is performed. When the computation is finished and its results are plotted, all inputs except for the action button become enabled again. If the user decides to change one input, the action button becomes enabled.
Most of this desired behaviour is working, except for the last bit, the enabling of the action button. Here is my server function (the action button is named "go"):
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
shiny::observeEvent(input$go, {
for (id in allinputIds()) shinyjs::disable(id)
})
# ==> here is some trouble: not working
shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
# from here starts the real work
bins <- shiny::eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- shiny::renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
for (id in setdiff(allinputIds(), "go")) shinyjs::enable(id)
})
}
How can I observe that any input has been changed? Instead of allinputIds()
after the line marked "==>", I tried input
but this worked neither.
As a second question, what would you recommend to encapsulate this button / disable / enable pattern, which I plan to use on more than one shiny module. It would be nice if I could concentrate on the main code, i.e. bins
and output$figure <- ...
.
Any hint appreciated!
For reproducibility, here is the ui function:
ui <- shiny::tagList(
shinyjs::useShinyjs(),
shiny::navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
shiny::sidebarLayout(
shiny::sidebarPanel(
shiny::sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
shiny::mainPanel(
shiny::actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
shiny::h4(shiny::textOutput("msg"))
)
)
)
)
)
shiny::shinyApp(ui, server)
The problem is that in shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
you just check if the names/amount of input ids change - they don't. You actually need to check if the values of any of the inputs (besides the action button) has changed. Therefore you can either put all inputs directly into the observe like c(input$bins, input$...)
or make an extra reactive to check for the values and just call this reactive.
library(shiny)
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
changingInputValues <- reactive({
checkIds <- setdiff(names(input), "go")
lapply(checkIds, function(x) input[[x]])
})
observeEvent(input$go, {
lapply(allinputIds(), shinyjs::disable)
})
# ==> here is some trouble: not working
observeEvent(changingInputValues(), shinyjs::enable("go"))
# from here starts the real work
bins <- eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
lapply(setdiff(allinputIds(), "go"), shinyjs::enable)
})
}
ui <- tagList(
shinyjs::useShinyjs(),
navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
h4(textOutput("msg"))
)
)
)
)
)
shinyApp(ui, server)
Note that I've changed the for
loops to lapply
, as for
loops tend to not work well with shiny (unfortunately, I'm not sure why). A few times the enabling of the inputs didn't work when using the loop, but with lapply
I haven't had any problems.