Declaring uiOutput widgets on unopened tabs - r

I'm creating an R Shiny app that runs a function based off of many reactive widgets on multiple tabs. A problem I'm running into is that when the app is initially launched, I need to select the tabs that contain the respective reactive widgets before the widget's id is recognized in the "input". Is there a way to either 1.) have the app recognize all the reactive widgets when the app is deployed or 2.) alter the "input" initially to contain initial values for the reactive widget ids. Here is a simple example of the problem:
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("tab 1", numericInput("a", "A", 2)),
tabPanel("tab 2", uiOutput("bUI"))
)
),
mainPanel(
verbatimTextOutput("a_b")
)
)
))
server <- function(input, output, session){
output$bUI <- renderUI({
numericInput("b", "B", 3)
})
output$a_b <- renderPrint(input$a * input$b)
}
shinyApp(ui = ui, server = server)
I initially get an output of interger(0) instead of the desired 6.
Note, I do not want to require the user to have to select all the tabs. i.e. I don't want to use req or validate to push the user to click through the tabs.

I added an intermediate check if input$b is truthy. If not, a default 3 is used:
library('shiny')
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("tab 1", numericInput("a", "A", 2)),
tabPanel("tab 2", uiOutput("bUI"))
)
),
mainPanel(
verbatimTextOutput("a_b")
)
)
))
server <- function(input, output, session){
output$bUI <- renderUI({
numericInput("b", "B", 3)
})
safe_b <- eventReactive(input$b, if(isTruthy(input$b)) input$b else 3, ignoreNULL = F)
output$a_b <- renderPrint(input$a * safe_b())
}
shinyApp(ui = ui, server = server)

Related

Impossible to access input from within R Shiny UI module?

I want to have the choices in a radioButtons input depend on the selection of a prior input, and I would like to wrap both inputs up in a UI module. I know that passing the inputs of one module to another requires passing to the server first. But I can't seem to access an input within the same UI.
Here's what I have in a single app.r (things will eventually get repeated over several tabs, thus the desire for a module, but we're keeping it simple for now):
library(shiny)
# Sidebar selector UI module
sidebarSel_ui <- function(id){
ns <- NS(id)
# conditional choices for secondInput based on firstInput
input2Choices <- if (ns(input$firstInput == 1)) { # having trouble here
list(
"Choice A"=1,
"Choice B"=2
)
} else {
list(
"Choice C"=1,
"Choice D"=2
)
}
# inputs
tagList(
radioButtons(
inputId=ns("firstInput"),
label="Choose one:",
choices=list(
"Choice 1"=1,
"Choice 2"=2),
selected=1
),
radioButtons(
inputId=ns("secondInput"),
label="Choose another",
choices=input2Choices,
selected=1
)
)
}
# Define UI
ui <- fluidPage(
# Sidebar
sidebarLayout(
sidebarPanel(
sidebarSel_ui("test")
),
# Main panel
mainPanel(
)
)
)
# Define server
server <- function(input, output, session) {
}
# Run the application
shinyApp(ui = ui, server = server)
I'm getting an "object 'input' not found" error. If I do actually have to split these inputs into different modules, send the results of the first to the server and then send that back to the second to make it work, I think I can figure that out. It seems odd to not be able to access inputs within the same UI.
I figured it out thanks to the hint from #Limey:
library(shiny)
# Sidebar selector UI module
sidebarSel_ui <- function(id){
ns <- NS(id)
# inputs
tagList(
radioButtons(
inputId=ns("firstInput"),
label="Choose one:",
choices=list(
"Choice 1"=1,
"Choice 2"=2),
selected=1
),
radioButtons(
inputId=ns("secondInput"),
label="Choose another",
choices=list(
"Choice A"=1,
"Choice B"=2
),
selected=1
)
)
}
# Sidebar selector server module
sidebarSel_server <- function(id){
moduleServer(
id,
function(input, output, session){
observeEvent(input$firstInput,{
# conditional choices for input2 based on input1
input2Choices <- if (input$firstInput == 1) {
list(
"Choice A"=1,
"Choice B"=2
)
} else {
list(
"Choice C"=1,
"Choice D"=2
)
}
updateRadioButtons(session, "secondInput", choices=input2Choices)
})
})
}
# Define UI
ui <- fluidPage(
# Sidebar
sidebarLayout(
sidebarPanel(
sidebarSel_ui("test")
),
# Main panel
mainPanel(
)
)
)
# Define server
server <- function(input, output, session) {
sidebarSel_server("test")
}
# Run the application
shinyApp(ui = ui, server = server)
Key changes:
set up the second radioButtons input as usual with the first set of choices
set up an observeEvent in the module server that handles the if logic and
spits the choices list back with updateRadioButtons
call the module server in the main server function
More roundabout than I was expecting, and it looks like one cannot, in fact, refer to the inputs of a module ui within the module ui itself. The trick is to do the work in the module server and kick it back to the ui.

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)

How to stop restarting list in selectize input after click in Shiny?

When I filter a list of states in Shiny for: "New" I can choose only one state. After that the list is restarting and I have to put: "New" again in order to find a state contains "New" in name. I would like to filter states and choose more states at one time.
Below I added a picture and a code which present my goal.
Picture
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(
'e2', '2. Multi-select', choices = state.name, multiple = TRUE
)
),
mainPanel(
verbatimTextOutput('ex_out')
)
)
)
server <- function(input, output) {
output$ex_out <- renderPrint({
sapply(sprintf('e%d', 2), function(id) {
input[[id]]
})
})
}
shinyApp(ui = ui, server = server)

R Shiny synchronize filters on multiple tabs

I built a R Shiny application with multiple tabs, which have some filters in common. Right now, all filters are stand-alone and do not synchronize across multiple tabs. Hence, when I change selectInput1 from value "a" to value "b", I have to repeat this handling on the next tab which contains selectInput2 with the same options/meaning.
I thought about making the filters dynamic, hence rendering them using the server side of R Shiny. Then of course, I can always make selectInput2 equal to selectInput1. But what if the user changes selectInput2 rather than selectInput1? It creates kind of a loop in the logic.
I spent quite some time finding a solution for this problem, and somehow I'm sure I'm not the first one encountering this problem. Suggestions or useful links would be really helpful!
Example:
## UI.R
shinyUI(
dashboardPage("Dashboard",
# Create tabs
tabPanel("Start",
p("This is the frontpage")
),
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)
)
and:
## Server.R
library(shiny)
shinyServer(function(input, output,session){
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = "a")
})
})
I would personally use a single input control to control the different tab panels. One way is to include that single input under your tabs:
shinyApp(
fluidPage(
fluidRow(
tabsetPanel(
tabPanel("Tab1",
verbatimTextOutput("choice1")),
tabPanel("Tab2",
verbatimTextOutput("choice2"))
)
),
fluidRow(
selectInput("id1", "Pick something",
choices = c("a","b","c"),
selected = "a")
)
),
function(input, output, session){
output$choice1 <- renderPrint(input$id1)
output$choice2 <- renderPrint({
paste("The choice is:", input$id1)
})
}
)
Or, as you use a shinydashboard, you could actually add that control in the sidebar, possibly again in its own row under a set of tabs if you must.
I can't think of a reason to have multiple inputs who automatigically select the same thing. Other than slowing down your app, I can't see any gain. But if you insist, you make the selected choice a reactive value using reactiveVal and you use eg observeEvent() to update that reactive value. A small example using shinydashboard:
library(shinydashboard)
library(shiny)
ui <- shinyUI(
dashboardPage(title = "Dashboard",
dashboardHeader(),
dashboardSidebar(
tabsetPanel(
tabPanel("tab1",
uiOutput("selectInput1")
),
tabPanel("tab2",
uiOutput("selectInput2")
)
)),
dashboardBody(
verbatimTextOutput("selected")
)
)
)
server <- shinyServer(function(input, output,session){
thechoice <- reactiveVal("a")
output$selectInput1 <- renderUI({
selectInput(inputId = "id1",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
output$selectInput2 <- renderUI({
selectInput(inputId = "id2",
label = "select",
choices = c("a","b","c"),
selected = thechoice())
})
observeEvent(input$id2,{
thechoice(input$id2)
})
observeEvent(input$id1,{
thechoice(input$id1)
})
output$selected <- renderPrint({
c(input$id1, input$id2)
})
})
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