I would need to re-use in multiple tabs of my UI an input provided in the first tab by the user.
It seems that it is not possible to do this using renderUI in the server and calling its outputs using uiOutput in my different tabs. Here is a reproducible code
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),
mainPanel())
server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}
runApp(list(ui=ui,server=server))
Is there another way to achieve this ?
Many thanks in advance for any suggestion.
That's because it's reactive: the app must load, trigger a reactive event, which calls the server function, yielding HTML to insert into the page. This is one of the downsides of renderUI() ; relying on it too much can create a laggy UI.
Shiny applications have two components, a user interface object and a server function, that are passed as arguments to the shinyApp function that creates a Shiny app object from this UI/server pair.
A Shiny module is a piece of a Shiny app. It can't be directly run, as a Shiny app can. Instead, it is included as part of a larger app (or as part of a larger Shiny module – they are composable). Modules can represent input, output, or both.
You can't (shouldn't) have two elements with the same ID in an HTML document (whether using Shiny or not). Certainly when using Shiny having multiple elements with the same ID will be problematic. I would also subjectively vote that you could substantially improve your code by using meaningful variable names.
It's also not really clear what you want to do with this input. Do you want the input box to be displayed on multiple tabs? Or the value of the textInput to be shown on multiple tabs?
If the former, there's not an obvious way to do that, in my mind, without violating the "multiple elements with the same ID" clause. The latter would be much easier (just use a renderText
and send it to a verbatimOutput
), but I don't think that's what you're asking.
So what you really want is multiple text inputs (with distinct IDs) that are synchronized. That you can do in separate observers on your server using something like this:
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
INITIAL_VAL <- "Initial text"
server <- function(input,output, session){
# Track the current value of the textInputs. Otherwise, we'll pick up that
# the text inputs are initially empty and will start setting the other to be
# empty too, rather than setting the initial value we wanted.
cur_val <- ""
observe({
# This observer depends on text1 and updates text2 with any changes
if (cur_val != input$text1){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text2", NULL, input$text1)
cur_val <<- input$text1
}
})
observe({
# This observer depends on text2 and updates text1 with any changes
if (cur_val != input$text2){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text1", NULL, input$text2)
cur_val <<- input$text2
}
})
# Define the initial state of the text boxes
updateTextInput(session, "text1", NULL, INITIAL_VAL)
updateTextInput(session, "text2", NULL, INITIAL_VAL)
}
runApp(list(ui=ui,server=server))
There's probably a cleaner way to set the initial state than the cur_val
I'm tracking. But I couldn't think of something off the top of my head, so there it is.
The example from Jeff Allen works only if you keep both ui
and server
functions in the same file. As soon as you split them into a ui.R and server.R file you will get an error complaining about the input value not existing:
Warning: Unhandled error in observer: argument is of length zero
There is an event handler available in Shiny that solves all that. It also makes it possible to handle many input widgets, as it becomes easier to extend the code to observe multiple input widget. Thanks to Jeff's example I found the following solution:
ui.R
pageWithSidebar(
headerPanel("Minimal Event Handler example"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
server.R
function(input,output, session){
# Observe the current value of the textInputs with the Shiny Event Handler.
observeEvent(input$text1, function(){
# Observe changes in input$text1, and change text2 on event
updateTextInput(session, "text2", NULL, input$text1)
})
observeEvent(input$text2, function(){
# Observe changes in input$text2, and change text1 on event
updateTextInput(session, "text1", NULL, input$text2)
})
}
Note that ignoreNULL=TRUE
by default, so this will not fail on startup.
Following up on FvD's answer, if you happen to be using uiOutput
and renderUI
to create UI elements, it seems that shiny does not create those elements until the appropriate tabPanel is selected, which can cause his solution to fail at the outset. (Once a user has cycled through all tabPanels with UI elements you wish to sync, everything works fine, because all UI elements have been created).
To get around this, I created a reactive variable to store the input value selected or created by the user. Then, when another tabPanel with a synched UI element is selected for the first time, the UI element is rendered with the value of this reactive variable.
As an example, I have selectInput
elements on multiple panels I wish to be synched, and the choices
of these elements is created when the app loads (based on whatever is present in file structure):
ui <- navbarPage("Title",
navbarMenu("Set of tabs",
tabPanel("tab1",
wellPanel(
uiOutput("selectorBin1")
)
),
tabPanel("tab2",
wellPanel(
uiOutput("selectorBin2")
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
rv$selection <- " "
getChoices <- function() {
choices <- list.dirs(getwd())
return(choices)
}
output$selectorBin1 <- renderUI({
selectInput("selector1",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
output$selectorBin2 <- renderUI({
selectInput("selector2",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector1, {
rv$selection <- input$selector1 # In case this is the first tab loaded
updateSelectInput(session,
"selector2",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector2, {
rv$selection <- input$selector2 # In case this is the first tab loaded
updateSelectInput(session,
"selector1",
choices=getChoices(),
selected=rv$selection)
})
}
shinyApp(ui = ui, server = server)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With