Series of tabs with Shiny - test 5

global.R

## slight modification of tabsetPanel() function
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)
}

## generates two datasets for illustration
I <- 3 # nb tests 
J <- 4 # nb timepoints
dat1 <- data.frame(
  Test=gl(I,J,labels=LETTERS[1:I]),
  timepoint=rep(1:J,I)
)
dat1 <- transform(dat1, y=round(rnorm(I*J,2*timepoint),1))
I <- 5 # nb tests 
J <- 3 # nb timepoints
dat2 <- data.frame(
  Test=gl(I,J,labels=LETTERS[1:I]),
  timepoint=rep(1:J,I)
)
dat2 <- transform(dat2, y=round(rnorm(I*J,2*timepoint),1))

server.R

####
#### Server
####
shinyServer(function(input, output, session) {
  ##
  ##  the two available datasets
  ##
  output$dat1 <- renderTable({ dat1 })
  output$dat2 <- renderTable({ dat2 })  
  ##
  ## get the selected dataset
  ##
  datGet <- reactive({
    if (input$ntabs == "0") return(NULL) 
    if (input$ntabs == "1") return(dat1) 
    if (input$ntabs == "2") return(dat2) 
  })
  Levels <- reactive({ # get the levels of the Test column 
    if (input$ntabs == "0") return(NULL) 
    dat <- datGet()
    levels(dat$Test)
  })
  ##
  ## Preliminary objects 
  ##
  Tabnames <- reactive({ # the names of the tabs
    if (input$ntabs == "0") return(NULL) 
    paste0("Test ", Levels()) 
  })
  tableNodes <- reactive({ # output nodes for tables rendering 
    if (input$ntabs == "0") return(NULL) 
    paste0("tnode", LETTERS[1:length(Levels())]) 
  })
  plotNodes <- reactive({ # output nodes for plots rendering
    if (input$ntabs == "0") return(NULL) 
    paste0("pnode", LETTERS[1:length(Levels())]) 
  })
  Selecteds <- reactive({ # (just for trying) return the values selected in the tabs 
    if (input$ntabs == "0") return(NULL) 
    selecteds <- rep(NA, length(Levels()))
    for(i in 1:length(selecteds)){ 
      selecteds[i] <- input[[paste0("sel",i)]]
    }
    selecteds
  })
  ##
  ## make the UI in each tab - TRICK: use input$tab0 as the current counter, not i ! 
  ##
  observe({ 
    dat <- datGet()
    if (!is.null(dat)) {
      tnodes <- tableNodes()
      pnodes <- plotNodes()
      tests <- levels(dat$Test)
    for(i in 1:length(tests)){ 
      test <- tests[as.numeric(input$tab0)]
      dd <- droplevels(subset(dat, subset= Test== test))
      output[[tnodes[i]]] <- renderTable({ # table in each tab 
        dd
      })
      output[[pnodes[i]]] <- renderPlot({ # plot in each tab
        plot(dd$timepoint, dd$y)
      }, width=600, height=300)      
    }
    output$selections <- renderTable({ # to display in the "Summary" tab
      data.frame(tab=Tabnames(), selected=Selecteds())
    })
    }
  })
  ##
  ## make the tabs 
  ##
  output$twotabs <- renderUI({
    if (is.null(datGet())) return(NULL) 
    tabnames <- Tabnames()
    tabs <- list(NULL)
    tnodes <- tableNodes()
    pnodes <- plotNodes()
    for(i in 1:length(tabnames)){
      tabs[[i]] <- tabPanel(tabnames[i], 
                            h3(tabnames[i]), 
                            selectInput(paste0("sel",i), "Select", choices=as.character(1:3), selected="1"), 
                            tableOutput(tnodes[i]), 
                            plotOutput(pnodes[i]),
                            value=i)
    }
    tabs[[length(tabnames)+1]] <- tabPanel("Summary", 
                                    h3("Your selections:"),
                                    tableOutput("selections")
                                  )
    mytabsetPanel(
      tabs
    , id="tab0")
  })
  #
})
  

ui.R

shinyUI(pageWithSidebar(
  headerPanel("Generating an arbitrary number of tabs - assay 5"),
  ##
  ## sidebar panel
  ##
  sidebarPanel(   
    selectInput("ntabs", "Select a dataset", choices=c(none=0, test1=1, test2=2), selected=0)
    ),
  ##
  ## main panel 
  ##
  mainPanel(
    conditionalPanel(
     condition = "input.ntabs == '0'", 
     h2("Choose a test dataset"), 
     h3("one tab will be generated for each level of the Test column"), 
     withTags(div(class='row-fluid',
                  div(class='span4', h3("Data test 1:"), tableOutput("dat1")),
                  div(class='span4', h3("Data test 2:"), tableOutput("dat2"))
     ))
    ),
      uiOutput("twotabs")
    #)
  )
))