Shiny modal dialog in response to multiple buttons - r

Consider the following app:
ui <- basicPage(
actionButton('button1', 'click one'),
actionButton('button2', 'click two')
)
server <- function(input, output){
popup <- function(){
modalDialog(easyClose = T,
'popup window triggered')
}
}
shinyApp(ui=ui, server=server)
My goal is that the modal window is triggered once either of the buttons is clicked. I realise that I can create an observeEvent for each button, but in the full application there will be many buttons on different navbar pages. So in order to avoid a whole bunch of code duplication, I would like to gather them in a single observeEvent. I tried some of the suggestions from here.
Adding
observeEvent({
input$button1
input$button2
}, {
showModal(popup())
})
to server() doesn't really work, because for some odd reason button2 needs to be clicked before button1 is responsive.
Instead, adding
observeEvent(c(input$button1, input$button2), {
showModal(popup())
})
causes the modal window to appear on startup already, which should not happen.
So is there a way to capture multiple action buttons into a single observe event without these undesirable behaviours?

You need to set ignoreInit = TRUE for observeEvent:
ui <- basicPage(
actionButton('button1', 'click one'),
actionButton('button2', 'click two')
)
server <- function(input, output){
popup <- function(){
modalDialog(easyClose = T,
'popup window triggered')
}
observeEvent(c(input$button1, input$button2), {
showModal(popup())
}, ignoreInit = TRUE)
}
shinyApp(ui=ui, server=server)

Related

Shiny : how to reset selectInput or observeEvent?

When I open a modalDialog (by clicking a "modal" button) with a selectInput inside it, the first choice of the list is displayed and the observeEvent is automaticaly launched with this first element. That's ok.
If I choose a second element of the list, the observeEvent is launched again and that's right.
I "cancel" or "dismiss" the modalDialog and I open it again by clicking "modal" button in the main window.
The first choice of the list is displayed again and the observeEvent is automaticaly launched with this first element. That's ok.
Now I "cancel" or "dismiss" this modalDialog, without choosing any element of the selectInput.
If I open the modalDialog again, nothing happens BECAUSE the first choice is the same when I closed the modelDialog before so the observeEvent didn't detect any change so it doesn't launch the action.
Is there a way to RESET the selectInput or the observeEvent in order to "forget" which element was previously selected when the modalDialog is closed ? This MUST works even if the selectInput contain only one choice.
I tried to add an actionButton in the footer of the modalDialog in order to launch an action while closing it : it updates the selectInput with a fake value but I don't think it's a good way...
Here is a reproducible code, I set the selectInput with only one choice...
Remove the # in front of the updateSelectInput to test my workaround.
Thanx !
library(shiny)
ui <- fluidPage(
actionButton("open", "Modal")
)
server <- function(input, output, session) {
observeEvent(input$open, {
showModal(
modalDialog(
tagList(
div(id="choice",
selectInput(
"dateList", "History:",
choices = c("choice1")
)
)
)
,
footer = tagList(
actionButton("cancel","CANCEL"),
actionButton("save", "SAVE")
)
)
)
})
observeEvent( input$dateList,{
insertUI("#choice", ui=div("hello"))
})
observeEvent( input$cancel,{
removeModal()
#updateSelectInput(session, "dateList" , choices = c("fake"), selected = NULL)
})
}
shinyApp(ui, server)
Interesting. Here is a way which works but I don't fully like it, because it generates a JavaScript warning. But no worry, this warning is harmless.
The idea is to use a reactive value which reacts to both input$datelist and input$cancel.
reacVal <- eventReactive(list(input$dateList, input$cancel), {
runif(1)
})
observeEvent(reacVal(), {
insertUI("#choice", ui = div("hello"))
})
observeEvent(input$cancel, {
removeModal()
})
The warning is due to the facet that there is no div #choice when the cancel button is pressed.
EDIT
Here is a better way. No warning and clearer. I "reset" input$dateList by setting it to NULL when the cancel button is clicked, using some JavaScript in the onclick attribute of this button.
observeEvent(input$open, {
showModal(
modalDialog(
tagList(
div(id="choice",
selectInput(
"dateList", "History:",
choices = c("choice1", "choice2")
)
)
)
,
footer = tagList(
actionButton(
"cancel", "CANCEL",
onclick = "Shiny.setInputValue('dateList', null);"
),
actionButton("save", "SAVE")
)
)
)
})
observeEvent(input$dateList, {
insertUI("#choice", ui = div("hello"))
})
observeEvent(input$cancel, {
removeModal()
})
I choose NULL because the observer does not react to NULL (by default), that's why the previous warning does not occur here.

Stop dropdownButton (shinywidgets) from opening dialog in R shiny

I'm looking to stop a dropdownbutton (shinywidgets) from opening when the button is clicked based on a condition. This to avoid renderUI errors on missing input for content on the dropdownButton modal panel.
When a user clicks on a dropdownButton, it normally opens a panel. In my case, this panel contains renderUIelements that depend on various variables.
If these variables do not exist yet, the renderUIswill cause errors to spit out.
What I would like to know is whether there is a way to look at the click
observeEvent(input$MydropdownButton, { ....})
and then completely stop it from opening the panel if a condition is not met, rather than toggle it to close immediately (not working version)
What I plan to do, is to give the user a sweetalert instead that informs the user of which options he has to create or load the needed data. And I know how to do the message, purely looking to stop the opening part in an 'if else' way
I know I can use shinyjs::disable('MydropdownButton') inside an observer with ifstatement to block the use of the button, but this would not allow me to trigger the sweetalerton a click anymore
I also know I can adjust all my renderUIs not to render if the needed input is missing, but by now there are a lot of renderUIs involved, and I'm:
A: afraid to make a mess of the code, and
B: eager to find out if there is a way in general to stop the opening of dropdownButtons
I've tried something like this:
observeEvent(input$MydropdownButton, {
if(!is.null(values$neededData)) { 'just open the dropdownbutton' }
else { toggleDropdownButton('TestDrop')
'run sweetalert code'}
})
But the toggleDropdownButtonwill only close the dropdownButtonpanel once it's already triggered to open, and thus shiny tried to renderthe uielement, with the resulting error, rather than block it from opening.
Here are a full serverand uicode files to demonstrate it calling for non-existing numbers.
SERVER file
shinyServer = function(input, output, session) {
values <- reactiveValues()
output$Reset_Threshold <- renderUI({
if(values$randomNr == 2) { actionButton(inputId = "Reset_Threshold", label = icon("undo")) }
else if(values$randomNr == 1) { actionButton(inputId = "Reset_Threshold", label = icon("table")) }
})
observeEvent(input$TestDrop, {
if(!is.null(values$randomNr )) { print('no problems')}
else { toggleDropdownButton('TestDrop')
# Run other code here to alert user.
}
})
}
UI file
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(inputId= "TestDrop",
uiOutput('Reset_Threshold'),
icon = icon("table"), tooltip = tooltipOptions(title = "Click"))
)
```
The error is not caused by toggling the dropdown menu but referencing a variable randomNr that doesn't exist. I added the variable and also a sweet dialog when the data is not ready in the server logic now it works.
But do note that it's not possible to stop the dropdown menu from opening. We still need to close it. If you want to block it from opening completely, you can conditionally render a regular Shiny actionButton when your data is not ready and will still trigger an event. Just make sure only one button is rendered under different condition and they should use the same input ID.
function(input, output, session) {
values <- reactiveValues(Filter_df = NULL, randomNr = 0)
output$Reset_Threshold <- renderUI({
if (values$randomNr == 2) {
actionButton(inputId = "Reset_Threshold", label = icon("undo"))
}
else if (values$randomNr == 1) {
actionButton(inputId = "Reset_Threshold", label = icon("table"))
}
})
observeEvent(input$TestDrop, {
if (!is.null(values$Filter_df)) {
print("no problems")
} else {
toggleDropdownButton("TestDrop")
# Run other code here to alert user.
sendSweetAlert(session, "data not ready")
}
})
}
EDIT
Just render a different button now. I'm using a single file app.R
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput("button")
)
server <- function(input, output, session) {
values <- reactiveValues(Filter_df = NULL, randomNr = 0)
output$button <- renderUI({
if (values$randomNr == 1) {
dropdownButton(
inputId = "dropdown",
actionButton(inputId = "Reset_Threshold", label = icon("table")),
icon = icon("table"), tooltip = tooltipOptions(title = "Click")
)
} else {
actionButton(
inputId = "alert",
NULL,
icon = icon("table")
)
}
})
observeEvent(input$alert, {
sendSweetAlert(session, "data not ready")
})
}
shiny::shinyApp(ui, server)

R Shiny: Present a ShinyBS Modal Popup on page visit (no user action)

I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.

Disabling buttons in Shiny

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)

shiny checkbox unchecks - cross-referring to inputs in same renderUI call

I intended to have some optional extra buttons appearing in my shiny app using renderUI. I would prefer to have new buttons inserted in the one and same renderUI call. I wrote a renderUI expession were the second button only is rendered if input of fist button is not null and(&&) is TRUE. It does not work as first button rapidly unchecks itself again whenever checked. I made a solution by splitting into two renderUI calls.
My question are:
Why exactly does the first code piece fail?
Would it be possible to achieve what the second code piece does in only one renderUI call?
.
library(shiny)
ui = fluidPage(
uiOutput("checkUI")
)
server = function(input,output) {
output$checkUI = renderUI({
list(
checkboxInput('check1',"check me first"),
if(!is.null(input$check1)&&input$check1==T) {
checkboxInput('check2',"check me to win")
} else {
NULL
}
)
})
}
shinyApp(ui,server)
but this works...
ui = fluidPage(
uiOutput("checkUI"),
uiOutput("textUI")
)
server = function(input,output) {
#UI first button
output$checkUI = renderUI({
list(
checkboxInput('check1',"check me first")
)
})
#UI second button
output$textUI = renderUI({
list(
if(!is.null(input$check1) && input$check1)
checkboxInput('check2',"check me to win") else NULL
)
})
}
shinyApp(ui,server)
Your first piece of code fails because the renderUI runs every time there is a change in input, so when you check the first check box. Since you have:
checkboxInput('check1',"check me first")
The renderUI immediately resets the input$check1 and then the renderUI is run again, unsetting the checkbox. This is why the second checkbox briefly flashes.
Luckily this is a common problem, so there is a Shiny solution to this with conditionalPanels:
library(shiny)
ui = fluidPage(
checkboxInput('check1',"check me first"),
conditionalPanel(
condition = "input.check1 == true",
checkboxInput("check2", "check me to win")
)
)
server = function(input,output){
}
shinyApp(ui,server)

Resources