r - 动态创建带有 Shiny 绘图的选项卡，而无需重新创建现有选项卡

Question

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

目前，我正在使用解决方案 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)
})

`

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

但是，上面的 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 <- list(menu_vals$menu_list) 在做什么，为什么 Rstudio 说它必须在响应式(Reactive)表达式中，以及为什么使用 menu_list = null 创建一个名为 menu_vals 的新列表，将不胜感激好 :)

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

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

                 })

但是，我仍然无法弄清楚如何使用它来创建选项卡。我尝试了相同的方法，但没有奏效。

Answer 1

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

对于此功能，您需要将 4 部分代码插入到 Shiny 的应用程序中。然后你可以添加任何 一套tabPanels每个都有任何内容到现有 tabsetPanel调用 addTabToTabset .它的参数是 tabPanel (或 列表 的 tabPanels )和目标的名称(id) tabsetPanel .它甚至适用于 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)