动态创建带有闪亮绘图的选项卡，而无需重新创建现有选项卡 [英] Dynamically creating tabs with plots in shiny without re-creating existing tabs

问题描述

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

I would like to create dynamic tabs, where each time the user clicks a button, a new tab would be created. Each tab has the same content, with a variety of widgets that the user can use to select which sets of data to be plotted.

目前，我正在使用此处的解决方案来动态创建我的选项卡，但随着 lapply 调用的更改调用 tabPanel 并向选项卡添加内容的函数

Currently, I am using the solution here to dynamically create my tabs, but with the change that lapply is calling a function that calls tabPanel and adds content to the tabs

`

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 循环方法在每个选项卡上创建绘图.

And the methods of for loops posted here to create the plots on each tab.

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

However, it seems like instead of creating a new tab, the 2 solutions above both re-create all the existing tabs. So if there are currently 10 tabs open, all 10 tabs get re-created. Unfortunately, this also resets all the user settings on each tab (in addition to slowing down the app), and extra provisions must be taken as shown here , which further slows down the app because of the large number of input objects that must be created.

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

I saw a solution for menu items that seems to solve this problem by simply storing all the menu items in a list, and each time a new menu item is generated, it is simply added to the list so that all the other existing items don't need to be created. Is something like this possible for tabs and rendering plots as well?

这是代码:

 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 的新列表，它会也非常感谢:)

If someone can explain to me what menu_list <- list(menu_vals$menu_list) is doing , why Rstudio says it must be inside a reactive expression, and why a new list called menu_vals is created with menu_list = null, it would be greatly appreciated as well :)

我想我能够防止每次创建新选项卡时重新创建绘图，并且还可以使用

I think I was able to prevent the plots from being re-created each time a new tab is created and also bypass the need for a max number of plots using

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

                 })

但是，我仍然不知道如何使用它来创建选项卡.我试过同样的方法，但没有用.

However, I still cannot figure out how to use this for creating tabs. I tried the same method but it didnt work.

推荐答案

我想提出一个解决方案，该解决方案可以添加一个特性到shiny，而这个特性早就应该在shiny基础中实现了.将 tabPanels 附加到现有 tabsetPanels 的函数.我已经尝试过类似的东西这里 和 这里，但这次，我觉得这个解决方案更加稳定和通用.

I would like to present a solution that adds a feature to shiny which should have been implemented into shiny base long ago. A function to append tabPanels to existing tabsetPanels. I already tried similar stuff here and here, but this time, I feel like this solution is way more stable and versatile.

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

For this feature, you need to insert 4 parts of code into your shiny app. Then you can add any set of tabPanels each having any content to an existing tabsetPanel by calling addTabToTabset. Its arguments are a tabPanel (or a list of tabPanels) and the name (id) of your target tabsetPanel. It even works for navbarPage, if you just want to add normal tabPanels.

应该复制粘贴的代码在重要！"里面.注释.

The code which should be copy-pasted, is inside the "Important!" comments.

我的评论可能不足以了解真正发生的事情(当然还有原因).所以如果你想更详细，请留言，我会尽量详细说明.

My comments will probably not be enough to grasp what's really happening (and why, of course). So if you want to get more into detail, please leave a message and I will try to elaborate.

复制-粘贴-运行-播放！

Copy-Paste-Run-Play!

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)

这篇关于动态创建带有闪亮绘图的选项卡，而无需重新创建现有选项卡的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！