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

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)

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.

Force input widget creation in Shiny even if widget has not yet been displayed in browser

In Shiny, one can use the following line to force displaying/refreshing an output even if not displayed within the ui:
outputOptions(output, "my_output", suspendWhenHidden = FALSE)
Is there a similar way to "force" input widget creation?
My context: I do have a button that pre-populate a textinput on another tab. Potentially, this textinput may not been generated yet if user didn't go to this specific tab. In such a case, the pre-population legitimely fails.
Good practice would probably be to use a reactiveValues, to feed it with the "pre-populate value" when clicking the button, and then to use this rv within the input widget creation. But I was wondering if a similar option as the above was available in Shiny.
Here’s a simple, working example of the situation I think you are describing.
That is, you don’t need to do anything special.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", textInput("b_text", "Add some B text"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
}
shinyApp(ui, server)
If the input you want to update is generated with uiOutput() then you can
use outputOptions() to force evaluation, like you already mentioned:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", uiOutput("b_panel"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
output$b_panel <- renderUI({
textInput("b_text", "Add some B text")
})
outputOptions(output, "b_panel", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)

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)

Use readlines(prompt = ) in Shiny

I have a code that takes inputs using the readlines(prompt = ) function. Could you tell me which input function in Shiny will be adequate to adapt this code to a Shiny app?
I need an interactive function, I can't use a simple input with selectInput() because I have a lot of readlines(prompt = ) statements.
Something similar to this question:
Include interactive function in shiny to highlight "readlines" and "print"
Florian's answer is nice and easy to use, I would definitely recommend that! But in case you are keen on using prompts for inputs I am adding another solution, using javaScript:
This one shows a prompt when the user presses an actionButton and stores it in an input variable. (it doesn't necessarily have to be after a button press)
library(shiny)
ui <- fluidPage(
tags$head(tags$script("
$(document).on('shiny:inputchanged', function(event) {
if (event.name === 'go') {
var text = prompt('Write me something nice:');
Shiny.onInputChange('mytext', text);
}
});"
)),
actionButton("go", "Click for prompt"),
textOutput("txt")
)
server <- function(input, output, session) {
output$txt <- renderText( {
input$mytext
})
}
shinyApp(ui, server)
Maybe you could use textArea for this purpose. Working example below, hope this helps!
library(shiny)
ui <- fluidPage(
tags$textarea(id="text", rows=4, cols=40),
htmlOutput('val')
)
server <- function(input,output)
{
output$val <- renderText({
text = gsub('\n','<br>',input$text)
text
})
}
shinyApp(ui,server)

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)

Resources