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

Posted 2023-03-24

【中文标题】动态创建带有闪亮绘图的选项卡，而无需重新创建现有选项卡

【英文标题】：Dynamically creating tabs with plots in shiny without re-creating existing tabs

【发布时间】：2016-05-03 10:15:39

【问题描述】：

我想创建动态选项卡，每次用户单击按钮时，都会创建一个新选项卡。每个选项卡都有相同的内容，带有各种小部件，用户可以使用这些小部件来选择要绘制的数据集。

目前，我正在使用解决方案 here 来动态创建我的选项卡，但变化在于 lapply 正在调用一个调用 tabPanel 并向选项卡添加内容的函数

`

renderUI(
some_data <- # Dataframe that data is extracted goes here
createTabs <- function(tabNum, some_data)
    
      tabPanel(title = paste("Map", tabNum, sep=" "), 
               fluidRow(
                 column(
                   width = 3,
                   wellPanel(
                     #widgets are added here
    
 mTabs <- lapply(0:input$map, createTabs, some_data)
 do.call(tabsetPanel, mTabs)
)

`

以及here 发布的 for 循环方法以在每个选项卡上创建图。

但是，上面的 2 个解决方案似乎都不是创建新选项卡，而是重新创建所有现有选项卡。因此，如果当前打开了 10 个选项卡，则会重新创建所有 10 个选项卡。不幸的是，这也会重置每个选项卡上的所有用户设置（除了减慢应用程序的速度），并且必须采取额外的规定，如 here 所示，由于必须输入大量输入对象，这进一步减慢了应用程序的速度被创建。

我看到了一个菜单项的解决方案，似乎通过简单地将所有菜单项存储在一个列表中来解决这个问题，并且每次生成一个新的菜单项时，它都会简单地添加到列表中，以便所有其他现有的不需要创建项目。选项卡和渲染图也可以这样吗？

这是代码：

 newTabs <- renderMenu(
    menu_list <- list(
      menu_vals$menu_list)
    sidebarMenu(.list = menu_list)
  )

  menu_vals = reactiveValues(menu_list = NULL)
  observeEvent(eventExpr = input$placeholder,
               handlerExpr = 
                 menu_vals$menu_list[[input$placeholder]] <- menuSubItem(paste("Saved Simulation", length(menu_vals$menu_list) + 1, sep = " "),
                                                                                    tabName = paste("saved_sim", length(menu_vals$menu_list) + 1)) 
               )

如果有人可以向我解释 menu_list

编辑：我认为我能够防止每次创建新选项卡时重新创建绘图，并且还绕过了使用最大绘图数的需要

observeEvent(eventExpr = input$map,
                 handlerExpr = 
                   output[[paste0("outputComparePlot",simNum,"-",input$map)]] <- outputComparePlot(sessionEnv, config, react, input, simNum, input$map) #This function contains the call to renderPlot

                 )

但是，我仍然无法弄清楚如何使用它来创建标签。我尝试了同样的方法，但没有成功。

【问题讨论】：

那么reactiveValues中的menu_list是否与renderMenu中的相关？ menu_vals$menu_list 中的 menu_list 呢？他们只是选择了相同的名称，还是在内部声明了一个列表？

【参考方案1】：

我想提出一个解决方案，该解决方案向闪亮添加一个功能，该解决方案早就应该在闪亮的基础中实现。 将 tabPanels 附加到现有 tabsetPanels 的函数。我已经尝试过类似的东西here 和here，但是这一次，我觉得这个解决方案更加稳定和通用。

对于此功能，您需要将 4 部分代码插入到闪亮的应用程序中。然后，您可以通过调用addTabToTabset 将any 组tabPanels 添加到现有tabsetPanel 中，每个tabPanels 都具有任何内容。它的参数是tabPanel（或tabPanels 的列表）和目标tabsetPanel 的名称（id）。如果您只想添加普通的tabPanels，它甚至适用于navbarPage。

应该复制粘贴的代码在“重要！”中厘米。

我的 cmets 可能不足以掌握真正发生的事情（当然还有为什么）。所以如果你想更详细，请留言，我会尽量详细说明。

复制粘贴运行播放！

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)

【讨论】：

非常好，感谢分享代码！有没有办法清除所有的 newTabPanels？

@JorgeSepulveda 新创建的 tabPanel 与您在 shinyUI 中的初始程序启动时绘制的 tabPanel 没有什么不同。所以你问，tabPanels 一般是否可以动态删除？

@k-rohde 我在问是否有办法让“creationPool”面板消失（或根据输入列表替换为新面板）。我试过removeUI('creationPool')，但它不起作用。制作newTabPanels <- NULL 并运行addTabToTabset(newTabPanels, "mainTabset") 也不会这样做。感谢您的帮助！

@JorgeSepulveda creationPool 不是元素所在的位置，也不是元素之一。过程是：1）在creationPool中创建元素，2）从创建池中移除元素并将其移动到tabPanels。此过程完成后，creationPool 中就没有任何剩余了。你想要做的是，你想删除 tabPanel 本身。这个问题更笼统，因为它需要在所有可能的 tabPanel 上工作。它涉及删除 tabPanel、导航链接并可能销毁链接到选项卡的所有观察者。

非常感谢您的代码。您可以将其作为拉取请求提交给 Shiny 存储库吗？ github.com/rstudio/shiny/pulls

【参考方案2】：

可能要感谢@k-rohde，Shiny 现在原生提供了一组方法来在选项卡集中添加/删除/附加选项卡：

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