This is a bit minor, but after clicking an action button (normally light gray) in a Shiny app, it turns a darker gray and the focus remains on it. The user has to click somewhere else for the action button to return to its normal lighter color.
Try it out here: http://shiny.rstudio.com/gallery/actionbutton-demo.html
The lack of automatically reverting to a lighter color means the user doesn't get a visual feedback that the button was successfully pressed.
Is there a way to fix this?
Another way of doing it is by disabling the button while the process is running, it will also prevent people from re-clicking it while you are waiting on the result. Have a look at shinyjs package which has a lot of nice features. Note that I added 2 second delay to mimic long operation.
rm(list=ls())
library(shinyBS)
library(shiny)
library(shinyjs)
ui <- pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(numericInput("n", "N:", min = 0, max = 100, value = 50),
tags$div(style="display:inline-block",title="Push Me",bsButton("goButton", label = "Button", block = TRUE,style="primary"))
),
mainPanel(useShinyjs(),verbatimTextOutput("nText")
)
)
server <- shinyServer(function(input, output,session) {
ntext <- eventReactive(input$goButton, {
shinyjs::disable("goButton")
Sys.sleep(2)
shinyjs::enable("goButton")
input$n
})
output$nText <- renderText({ntext()})
})
shinyApp(ui = ui, server = server)
Disabled Button
Enabled Button
You can tell the webbrowser to unfocus the actionbutton, when it is clicked. This way, you don't get the effects you describe. Below is a (more or less) two line JavaScript call to achieve this. The script reads very straightforward. When the document is ready, we add a functionality, that if a button is clicked, then it is blurred immediately (looses focus).
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
tags$script(HTML("
$(document).ready(function() {
$('.btn').on('click', function(){$(this).blur()});
})
")),
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
))
server <- function(input, output) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
ntext()
})
}
shinyApp(ui, server)
Related
I have a Shiny App that has a button that runs a quite long (around 30 minutes) routine. what I would like to do is to disable the button that calls the process once the user clicks on it and that the button can be 'clickable' again once the process finishes...
Ideally I would click on the Action Button and it gets disabled, its label changes to 'Running' and once the process ends the button is clickable again and the label goes back to 'Run Process'.
So:
User clicks on an action button labeled "Run"
Button changes label to "Running" and is no longer clickable
Process Finishes
Button is clickable again and label goes back to "Run"
Thx
Basic shiny has update functions, such as updateActionButton(). You can use it to update the label:
updateActionButton(inputId = "run_button", label = "Running...")
As for disabling and enabling buttons, look into shinyjs library - it provides functions for a lot of this sort of stuff.
That depends on what happens when you click the button. Here is an example where clicking the button runs a time-consuming plot.
library(shiny)
js <- '
$(document).ready(function(){
$("#myplot").on("shiny:recalculating", function(){
$("#run").prop("disabled", true).text("Running...");
}).on("shiny:recalculated", function(){
$("#run").prop("disabled", false).text("Run");
});
})
'
ui <- fluidPage(
tags$head(
tags$script(HTML(js))
),
br(),
actionButton("run", "Run", class = "btn-primary btn-lg"),
br(),
plotOutput("myplot")
)
server <- function(input, output, session){
output[["myplot"]] <- renderPlot({
if(input[["run"]] > 0){
x <- y <- NULL
for(. in 1:25000){
x <- c(x, runif(1))
y <- c(y, runif(1))
}
plot(x, y)
}
})
}
shinyApp(ui, server)
And you can add a spinner with the shinybusy package:
library(shiny)
library(shinybusy)
js <- '
$(document).ready(function(){
$("#myplot").on("shiny:recalculating", function(){
$("#run").prop("disabled", true).text("Running...");
}).on("shiny:recalculated", function(){
$("#run").prop("disabled", false).text("Run");
});
})
'
ui <- fluidPage(
tags$head(
tags$script(HTML(js))
),
add_loading_state(
"#myplot",
spinner = "hourglass",
svgSize = "100px"
),
br(),
actionButton("run", "Run", class = "btn-primary btn-lg"),
br(),
plotOutput("myplot")
)
I have a reset (actionButton) and update button (submitButton) in my Shiny app. The problem is that to reset the app, I have to click on the reset button followed by the update button. Is it possible to reset the app without having to click on update?
EDIT: I do want the app to update only after the user explicitly clicks update. This is because in my app they will have the option to select several selectors to filter the data. Happy to use something else other than submitbutton, but so far this has been the only function that worked for the purpose.
In the example below, I have to click on update twice to get the whole app to reset :
library(shiny)
shinyApp(
ui = basicPage(
numericInput("num", label = "Make changes", value = 1),
submitButton("Update", icon("refresh")),
shinyjs::useShinyjs(),
actionButton("reset", "Reset"),
helpText(
"When you click the button above, you should see",
"the output below update to reflect the value you",
"entered at the top:"
),
verbatimTextOutput("value")
),
server = function(input, output) {
# submit buttons do not have a value of their own,
# they control when the app accesses values of other widgets.
# input$num is the value of the number widget.
output$value <- renderPrint({
input$num
})
observeEvent(input$reset, {
shinyjs::reset("num")
})
}
)
I hope someone can enlighten me!
Perhaps actionButton in combination with updateNumericInput() will meet your needs. Try this
library(shiny)
shinyApp(
ui = basicPage(
numericInput("num", label = "Make changes", value = 1),
actionButton("Update", "refresh"),
shinyjs::useShinyjs(),
actionButton("reset", "Reset"),
helpText(
"When you click the button above, you should see",
"the output below update to reflect the value you",
"entered at the top:"
),
verbatimTextOutput("value")
),
server = function(input, output,session) {
# submit buttons do not have a value of their own,
# they control when the app accesses values of other widgets.
# input$num is the value of the number widget.
observeEvent(input$Update, {
output$value <- renderPrint({
isolate(input$num)
})
})
observeEvent(input$reset, {
#shinyjs::reset("num")
updateNumericInput(session,"num",value=1)
})
}
)
I'm using modules within my shiny app to display the content of different tabPanels. I would like to be able to travel to the second tab by clicking one button. I have the following code:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")
)
}
module <- function(input, output, session, openTab){
observeEvent(input$action1, {
openTab("two")
})
return(openTab)
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
openTab("one")
openTab <- callModule(module,"first", openTab)
openTab <- callModule(module,"second", openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)
However this only works once. The problem I think, is that the module does not know when a tab is changed in the app. Therefore I'm looking for a way to make sure the module knows which tab is opened so that the actionButton works more that once.
I have considered using input$tabsPanel but I don't know how to implement it.
Help would be greatly appreciated.
The problem is that once the user manually switches back to tab 1, the openTab() does not get updated. So therefore, when you click the actionButton a second time, openTab changes from "two" to "two" (i.e. it stays the same), and therefore your observeEvent is not triggered.
You could add:
observeEvent(input$tabsPanel,{
openTab(input$tabsPanel)
})
So the openTab reactiveVal is updated also when a user manually changes back to tab1 (or any other tab).
You don't need modules to do what you want by the way, but I assume you have a specific reason to use them. For anyone else who wants to achieve the same but does not need modules:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")),
navlistPanel(id = "tabsPanel",
tabPanel("one"),
tabPanel("two")
))
server <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
shinyApp(ui = ui, server = server)
I am writing some Shiny code where the user will enter some inputs to the app and then click a an action button. The action button triggers a bunch of simulations to run that take a long time so I want once the action button is clicked for it to be disabled so that the user can't keep clicking it until the simulations are run. I came across the shinyjs::enable and shinyjs::disable functions but have been having a hard time utilizing them. Here is my server code:
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
shinyjs::enable("Button1")}
})
However, when I use this code, and click the action button nothing happens. I.e., teh action button doesn't grey out nor does the table get generated. However, when I take away the shinyjs::enable() command, i.e.,
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
}
})
The table gets generated first, and then the button goes grey, however I would have expected the button to go grey and then the table to generate itself.
What am I doing wrong here?
Here is my updated code based on Geovany's suggestion yet it still doesn't work for me
Button1Ready <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
RunButton1Ready$ok <- FALSE
RunButton1Ready$ok <- TRUE
})
output$SumUI1= renderUI({
if(Button1Ready$ok){
tableOutput("table")
shinyjs::enable("Button1")
}
})
where for clarification I have also:
output$table <- renderTable({
#My code....
)}
I think that you are using shinyjs::disable and shinyjs::enable in the same reactive function. You will only see the last effect. I will recommend you to split in different reactive functions the disable/enable and use an extra reactive variable to control the reactivation of the button.
I don't know how exactly your code is, but in the code below the main idea is illustrated.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("Button1", "Run"),
shinyjs::hidden(p(id = "text1", "Processing..."))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plotReady <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
shinyjs::show("text1")
plotReady$ok <- FALSE
# do some cool and complex stuff
Sys.sleep(2)
plotReady$ok <- TRUE
})
output$plot <-renderPlot({
if (plotReady$ok) {
shinyjs::enable("Button1")
shinyjs::hide("text1")
hist(rnorm(100, 4, 1),breaks = 50)
}
})
}
shinyApp(ui, server)
My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!