Update dynamically rendered UI in bsModal - r

I want to use bsModal that contains inputs that are generated via renderUI. The inputs depend on my data but will not change after start-up. When opening the modal I want to update the selected values of the input. The problem is that in my minimal reproducible example the first update goes wrong as the inputs inside the modal have not been rendered, yet. From the second update on everything works fine.
Here is the example:
library(shiny)
library(shinyBS)
ui <- fluidPage(
titlePanel("Modal Update Problem"),
actionButton(inputId = "btn_test", label = "Click Me"),
bsModal("modal_test", "Test Modal", "btn_test", size = "large",
uiOutput("test_ui")
)
)
server <- function(input, output, session) {
observeEvent(input$btn_test, {
updateSelectInput(
session = session,
inputId = "test_select",
selected = "B"
)
})
output$test_ui <- renderUI({
selectInput(
inputId = "test_select",
label = "Test",
choices = c("A", "B", "C"),
selected = "A"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Expected behaviour: Select-Input inside the modal shows "B" every time I click the button.
Current behaviour: It shows "A" (i.e. the initial value) after the first click and "B" after the second click.
Is there a clean solution to do this or at least a workaround? How can I render the UI inside the modal on start-up?

Just using selectInput inside observeEvent displays your expected behavior as shown below. Does your use case require you to use updateSelectInput? If so, you can use outputOptions as shown below.
ui <- fluidPage(
titlePanel("Modal Update Problem"),
actionButton(inputId = "btn_test", label = "Click Me"),
bsModal("modal_test", "Test Modal", "btn_test", size = "large",
uiOutput("test_ui")
)
)
server <- function(input, output, session) {
observeEvent(input$btn_test, {
updateSelectInput(
session = session,
inputId = "test_select",
selected = "B"
)
})
output$test_ui <- renderUI({
selectInput(
inputId = "test_select",
label = "Test",
choices = c("A", "B", "C") ,
selected = "A"
)
})
outputOptions(output, "test_ui", suspendWhenHidden = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)

Related

looping error in alert generation with shinyalert

Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)
Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)

How to access values from dynamically generated UI elements that are not initially visible

If you run this app 'a' the default selected value does not appear until the UI tab is selected
and the UI element which populates 'input$select' is generated. How can I force this element to be created when the app is loaded without the need to click on the panel to initialize it in order to get access to its default value.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI(
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
)
output$out <- renderText(input$select)
}
shinyApp(ui, server)
You can use the argument suspendWhenHidden = FALSE from outputOptions. I had to play a bit where to place outputOptions (it doesn't work at the beginning of the server function). However, it still needs a little bit of time to load, so maybe one could optimise it further.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI({
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
})
output$out <- renderText(input$select)
outputOptions(output, "select", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)

R Shiny reactive triggered by navigating to particular tabPanel in navbarPage

writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)

How to overwrite output using 2nd action button

I have a shiny app which writes a dataframe to output when an action button is pressed. This is the "Go" button in the bare-bones example below. I have a reset button which resets the values of the inputs. I'm wondering how I might also reset the output (so it becomes NULL & disappears when "reset" is pressed).
I've tried to pass input$goButtonReset to the eventReactive function (with the intention of using an if statement inside to indicate which button was making the call) but this didn't seem to be possible.
Any help much appreciated!
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
observeEvent(input$goButtonReset, {
updateSelectInput(session, "Input1", selected = "NULL")
})
writePF <- eventReactive(input$goButton, {
data.frame("test output")
})
output$pf <- renderTable({
writePF()
})
}
shinyApp(ui = ui, server = server)
You could try using reactiveValues to store the data frame. This worked for me:
ui <- fluidPage(title = "Working Title",
sidebarLayout(
sidebarPanel(width = 6,
# *Input() functions
selectInput("Input1", label = h3("Select Input1"),
choices = list("A" = "A", NULL = "NULL"),
selected = 1),
actionButton("goButton", "Go!"),
p("Click the button to display the table"),
actionButton("goButtonReset", "Reset"),
p("Click the button to reset your inputs.")
),
mainPanel(
# *Output() functions
tableOutput("pf"))
)
)
# build the outputs here
server <- function(input, output, session) {
df <- reactiveValues()
observeEvent(input$goButton,{
df$writePF <- data.frame("test output")
})
observeEvent(input$goButtonReset,{
df$writePF <- NULL
})
output$pf <- renderTable({
df$writePF
})
}
shinyApp(ui = ui, server = server)

Disappearing button - after click

I would like to have a button (say A) in sidebarPanel such that after using it another button (say B) will be activated (by renderUI), but the button A will disappear. How can I do this
Here my naive solution. I do not know how to avoid referring button status to itself:
library(shiny)
runApp(list(
ui = fluidPage(
uiOutput("answer"),
uiOutput("part2")
),
server = function(input, output) {
output$answer <- renderUI({
if(input$continue == 0){
checkboxGroupInput(inputId = "firstQ", label = "First question", choices = c("Ans. A" = "a", "Ans. B" = "b"))
actionButton("continue", "Continue")}
})
output$part2 <- renderUI({
if(input$kontynuuj > 0)
actionButton("newButton", "New button")
})
}
))
I think that conditionalPanel in your ui is what you need to use here. It will let you set a condition that determines if part of the UI is shown or not.
In the code below I moved the checkboxGroupInput and the first actionButton to the ui, and left the second actionButton as a renderUI. conditionalPanel will work either way.
Each conditionalPanel evaluates the "Continue" button, the first displays before it has been pressed, the second afterwards.
It is important to note that the condition must be written in javascript, not R. See ?conditionalPanel for the details.
library(shiny)
runApp(list(
ui = fluidPage(
conditionalPanel(condition="input.continue==0",
checkboxGroupInput(inputId = "firstQ", label = "First question",
choices = c("Ans. A" = "a", "Ans. B" = "b")),
actionButton("continue", "Continue")
),
conditionalPanel(condition="input.continue>0",
uiOutput("part2")
)
),
server = function(input, output) {
output$part2 <- renderUI({
actionButton("newButton", "New button")
})
}
))

Resources