Generating a series of tabPanels

[Stéphane Laurent]

Hello. I'd like to generate an arbitrary number of tabPanels. For instance, the user uploads a data file whose first column is a factor, and then a tabPanel is created for each level of this factor. Is it possible ?

[Ramnath Vaidyanathan]

Yes. You need to place your tabPanel code in server.R and use renderUI to place it on the UI. 

[Stéphane Laurent]

Yes I know renderUI() but I'm not sure to understand your answer. Do you mean something like that could work, but then how to handle with DATA_i and PANEL_i ? (DATA_i and PANEL_i have no sense in my code, this is one of the point which causes problem to me) :

```
for(i in 1:length(levels(myfactor))){
  output$DATA_i <- reactive({
        data.frame(...)
      }) 
    }
    for(i in 1:length(levels(myfactor))){
      id <- levels(myfactor)[i]
      output$PANEL_i <- renderUI({
    tabPanel(paste0("tab_","id"), 
      tableOutput(deparse(substitute(DATA_i)))
  }) 
}
``` 

[Stéphane Laurent]

I have been under the impression that the output of renderUI() is an expression, which would mean that something like tableOutput(deparse(substitute(DATA_i))) is not possible ? Actually I'm under the impression nothing can work in this code, no ? And moreover can we make a loop in the ui.R file ?

[Ramnath Vaidyanathan]

You have the right idea, although I am not sure the deparse stuff will work. Let me try to cook up a minimal example of what I was thinking.

[Stéphane Laurent]

Oh I see we surely can do output$DATA[[i]] after defining an empty list DATA. 

The problem is to write the UIs. 

[Stéphane Laurent]

I was very tired last night. 

I almost have a solution. The only problem is that I don't know how to create some output$... in a loop. I had to midify the tabsetPanel() function. 

server.R:

``` 

mytabsetPanel <- function (tabs, id = NULL, selected = NULL) 

{

  #tabs <- list(...)

  tabNavList <- tags$ul(class = "nav nav-tabs", id = id)

  tabContent <- tags$div(class = "tab-content")

  firstTab <- TRUE

  tabsetId <- as.integer(stats::runif(1, 1, 10000))

  tabId <- 1

  for (divTag in tabs) {

    thisId <- paste("tab", tabsetId, tabId, sep = "-")

    divTag$attribs$id <- thisId

    tabId <- tabId + 1

    tabValue <- divTag$attribs$`data-value`

    if (!is.null(tabValue) && is.null(id)) {

      stop("tabsetPanel doesn't have an id assigned, but one of its tabPanels ", 

           "has a value. The value won't be sent without an id.")

    }

    liTag <- tags$li(tags$a(href = paste("#", thisId, sep = ""), 

                            `data-toggle` = "tab", `data-value` = tabValue, divTag$attribs$title))

    if (is.null(tabValue)) {

      tabValue <- divTag$attribs$title

    }

    if ((firstTab && is.null(selected)) || (!is.null(selected) && 

                                              identical(selected, tabValue))) {

      liTag$attribs$class <- "active"

      divTag$attribs$class <- "tab-pane active"

      firstTab = FALSE

    }

    divTag$attribs$title <- NULL

    tabNavList <- tagAppendChild(tabNavList, liTag)

    tabContent <- tagAppendChild(tabContent, divTag)

  }

  tabDiv <- tags$div(class = "tabbable", tabNavList, tabContent)

}

####

#### Server

####

shinyServer(function(input, output, session) {

  texts <- c("blabla", "HHHHHHHH")

  nodes <- c("aaa","bbb")

  #for(i in 1:2){                   ## THAT DOESN'T WORK WITH THIS LOOP !!!

  #  text <- texts[i]

  #  output[[nodes[i]]] <- renderText({text})

  #}

  output[[nodes[1]]] <-  renderText({texts[1]})

  output[[nodes[2]]] <-  renderText({texts[2]})

  #

  tabnames <- c("uuu", "vvv")

  output$twotabs <- renderUI({   

    tabs <- list(NULL)

    for(i in 1:2){ 

      tabs[[i]] <- tabPanel(tabnames[i], textOutput(nodes[i]))

    }

    mytabsetPanel(

      tabs

    , id="tab0")

  })

  #

  #output$text1 <- renderUI({  textOutput(nodes[1]) })

  #output$text2 <- renderUI({  textOutput(nodes[2]) })

  #

  # tag selection (optional) :

  observe({

    tabselect <- input$tab == TRUE

    if (tabselect) {

      updateTabsetPanel(session, "tab0", "uuu")

    } else {

      updateTabsetPanel(session, "tab0", "vvv")

    }

  })

})

```

ui.R:

```

shinyUI(pageWithSidebar(

  headerPanel("xxx"),

  ##

  ## sidebar panel

  ##

  sidebarPanel(

    checkboxInput("tab", "select tab")

    ),

  ##

  ## main panel 

  ##

  mainPanel(

    #uiOutput("text1"),

    #uiOutput("text2")

    uiOutput("twotabs")

  )

))

```

[Stéphane Laurent]

If you want to try: https://gist.github.com/stla/6536230

[Stéphane Laurent]

That works :

``` 

####

#### Server

####

shinyServer(function(input, output, session) {

  texts <- c("blabla", "HHHHHHHH")

  nodes <- c("aaa","bbb")

  names(texts) <- nodes

  for(i in 1:2){ 

    output[[nodes[i]]] <- renderText({texts[input$tab0]})

  }

  #

  tabnames <- c("uuu", "vvv")

  output$twotabs <- renderUI({

    tabs <- list(NULL)

    for(i in 1:2){

      tabs[[i]] <- tabPanel(tabnames[i], textOutput(nodes[i]), value=nodes[i])

    }

    mytabsetPanel(

      tabs

    , id="tab0")

  })

  #

  #output$text1 <- renderUI({  textOutput(nodes[1]) })

  #output$text2 <- renderUI({  textOutput(nodes[2]) })

  #

})

```

[Stéphane Laurent]

Hey try it !!  http://glimmer.rstudio.com/stla/MetaDynamicUI/

Source : https://gist.github.com/anonymous/6537713

[Stéphane Laurent]

This one is better:  http://glimmer.rstudio.com/stla/MetaDynamicUI4/ 

source: https://gist.github.com/stla/6539861

I'm afraid this will quickly become very complicated for a more serious appli.

[Stéphane Laurent]

Here is an application which is artificial but which well illustrates the serious application I'm aiming to do :

http://glimmer.rstudio.com/stla/MetaDynamicUI5/ 

source : https://gist.github.com/stla/6543131

That is working well except for one point. When I run this application with my local R, the following messages appear in the R console the first time I select a dataset : 

```

Listening on port 8100

Warning in matrix(align.tmp[(2 - pos):(ncol(x) + 1)], nrow = nrow(x), ncol = ncol(x) +  :

  data length exceeds size of matrix

Warning in min(x) : no non-missing arguments to min; returning Inf

Warning in max(x) : no non-missing arguments to max; returning -Inf

Warning in min(x) : no non-missing arguments to min; returning Inf

Warning in max(x) : no non-missing arguments to max; returning -Inf

Error in plot.window(...) : need finite 'xlim' values

```

The appli wors anyway, but I would be glad if someone could help me to prevent these warning messages. This looks like a synchronization problem.

[Joe Cheng]

If the only difference between mytabsetPanel and Shiny's own tabsetPanel is that the former takes a list of tabs as an argument instead of the individual tabs, then you could also accomplish that by calling tabsetPanel using do.call:

tabs <- ...

tabs$id <- 'tab0'

do.call(tabsetPanel, tabs)

This is not very intuitive, perhaps we should just change tabsetPanel to accept either list or ... tabsetPanels. (Come to think of it, that is how tabPanel and all the other panels work.)

Other than your MetaDynamicUI5 code looks like a sensible approach to me--I'm glad you were able to figure this out (and sorry for not weighing in sooner). Although I do wonder if rather than having the four separate reactive expressions under "preliminary objects", it would be more convenient to have a single reactive that does all of those calculations at the same time and returns them as a dataframe/list? Performance-wise it should be about the same because they all have the same dependencies--though if in your real application they have different dependencies then by all means keep them separate.

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
For more options, visit https://groups.google.com/groups/opt_out.

[Stéphane Laurent]

Hi Joe. You dont' have to be sorry; we cannot require you to be as reactive as Shiny ;-)

[Stéphane Laurent]

That works well with do.call(), indeed. 

But when I put my "preliminary" objects in a dataframe returned by only one reactive expression, that does not work. I'm still under the impression this is a synchronization progress. When we have two reactive expressions beginning with  if(!condition){return(NULL)}, which one is launched before the other when condition occurs ?  

[Stéphane Laurent]

This time it does not generate any warning :-)  http://glimmer.rstudio.com/stla/MetaDynamicUI7/

source: https://gist.github.com/stla/6549481

I think it is better to already use a first tab at the beginning. 

I had to separate some groups of preliminary objects in order that it works like that, without any warning.

[Stéphane Laurent]

I have noticed a problem with the withTags() function. Someting like that works very well:

``` 
withTags(div(class='row-fluid',
             div(class='span4', numericInput("lwr", "Lower limit", value=NA)),
             div(class='span4', numericInput("upr", "Upper limit", value=NA))
)) 
```

But in my case this UI is defined through the server file in a renderUI() environment and the labels of the widgets are given as objects, not as direct character strings, and then that doesn't work :

``` 
withTags(div(class='row-fluid',
             div(class='span4', numericInput(lwr, "Lower limit", value=NA)),
             div(class='span4', numericInput(upr, "Upper limit", value=NA))
)) 
```

It generates the following error message: 

Error in as.character(x) : 
  cannot coerce type 'closure' to vector of type 'character'

However that works: 

```
tags$div(class='row-fluid',
         div(class='span4', numericInput(lwr, "Lower limit", value=NA)),
         div(class='span4', numericInput(upr, "Upper limit", value=NA))
)
```

[Richard Schuster]

Hi Stéphane,

I recently came across your series of tabPanels post and its some great stuff, thank you very much for sharing it.

I have tried to adopt your code into my own shiny app (bare bone version attached) and creating a variable number of tabs works perfectly. I did run into one problem though, which is the reason why I am writing you now.
When you run the app you will see that the function generates 3 tabs initially (this can be changed with the iterations slider), which is what it should do. What's a bit odd though, but I can't figure out how to solve, is that all three tabs show the same table, specifically the table that should be displayed in the last tab. The tables for the different tabs come from csv files in the ./files/output folder (*_sum.csv) and are read in correctly by the marxan function that represents the biggest part of the code in server.R.

Could you have a quick look at the shinyServer function (starts at line 147) to check what I am doing wrong here?

In response to Stéphane's comment:
"The problem you mention is expected since you have commented these lines:

      #I <- input$tab0
      #if(I==i)
"

If I include these two lines of code I get the following error message:

Error in if (I == i) output[[nodes[i]]] <- renderTable({ : 
  argument is of length zero

Thanks very much for your help,
Richard

[Stéphane Laurent]

I think you need to use a first tab without dynamic elements. Could you try:

  output$tabsets <- renderUI({

    tabs <- list(NULL)

    texts <- Texts()

    nodes <- Nodes()

tabs[[1]] <- tabPanel("Test",

h4("test"),

value="welcometab")

    J <- length(nodes)

    for(i in 1:J){

      tabs[[i+1]] <- tabPanel(tabnames()[i], tableOutput(nodes[i]), value=i)

    }

    ..............

[Stéphane Laurent]

I suspect something else: don't put the counter in the body of renderSomething(). Try :

    for(i in 1:length(nodes)){

      tabl <-  texts[[i]]

        output[[nodes[i]]] <- renderTable({tabl})

    }

or 

    I <- input$tab0

    for(i in 1:length(nodes)){

      if(I==i){

         tabl <-  texts[[i]]

         output[[nodes[i]]] <- renderTable({tabl})

      }

    }

[Ramnath Vaidyanathan]

On a related note, you can generate dynamic tabsets more concisely, by using do.call, instead of looping. Here is an answer I gave on SO that shows how to do it.

library(shiny)
runApp(list(
  ui = pageWithSidebar(
    headerPanel('Dynamic Tabs'),
    sidebarPanel(
      numericInput("nTabs", 'No. of Tabs', 5)
    ),
    mainPanel(
      uiOutput('mytabs')  
    )
  ),
  server = function(input, output, session){
    output$mytabs = renderUI({
      nTabs = input$nTabs
      myTabs = lapply(paste('Tab', 1: nTabs), tabPanel)
      do.call(tabsetPanel, myTabs)
    })
  }
))

[Stéphane Laurent]

I don't understand what you mean. You use do.call() exactly as me, but you use lapply() instead of a loop. But for a real app, it's easier to use a loop.

[Ramnath Vaidyanathan]

Ah, I did not see your do.call code. You are right that the primary difference is lapply vs. loops and I have always been partial to the apply methods :)

[Richard Schuster]

Thanks for your suggestions.

I tried the non-dynamic first tab option previously and that did not resolve the issue.

 

Unfortunately taking the counter out of the render body did not resolve the issue either (still the same table in all tabs).

 

Including I <- input$tab0 and if(I==i) produces the same error as I got before:

Error in if (I == i) { : argument is of length zero

[Stéphane Laurent]

Strange. I have not tried your code. Is the code you sent to me self-contained ? 

[Richard Schuster]

Yes, everything should work once unzipped.

[Stéphane Laurent]

That works with Windows too ?

I understand why I==i cannot work: when you run the app, I doesn't exist at the very beginning. 

Try:

if(length(input$tab0)>0){

  I <- input$tab0

  for(i in 1:J){ 

     if(I==i){

        ...

[Richard Schuster]

I thought ShinyServer only works on Linux? Or is there a way to run Shiny apps without ShinyServer? If you are on a Windows system could you let me know how you set it up and I will adopt the code to run in that environment.

Including the if statement did improve things:
now the first tab shows the correct table (instead of the last one),
the draw back is that all other tabs are empty now.

[Stéphane Laurent]

Lol ;-) Try the runApp() function to run an app from your local R.

I have a lot of work, I'll take a look at your code when I take a pause.

Yours,

S

[Richard Schuster]

That's embarrassing. I never even tried it in Windows.

 I have attached a version that should run in Windows, but I think I am getting somewhere here:
I am using a submitButton in my UI (because calculations might take a while), so Tabs don't automatically update when I select them. If I go to an empty tab and press the submitButton the table gets populated with the correct values. Just need to figure out how to update the tables without pressing the button.

[Stéphane Laurent]

This is precisely the role of submitButton(). You may try actionButton() instead.

[Richard Schuster]

Thanks very much, I will give actionButtion() a try.

Am 24/10/2013 19:45, schrieb Stï¿œphane Laurent:

This is precisely the role of submitButton(). You may try actionButton() instead.

--
You received this message because you are subscribed to a topic in the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/shiny-discuss/-yxa4WFNTcA/unsubscribe.
To unsubscribe from this group and all its topics, send an email to shiny-discus...@googlegroups.com.