How to show hidden tabs after clicking an actionButton?
Asked Answered
P

2

1

I am trying to find the way to have some hidden tabs and show them after clicking an actionButton. I found this post but the proposed solution uses navbarPage. I tried to change the example using sidebarPanel:

library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(),

                tags$head(tags$style(HTML("#hello li a[data-value = 'tab2_val'], #hello li a[data-value = 'tab3_val'] 
                { display: none;}"))),
                
      # Application title
      titlePanel("My app"),
      
      sidebarLayout(
        sidebarPanel(
          tabsetPanel("hello", id="hello",
                                
           tabPanel("home", br(), h3("Click the button"),actionButton("enter", "enter")),
           tabPanel("tab2", value = "tab2_val", br(), h4("this is tab2")),
           tabPanel("tab3 with a lot of stuff in it", value = "tab3_val", br(), h4("this is tab3"))),
          
          mainPanel(
          )
        )
      )
)
      

server <- function(input, output, session) {
  
  observeEvent(input$enter, {
    show(selector = '#hello li a[data-value="tab3_val"]')
    show(selector = '#hello li a[data-value="tab2_val"]')
    })}
shinyApp(ui, server)

But I get this error:

Error: Navigation containers expect a collection of bslib::nav()/shiny::tabPanel()s and/or bslib::nav_menu()/shiny::navbarMenu()s. Consider using header or footer if you wish to place content above (or below) every panel's contents.

I tried to run the proposed solution in this post, but I still get the same error. I suppose it is because the version of shiny that I have (which is 1.7.1).

Could anyone help me with this?

I attach you a reproducible example. The idea is to have Tab2 and Tab3 hidden and when you click the actionButton "Submit" they appear.

library(shiny)
library(dplyr)
library(ggplot2)

ui <- fluidPage(
  
  titlePanel("My app"),
  
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        
        tabPanel("Tab1",
                 checkboxInput("log2", "Log2 transformation", value = FALSE),
                 actionButton("submit", "Submit")
        ),
        
        tabPanel("Tab2",
                 radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
                              c("All the samples" = "all_samples",
                                "Groups" = "samples_group")),
                 conditionalPanel(
                   condition = "input.plot_type == 'samples_group'",
                   style = "margin-left: 20px;",
                   checkboxGroupInput("group", "Choose the group:",
                                      choices = c("Group1", "Group2", "Group3"))),
                 
                 actionButton("show_plot", "See the plot")
        ),
        
        tabPanel("Tab3",
                 numericInput("alpha", "Opacity of the plot", value=0.2),
                 checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
                 conditionalPanel(
                   condition = "input.Kruskalpval == '1'",
                   style = "margin-left: 20px;",
                   checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
                   
                   conditionalPanel(
                     condition = "input.changeKW == '1'",
                     numericInput(inputId = "X_axis", "X_axis:", value=2),
                     numericInput(inputId = "Y_axis", "Y_axis:", value=70)
                   )
                   
                 ),
                 actionButton("show_plot_2", "See the plot")
        )
        
      )
    ),
    
    mainPanel(
      plotOutput("boxplots")
    )
  )
)


server <- function(input, output) {
  
  
  set.seed(1234)
  Gene <- floor(runif(25, min=0, max=101))
  groups_age <- floor(runif(25, min=18, max=75))
  Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
  
  data <- reactive({
    df <- data.frame(Gene, Group, groups_age)
    
    mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
    df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
    
    if(input$plot_type == "samples_group"){
      
      # if the user selects everything, it will take everything. 
      if(all(c("Group1", "Group2", "Group3") %in% input$group)){
        return(df)
        
        # if the user only selects group1 and group2, it will appear only those columns.
      }else if (all(c("Group1", "Group2") %in% input$group)) {
        df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
        return(df)
        
        # if the user only selects group1 and group3, it will appear only those columns.
      }else if (all(c("Group1", "Group3") %in% input$group)) {
        df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
        return(df)
        
        # if the user only selects Group2 and Group3, it will appear only those columns.
      }else if (all(c("Group2", "Group3") %in% input$group)) {
        df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
        return(df)
        
        # if the user only selects Group1
      } else if ("Group1" %in% input$group) {
        df <- subset(df, (df$Group == "Group1"))
        return(df)
        
        # if the user only selects group2
      } else if ("Group2" %in% input$group) {
        df <- subset(df, (df$Group == "Group2"))
        return(df)
        
        
        # if the user only selects group3
      } else if ("Group3" %in% input$group) {
        df <- subset(df, (df$Group == "Group3"))
        return(df)
        
        # if the user doesn't select anything.
      } else {
        return(df)
      }
    }else{
      df$Group <- NULL
      return(df)
    }
  })
  
  
  mydata <- reactive({
    req(input$submit)
    
    if(input$log2 == TRUE){
      data <- data()
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
      
    }
    else{
      data <- data()
    }
    return(data)
  })
  
  draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
    
    if(ncol(mydata())==2){
      bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
        geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
        labs(fill = "groups_age")
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
        pval <- mydata() %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
        pval <- mydata() %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      return(bp)
    }
    else{
      bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
        geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
        facet_grid(. ~ Group)
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
        pval <- mydata() %>%
          group_by(Group) %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
        pval <- mydata() %>%
          group_by(Group) %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      return(bp)
      
    }
  })
  
  v <- reactiveValues()
  observeEvent(input$show_plot | input$show_plot_2, {
    v$plot <- draw_bp()
    
  })
  
  output$boxplots <- renderPlot({
    req(input$submit)
    draw_bp()
  })
}

shinyApp(ui = ui, server = server)

Thanks very much in advance

Regards

Precondition answered 12/1, 2022 at 8:12 Comment(1)
You are getting the error due to the "hello" in tabsetPanel. tabsetPanel expects tabPanels not strings.Jijib
S
1

Here is the code for hiding/showing the second tab. Code is similar for the other tabs.

library(shiny)

js <- "$(document).ready(function(){
    var $tab2 = $('#hello li > a[data-value=tab2_val]').parent(); 
    $tab2.removeClass('active').addClass('hide');
    $('#enter').on('click', function(){
      $tab2.removeClass('hide');
    });
  });
"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),

  # Application title
  titlePanel("My app"),
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        tabPanel(
          "home", br(), h3("Click the button"), actionButton("enter", "enter")
        ),
        tabPanel(
          "tab2", value = "tab2_val", br(), h4("this is tab2")
        ),
        tabPanel(
          "tab3 with a lot of stuff in it", value = "tab3_val", br(), 
          h4("this is tab3")
        ),
        id = "hello"
      )
    ),
    mainPanel()
  )
)


server <- function(input, output, session) {
}

shinyApp(ui, server)
Sympathetic answered 12/1, 2022 at 9:3 Comment(7)
Thanks very much for your help. However, how can I do it for Tab3? I don't know how JS works with spaces... and I have tried it the same thing... but it seems that it doesn't like spaces. If I write only "Tab3" works.. but, what if I have 2 or 3 words? Do you know how can I do it? ThanksPrecondition
I have tried to add a regular space as I found on Google (&nbsp) like this $Tab3&nbspwith&nbspa&nbsplot&nbspof&nbspstuff&nbspin&nbspit but it doesn't work.Precondition
@Eva There's no space in the value of Tab3 (tab3_val). But if you have some spaces you can try a[data-value=\"tab3 value with spaces\"].Strachey
No, I didn't mean the value of the tabs. I was referring to the name of each tab. You used var $tab2 and $tab2.removeClass with the name of tab2... (which is tab2), however tab3 has this name ("tab3 with a lot of stuff in it")... but if I try to do the same as you did with tab2 it doesn't work. Could you tell me how to add the third tab to your answer, please? Thanks very much againPrecondition
This is what I have tried (and it doesn't work) js <- "$(document).ready(function(){ var $tab2 = $('#hello li > a[data-value=tab2_val]').parent(); var $tab3 with a lot of stuff in it = $('#hello li > a[data-value=tab3_val]').parent(); $tab2.removeClass('active').addClass('hide'); $tab3 with a lot of stuff in it.removeClass('active').addClass('hide'); $('#submit').on('click', function(){ $tab2.removeClass('hide'); $tab3 with a lot of stuff in it.removeClass('hide'); }); }); "Precondition
@Eva Just do var $tab3 = ....... This is just the name of a variable, you can use what you want.Strachey
oh right, thanks very much!Precondition
J
0

Here is a solution using appendTab, as done here:

Your initial example:

library(shiny)

ui <- fluidPage(
                titlePanel("My app"),
                sidebarLayout(
                  sidebarPanel(
                    tabsetPanel(id="hello",
                                tabPanel("home", br(), h3("Click the button"),actionButton("enter", "enter"))
                                )
                  ),
                  mainPanel()
                )
)


server <- function(input, output, session) {
  
  observeEvent(input$enter, {
    appendTab(inputId = "hello", tabPanel("tab2", value = "tab2_val", br(), h4("this is tab2")))
    appendTab(inputId = "hello", tabPanel("tab3 with a lot of stuff in it", value = "tab3_val", br(), h4("this is tab3")))
  }, once = TRUE)
  
  }

shinyApp(ui, server)

The second example:

library(shiny)
library(dplyr)
library(ggplot2)

ui <- fluidPage(
  
  titlePanel("My app"),
  
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        id = "tabsetPanelID",
        tabPanel("Tab1",
                 checkboxInput("log2", "Log2 transformation", value = FALSE),
                 actionButton("submit", "Submit")
        )
      )
    ),
    mainPanel(
      plotOutput("boxplots")
    )
  )
)


server <- function(input, output) {
  
  observeEvent(input$submit, {
    appendTab(inputId = "tabsetPanelID", tab = tabPanel("Tab2",
                                                        radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
                                                                     c("All the samples" = "all_samples",
                                                                       "Groups" = "samples_group")),
                                                        conditionalPanel(
                                                          condition = "input.plot_type == 'samples_group'",
                                                          style = "margin-left: 20px;",
                                                          checkboxGroupInput("group", "Choose the group:",
                                                                             choices = c("Group1", "Group2", "Group3"))),
                                                        
                                                        actionButton("show_plot", "See the plot")
    ))
    appendTab(inputId = "tabsetPanelID", tab = tabPanel("Tab3",
                                                        numericInput("alpha", "Opacity of the plot", value=0.2),
                                                        checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
                                                        conditionalPanel(
                                                          condition = "input.Kruskalpval == '1'",
                                                          style = "margin-left: 20px;",
                                                          checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
                                                          
                                                          conditionalPanel(
                                                            condition = "input.changeKW == '1'",
                                                            numericInput(inputId = "X_axis", "X_axis:", value=2),
                                                            numericInput(inputId = "Y_axis", "Y_axis:", value=70)
                                                          )
                                                          
                                                        ),
                                                        actionButton("show_plot_2", "See the plot")
    ))
  }, once = TRUE)
  
  set.seed(1234)
  Gene <- floor(runif(25, min=0, max=101))
  groups_age <- floor(runif(25, min=18, max=75))
  Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
  
  data <- reactive({
    df <- data.frame(Gene, Group, groups_age)
    
    mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age)+10, by=10)
    df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
    
    if(input$plot_type == "samples_group"){
      
      # if the user selects everything, it will take everything. 
      if(all(c("Group1", "Group2", "Group3") %in% input$group)){
        return(df)
        
        # if the user only selects group1 and group2, it will appear only those columns.
      }else if (all(c("Group1", "Group2") %in% input$group)) {
        df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
        return(df)
        
        # if the user only selects group1 and group3, it will appear only those columns.
      }else if (all(c("Group1", "Group3") %in% input$group)) {
        df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
        return(df)
        
        # if the user only selects Group2 and Group3, it will appear only those columns.
      }else if (all(c("Group2", "Group3") %in% input$group)) {
        df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
        return(df)
        
        # if the user only selects Group1
      } else if ("Group1" %in% input$group) {
        df <- subset(df, (df$Group == "Group1"))
        return(df)
        
        # if the user only selects group2
      } else if ("Group2" %in% input$group) {
        df <- subset(df, (df$Group == "Group2"))
        return(df)
        
        
        # if the user only selects group3
      } else if ("Group3" %in% input$group) {
        df <- subset(df, (df$Group == "Group3"))
        return(df)
        
        # if the user doesn't select anything.
      } else {
        return(df)
      }
    }else{
      df$Group <- NULL
      return(df)
    }
  })
  
  
  mydata <- reactive({
    req(input$submit)
    
    # browser()
    if(input$log2 == TRUE){
      data <- data()
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
    }
    else{
      data <- data()
    }
    return(data)
  })
  
  draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
    
    if(ncol(mydata())==2){
      bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
        geom_boxplot(aes(fill=groups_age), alpha = input$alpha) +
        labs(fill = "groups_age")
      
      req(input$Kruskalpval)
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
        pval <- mydata() %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
        pval <- mydata() %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      return(bp)
    }
    else{
      bp <- ggplot(mydata(), aes(x=groups_age, y=Gene)) +
        geom_boxplot(aes(fill=groups_age), alpha=input$alpha) +
        facet_grid(. ~ Group)
      
      req(input$Kruskalpval)
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
        pval <- mydata() %>%
          group_by(Group) %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      
      if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
        pval <- mydata() %>%
          group_by(Group) %>%
          summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
        
        bp <- bp + geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
      }
      return(bp)
      
    }
  })
  
  v <- reactiveValues()
  observeEvent(input$show_plot | input$show_plot_2, {
    v$plot <- draw_bp()
    
  })
  
  output$boxplots <- renderPlot({
    req(input$submit)
    draw_bp()
  })
}

shinyApp(ui = ui, server = server)
Jijib answered 12/1, 2022 at 10:41 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.