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

Question

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

目前,我在这里使用解决方案动态创建我的选项卡,但是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循环的方法以在每个选项卡上创建绘图.

但是,似乎不是创建新选项卡,而是上面的两个解决方案都重新创建了所有现有选项卡.因此,如果当前打开了10个选项卡,则会重新创建所有10个选项卡.不幸的是,这也将重置每个选项卡上的所有用户设置(除了减慢应用程序),以及额外的条款必须被视为显示在这里,这进一步减慢,因为该应用的大量输入的对象必须创建.

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

这是代码:

 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说它必须在一个反应​​式表达式中,为什么用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

我想提出一个解决方案,增加一个闪亮的功能,应该很久以前就已经实现了闪亮的基础.该功能可追加tabPanels现有tabsetPanels.我已经在这里和这里尝试了类似的东西,但这一次,我觉得这个解决方案更稳定,更通用.

对于此功能,您需要将4部分代码插入到闪亮的应用程序中.然后,您可以通过调用将任何tabPanels具有任何内容的集合添加到现有内容中.它的参数是一个(或列表中)和你的目标的名称(ID) .它甚至适用于,如果你只是想添加正常.tabsetPaneladdTabToTabsettabPaneltabPanelstabsetPanelnavbarPagetabPanels

应该复制粘贴的代码在"重要!"内.评论.

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

复制 - 粘贴 - 运行 - 玩!

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)

Answer 2

这可能与@ k-rohde的答案有关，而不是原始帖子。现在提供了一组在选项卡集中添加/删除/附加选项卡的方法：

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

希望这对登陆“如何在选项卡集中动态添加/删除选项卡”的人有所帮助。