Shiny: dynamic number of tabs and tab-dependent UI in the sidebar - v2

global.R

# generates a html link at topright position
sourcecode <- function(link){
  tags$a(href=link, 
         style="float:right; padding-right:10px;padding-top:10px; color:yellow; background-color:red; font-family:arial; font-size:20px",
         ">>source code<<")
}

## generates two datasets for illustration
#
tests <- c("aaa","bbb","ccc")
I <- length(tests) 
J <- 4 # nb timepoints
dat1 <- data.frame(
  Test=gl(I,J,labels=tests),
  timepoint=rep(1:J,I)
)
dat1 <- transform(dat1, y=round(rnorm(I*J,2*timepoint),1))
#
tests <- c("aaa","bbb","ccc","ddd","eee")
I <- length(tests) 
J <- 3 # nb timepoints
dat2 <- data.frame(
  Test=gl(I,J,labels=tests),
  timepoint=rep(1:J,I)
)
dat2 <- transform(dat2, y=round(rnorm(I*J,2*timepoint),1))

server.R

# setwd("~/Work/RD/MacroStab")
library(ggplot2)
####
#### 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$datatest == "0") return(NULL) 
    if (input$datatest == "1") return(dat1) 
    if (input$datatest == "2") return(dat2) 
  })
  ##
  ## Functinos defining the tab-dependent UIs
  ##
  Radiobutton <- function(i){
    id <- paste0("radio",i)
    # if(!is.null(Visited[[as.character(i)]])){
    radioButtons(id, "plot title:", choices=c("bonjour", "guten Tag"), selected=input[[id]])      
  }
  NumericInput <- function(i){
    id <- paste0("num",i)
    numericInput(id, "set a number", value=input[[id]])      
  }
  ##
  ## reactive list to store an indicator visited/unvisited tab
  ##
  TEMP <- reactiveValues()
  Visited <- reactiveValues(all=FALSE)
  ##
  ## Principal objects 
  ##
  pObjects <- reactive({
    dat <- datGet()
    if (is.null(dat)) return(NULL) 
    Levels <- levels(dat$Test)
    J <- length(Levels)
    Tabnames <- paste0("Test ", LETTERS[1:J]) 
    list(J=J, Levels=Levels, Tabnames=Tabnames)
  })
  ##
  ## return the values selected in the tabs (selectInput ("sel",i) is defined in its tab)
  ##
  Selecteds <- reactive({ # 
    dat <- datGet()
    if (is.null(dat)) return(NULL) 
    J <- length(levels(dat$Test))
    selecteds <- rep(NA, J)
      for(i in 1:J){ 
        selecteds[i] <- input[[paste0("sel",i)]]
      }
    selecteds
  })
  ##
  ## make a radio button depending on the active tab - to put in the sidebar
  ##
  output$Radio <- renderUI({
    i <- input$tab0
    if (!is.null(i)){ 
      if(!is.element(i, c("0","firsttab","summarytab"))){
          return(Radiobutton(as.numeric(i)))
      }
    }
  })
  SelectedRadios <- reactive({ # return the values selected in the tabs 
    pobjects <- pObjects()
    if (is.null(pobjects)) return(NULL)  
    J <- pobjects$J
    selecteds <- rep(NA, J)
    for(i in 1:J){ 
      sel <- input[[paste0("radio",i)]]
      selecteds[i] <- if(is.null(sel)) NA else sel
    }
    selecteds
  })
  ##
  ## make a numeric input widget depending on the active tab
  ##
  output$Numeric <- renderUI({
    if (!is.null(pObjects())) {
      i <- input$tab0
      if(!is.element(i, c("0","firsttab","summarytab"))){
        return(NumericInput(as.numeric(i)))
      }
    }
  })
  ##
  ## make a table showing whether the tabs have been visited yet
  ##
  output$testcodes1 <- renderTable({
    pobjects <- pObjects()
    if (is.null(pobjects)) return(NULL)
    tests <- pobjects$Levels
    J <- pobjects$J
    inspected <- sapply(as.character(1:J), function(i){ 
      visited <- Visited[[i]] 
      switch(as.character(visited), "TRUE"="Yes", "FALSE"="No")
    })
    tcodes <- data.frame(code=LETTERS[1:J], Test=tests, visited=inspected)
    tcodes
  }, include.rownames=FALSE)
  output$testcodes2 <- renderUI({ 
    pobjects <- pObjects()
    if (is.null(pobjects)) return(NULL)
    wellPanel(
      h3("Tests coding:"),
      helpText("This coding is used in the tab names"), 
      tableOutput("testcodes1")
    )
  })
  ##
  ## make the UIs for each tab  
  ##  
  observe({ 
    pobjects <- pObjects()
    if (!is.null(pobjects)) {
      tests <- pobjects$Levels
      J <- pobjects$J
      tnodes <- paste0("tnode", LETTERS[1:J]) # name of table output object 
      pnodes <- paste0("pnode", LETTERS[1:J]) # name of plot output object
      dat <- datGet()
      ## overall plot in the first tab :
      output$dataplot <- renderPlot({
        gg <- ggplot(dat, aes(x=timepoint, y=y)) + geom_point() + 
            geom_smooth(method=lm, se=FALSE, size=1, linetype="twodash") +
            facet_grid(Test~.) + ylab("result")
        print(gg) 
      }, width=500, height=900)
      #
      for(i in as.character(1:J)){ 
        Visited[[i]] <- !is.null(TEMP[[i]])
      }
      ## tab 1, 2, ..., J
      I <- input$tab0
      for(i in 1:J){ 
        if(I==i){
          TEMP[[as.character(i)]] <- "ok"
          test <- tests[as.numeric(I)] 
          dd <- droplevels(subset(dat, subset= Test== test))
          output[[tnodes[i]]] <- renderTable({ # table in each tab 
            dd
          })
          title <- input[[paste0("radio",i)]]
          output[[pnodes[i]]] <- renderPlot({ # plot in each tab
            plot(dd$timepoint, dd$y, main=title)
          }, width=600, height=300)
        }
      }
      ##
      Visited$all <- all(sapply(as.character(1:J), function(i) !is.null(Visited[[i]])))
      ## UIs in the summary tab:
      output$selections <- renderTable({ # to display in the "Summary" tab
        data.frame(tab=pobjects$Tabnames, selected=Selecteds())
      })
      output$radioselections <- renderTable({ # to display in the "Summary" tab
        data.frame(tab=pobjects$Tabnames, selected=SelectedRadios())
      })
    }
  })
  ##
  ## make the tabs 
  ##
  output$twotabs <- renderUI({
    tabs <- list(NULL)
    ## temporary firsttab (disappears after data selection) :
    tabs[[1]] <- tabPanel("Data", 
      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"))
      )),
       value="0")
    ## permanent tabs : firsttab, 1, 2, ..., J, summarytab
    pobjects <- pObjects()
    if (!is.null(pobjects)) { 
      tabnames <- pobjects$Tabnames
      J <- pobjects$J
      tnodes <- paste0("tnode", LETTERS[1:J]) # name of table output object 
      pnodes <- paste0("pnode", LETTERS[1:J]) # name of plot output object
      tabs[[1]] <- tabPanel("Data",
                          h3("Overview of Data"), 
                          h3("Click on the tabs to run the analysis for each test"), 
                          h3("When done, click on the Summary tab to check and generate a report"), 
                          plotOutput("dataplot"),
                          value="firsttab")
      for(i in 1:J){
        tabs[[i+1]] <- tabPanel(tabnames[i], 
                            h3(tabnames[i]), 
                            selectInput(paste0("sel",i), "Select (will be rendered in the summary tab)", choices=as.character(1:3), selected="1"), 
                            tableOutput(tnodes[i]), 
                            plotOutput(pnodes[i]),
                            value=i)
      }
      tabs[[J+2]] <- tabPanel("Summary", 
                                    h3("Your selections:"),
                                    tableOutput("selections"),
                              tableOutput("radioselections"), 
                                    value="summarytab")
    } 
    tabs$id <- "tab0"
    do.call(tabsetPanel, tabs)
  })
  #
})
  

ui.R

shinyUI(pageWithSidebar(
  headerPanel("Generating an arbitrary number of tabs - assay 7ter", 
              tags$head(
                sourcecode(link="https://gist.github.com/stla/7440533")
              )
  ),
  ##
  ## sidebar panel
  ##
  sidebarPanel(
    conditionalPanel(
      condition = 'input.tab0 == "0"',
      selectInput("datatest", "Select a dataset", choices=c(none=0, test1=1, test2=2), selected=0)
    ),
    uiOutput("Radio"),
    uiOutput("Numeric"),
    uiOutput("testcodes2")
  ),
  ##
  ## main panel 
  ##
  mainPanel(
      uiOutput("twotabs")
  )
))