9

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.

user1431694
  • 715
  • 1
  • 11
  • 22
  • The problem is the expression you use in `renderUI`. You should use "An expression that returns a Shiny tag object, HTML, or a list of such objects.", (`?renderUI`), you can't use "input$xyz". – Julien Navarre Feb 18 '14 at 21:19
  • Thank you Julien. Sorry I am new to Shiny and have no knowledge at all of HTML/tagging, could you please suggest a solution to me ? – user1431694 Feb 18 '14 at 21:37
  • (I've tried with tag() and with HTML() but it did not work, maybe because I don't understand how to use these functions either) – user1431694 Feb 18 '14 at 21:38
  • I didn't see but the 1st problem you have is that you can't have severals outputs with the same id ""x.vyz" (Try without the 3rd tab and you will see, the expression "input$xyz" will only return the value though). Then you can't define a "general output" this way. – Julien Navarre Feb 18 '14 at 21:58
  • So I would be really grateful if somebody has already found a solution to this problem and could share it. I presume there must be a way to create a "general" output, but after a few hours trying, I am now relying on the strength of the community – user1431694 Feb 18 '14 at 22:13

3 Answers3

9

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.

Jeff Allen
  • 17,277
  • 8
  • 49
  • 70
  • Thank you very much Jeff. What you provide is really helpful, but actually what I need is the first thing you suggested (Do you want the input box to be displayed on multiple tabs?). – user1431694 Feb 19 '14 at 19:11
  • So is there an efficient way to write different names in the server using a loop for example ? I have tried with the following code but it does not work – user1431694 Feb 19 '14 at 19:18
  • ui <- pageWithSidebar( headerPanel("Hello !"), sidebarPanel( tabsetPanel( tabPanel("a", textInput(inputId = "xyz", label = "abc", value = "abc") ), tabPanel("b", uiOutput("v.xyz[1]")) ,tabPanel("b", uiOutput("v.xyz[2]")) ) ), mainPanel() ) server <- function(input,output){ renderUI({ output$v.xyz <- rep(NA,2) for(i in 1:2){ output$v.xyz[i] < input$xyz } }) } runApp(list(ui=ui,server=server)) – user1431694 Feb 19 '14 at 19:20
  • @user1431694 starting with the initialisation `output$v.xyz <- rep(NA,2) ` makes no sense, remove it. Define `v.xyz <- c("name1","name2")` and `output[[v.xyz[i]]]` should work in the loop. – Stéphane Laurent Feb 20 '14 at 10:21
4

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.

FvD
  • 3,697
  • 1
  • 35
  • 53
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)
Andrew Brick
  • 115
  • 8