动态创建带有闪亮图表的选项卡，而无需重新创建现有选项卡

2 回答

• 12

  我想提出一个解决方案 adds a feature 闪亮，这应该很久以前已经实施到闪亮的基地 . 一个函数 append tabPanels to existing tabsetPanels . 我已经尝试了类似的东西here和here，但这一次，我觉得这个解决方案更稳定，更通用 .

  对于此功能，您需要将4部分代码插入到闪亮的应用程序中 . 然后，您可以通过调用 addTabToTabset 将 any tabPanels 的每一个 any content 添加到现有的 tabsetPanel . 它的参数是 tabPanel （或 tabPanels 的 list ）和目标 tabsetPanel 的名称（id） . 它甚至适用于 navbarPage ，如果你只想添加正常的 tabPanels .

  应该复制粘贴的代码在“重要！”内 . 评论 .

  我的评论可能不足以掌握真正发生的事情（当然还有原因） . 因此，如果您想了解更多细节，请留言，我会尽力详细说明 .

  复制 - 粘贴 - 运行 - 玩！

  library(shiny)
  
  ui <- shinyUI(fluidPage(
  
    # Important! : JavaScript functionality to add the Tabs
    tags$head(tags$script(HTML("
      /* In coherence with the original Shiny way, tab names are created with random numbers. 
         To avoid duplicate IDs, we collect all generated IDs.  */
      var hrefCollection = [];
  
      Shiny.addCustomMessageHandler('addTabToTabset', function(message){
        var hrefCodes = [];
        /* Getting the right tabsetPanel */
        var tabsetTarget = document.getElementById(message.tabsetName);
  
        /* Iterating through all Panel elements */
        for(var i = 0; i < message.titles.length; i++){
          /* Creating 6-digit tab ID and check, whether it was already assigned. */
          do {
            hrefCodes[i] = Math.floor(Math.random()*100000);
          } 
          while(hrefCollection.indexOf(hrefCodes[i]) != -1);
          hrefCollection = hrefCollection.concat(hrefCodes[i]);
  
          /* Creating node in the navigation bar */
          var navNode = document.createElement('li');
          var linkNode = document.createElement('a');
  
          linkNode.appendChild(document.createTextNode(message.titles[i]));
          linkNode.setAttribute('data-toggle', 'tab');
          linkNode.setAttribute('data-value', message.titles[i]);
          linkNode.setAttribute('href', '#tab-' + hrefCodes[i]);
  
          navNode.appendChild(linkNode);
          tabsetTarget.appendChild(navNode);
        };
  
        /* Move the tabs content to where they are normally stored. Using timeout, because
           it can take some 20-50 millis until the elements are created. */ 
        setTimeout(function(){
          var creationPool = document.getElementById('creationPool').childNodes;
          var tabContainerTarget = document.getElementsByClassName('tab-content')[0];
  
          /* Again iterate through all Panels. */
          for(var i = 0; i < creationPool.length; i++){
            var tabContent = creationPool[i];
            tabContent.setAttribute('id', 'tab-' + hrefCodes[i]);
  
            tabContainerTarget.appendChild(tabContent);
          };
        }, 100);
      });
      "))),
    # End Important
  
    tabsetPanel(id = "mainTabset", 
      tabPanel("InitialPanel1", "Some Text here to show this is InitialPanel1", 
        actionButton("goCreate", "Go create a new Tab!"),
        textOutput("creationInfo")
      ),
      tabPanel("InitialPanel2", "Some Text here to show this is InitialPanel2 and not some other Panel")
    ),
  
    # Important! : 'Freshly baked' tabs first enter here.
    uiOutput("creationPool", style = "display: none;")
    # End Important
  
    ))
  
  server <- function(input, output, session){
  
    # Important! : creationPool should be hidden to avoid elements flashing before they are moved.
    #              But hidden elements are ignored by shiny, unless this option below is set.
    output$creationPool <- renderUI({})
    outputOptions(output, "creationPool", suspendWhenHidden = FALSE)
    # End Important
  
    # Important! : This is the make-easy wrapper for adding new tabPanels.
    addTabToTabset <- function(Panels, tabsetName){
      titles <- lapply(Panels, function(Panel){return(Panel$attribs$title)})
      Panels <- lapply(Panels, function(Panel){Panel$attribs$title <- NULL; return(Panel)})
  
      output$creationPool <- renderUI({Panels})
      session$sendCustomMessage(type = "addTabToTabset", message = list(titles = titles, tabsetName = tabsetName))
    }
    # End Important 
  
    # From here: Just for demonstration
    output$creationInfo <- renderText({
      paste0("The next tab will be named NewTab", input$goCreate + 1)
    })
  
    observeEvent(input$goCreate, {
      nr <- input$goCreate
  
      newTabPanels <- list(
        tabPanel(paste0("NewTab", nr), 
          actionButton(paste0("Button", nr), "Some new button!"), 
          textOutput(paste0("Text", nr))
        ), 
        tabPanel(paste0("AlsoNewTab", nr), sliderInput(paste0("Slider", nr), label = NULL, min = 0, max = 1, value = 1))
      )
  
      output[[paste0("Text", nr)]] <- renderText({
        if(input[[paste0("Button", nr)]] == 0){
          "Try pushing this button!"
        } else {
          paste("Button number", nr , "works!")
        }
      })
  
      addTabToTabset(newTabPanels, "mainTabset")
    })
  }
  
  shinyApp(ui, server)
  

  回复于 2024-04-29T15:39:47+08:00
• 4

  这可能与@ k-rohde的回答有关，而不是原帖 . 现在有一组方法可以在tabset中添加/删除/追加选项卡：

  library(shiny)
  runApp(list(
    ui=fluidPage(
      fluidRow(
        actionLink("newTab", "Append tab"),
        actionLink("removeTab", "Remove current tab")
      ),
      tabsetPanel(id="myTabs", type="pills")
    ),
    server=function(input, output, session){
      tabIndex <- reactiveVal(0)
      observeEvent(input$newTab, {
        tabIndex(tabIndex() + 1)
        appendTab("myTabs", tabPanel(tabIndex(), tags$p(paste("I'm tab", tabIndex()))), select=TRUE)
      })
      observeEvent(input$removeTab, {
        removeTab("myTabs", target=input$myTabs)
      })
    }
  ))
  

  希望这可以帮助任何人登陆这里寻找“如何动态添加/删除标签集中的标签” .

  回复于 2024-04-29T15:39:47+08:00