Update shiny UI only when tab is selected - r

I have a Shiny dashboard with multiple tabs. In one of the tabs, a slow database query fills the choices for a dropdown menu. I want the slow database query to execute only when the relevant tab is selected.
In the following ReprEx, the slowDatabaseQuery is executed at launch and blocks the R process.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"panel1",
"Panel 1 content"
),
tabPanel(
"panel2",
"Panel 2 content",
selectizeInput(
"selected",
label = "Selector",
choices = NULL
),
verbatimTextOutput("text")
)
)
)
server <- function(input, output, session) {
slowDatabaseQuery <- reactive({
Sys.sleep(5)
return(c("C", "D"))
})
observe(
updateSelectizeInput(
session,
"selected",
choices = slowDatabaseQuery(),
selected = "C",
server = TRUE
)
)
output$text <- renderText(input$selected)
}
shinyApp(ui = ui, server = server)
A partial solution would be using renderUI() instead of updateSelectizeInput(). However, I would like to use the server = TRUE argument which is only available in updateSelectizeInput() and do not like that it would take the UI element a long time to appear.

We can provide your tabsetPanel with an id and observe the selections via observeEvent.
There are two different options in the code below.
The DB query is done each time tab2 is selected.
The DB query is done the first time tab2 is selected in the current shiny-session (commented out).
library(shiny)
ui <- fluidPage(
tabsetPanel(
id = "tabsetPanelID",
tabPanel(
"panel1",
"Panel 1 content"
),
tabPanel(
"panel2",
"Panel 2 content",
selectizeInput(
"selected",
label = "Selector",
choices = NULL
),
verbatimTextOutput("text")
)
)
)
server <- function(input, output, session) {
slowDatabaseQuery <- reactive({
Sys.sleep(5)
return(c("C", "D"))
})
observeEvent(input$tabsetPanelID,{
if(input$tabsetPanelID == "panel2"){
updateSelectizeInput(
session,
"selected",
choices = slowDatabaseQuery(),
selected = "C",
server = TRUE
)
}
})
# observeEvent(input$tabsetPanelID == "panel2", {
# updateSelectizeInput(
# session,
# "selected",
# choices = slowDatabaseQuery(),
# selected = "C",
# server = TRUE
# )
# }, once = TRUE) # should the query be done only once or each time the tab is selected?
output$text <- renderText(input$selected)
}
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)

Append and remove tabs using sidebarPanel

Having trouble deleting tabs that have been newly created in Shiny.
Scenario:
Add new tab "A"
Add new tab "B"
Click delete on tab B - doesn't delete
Select tab A, click delete it works
I feel its something to do with ids, stumped with the logic.
Thanks in advance.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id="tabs",
tabPanel("Home",
sidebarPanel(
selectInput("testlist", "Select test:",
list("A", "B", "C")),
actionButton("append", "New tab")),
mainPanel()
)
)
)
server <- function(input, output, session) {
tabnamesinput<-reactive({
input$testlist
})
observeEvent(input$append,{
id<-paste0(tabnamesinput())
appendTab(inputId = "tabs",
tabPanel(id,
sidebarPanel(
actionButton("remove", "Delete")
)
)
)
})
observeEvent(input$remove,{
removeTab(inputId = "tabs", target = input$tabs)
})
}
shinyApp(ui, server)
With your above approach you are trying to assign the same id = "remove" to each delete-button. This won't work. Every button needs it's own id.
Once each button has it's unique id you need an observer listening to all events triggered by those buttons. The following looks for all inputs matching the pattern "^remove_":
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id = "tabs",
tabPanel("Home",
sidebarPanel(
selectInput("testlist", "Select test:", list("A", "B", "C"), selected = "A"),
actionButton("append", "New tab")),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$testlist,
sidebarPanel(
actionButton(paste0("remove_", input$testlist), "Delete")
)
)
)
})
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "testlist", selected = input$testlist) # keep the selection when re-rendering sidebarPanel
}
})
}
shinyApp(ui, 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)

Having issues appending tab on cell click within observeEvent function in R Shiny

This is the minimum reproducible example needed to help:
ui.R
library(shiny)
fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DT::dataTableOutput("x4")
)
)
)
Server script:
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
output$x4 = DT::renderDataTable({
DT::datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cells_clicked, {
print("Trigger")
value <- x4_cells_clicked$value
details <- mtcars %>%
filter(mpg == value)
appendTab(inputId = "tabs",
tabPanel(
DT::renderDataTable(DT::datatable(details), server = TRUE)
)
)
# Focus on newly created tab
updateTabsetPanel(session, "tabs", selected = "Car details")
})
})
What I am trying to accomplish is to trigger an event through a cell click on the mtcars dataframe. I want to append a tab upon a click and filter the dataframe that is produced by the value within the cell that is clicked. I know in this case I am only accounting for a click on the mpg column but I just need to see how a click on a cell is registered through observeEvent and how to use the value of the cell clicked to filter the dataframe that is produced in the new tab.
library(shiny)
library(DT)
ui <- fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DTOutput("x4")
)
)
)
server <- function(input, output, session) {
output$x4 = renderDT({
datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cell_clicked, {
cell <- input$x4_cell_clicked
if(length(cell)){
details <- mtcars[mtcars[[cell$col]]==cell$value,]
appendTab(inputId = "tabs",
tabPanel(
"Cars details",
renderDT(datatable(details), server = TRUE)
),
select = TRUE # Focus on newly created tab
)
}
})
}
shinyApp(ui, server)

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)

Resources