如何在点击操作按钮后显示隐藏的标签? [英] How to show hidden tabs after clicking an actionButton?

查看:14
本文介绍了如何在点击操作按钮后显示隐藏的标签?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我正在试图找到一些隐藏选项卡的方法,并在单击actionButton后显示它们。我发现这个post,但建议的解决方案使用navbarPage。我尝试使用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)

但我收到以下错误:

错误:导航容器需要 bslib::nav()/shiny::tabPanel()和/或 bslib::nav_menu()/shiny::navbarMenu()。请考虑使用headerfooter如果希望将内容放在每个面板的上方(或下方) 内容。

我尝试在此post中运行建议的解决方案,但仍收到相同的错误。我想这是因为我拥有的闪亮版本(1.7.1)。

有人能帮我吗?

我附上一个可重复使用的例子。我们的想法是隐藏Tab2和Tab3,当您单击actionButton提交&q;时,它们会出现。

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
 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
 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
 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
 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)

提前感谢

问候

推荐答案

以下是隐藏/显示第二个选项卡的代码。其他选项卡的代码类似。

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)

这篇关于如何在点击操作按钮后显示隐藏的标签?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆