R shiny: multiple use in ui of same renderUI in server? - r

Question

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.

Answer 1

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.

Answer 2

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.

Answer 3

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)