由于K. Rohde解决方案（Dynamically creating tabs with plots in shiny without re-creating existing tabs），我成功制作了动态tabPanel。
但是，当我尝试在shinydashboard布局中导入它时，我观察到动态创建的tabPanel的奇怪行为：当我选择一个时，页面变为空，除了我在新面板中指定的内容。
我不明白为什么......似乎新的标签不会继承属于他人的布局元素（如果不使用shinydashboard，那么它应该是......也许？），并隐藏它们（！？）。当我点击另一个tabItem并返回时，在点击＆＃34;动态标签＆＃34;之前，所有内容都会显示。
这并不容易解释，所以这里有一个可重复的例子，它只是K. Rhode示例在shinydashboard布局中的转换：
library(shiny)
library(shinydashboard)
ui <- dashboardPage(skin = "green",
dashboardHeader(title = 'Dynamic Tabs'),
dashboardSidebar(
sidebarMenu(id = "sidebarmenu",
menuItem("Page1", tabName = "Page1", icon = icon("map"), selected = TRUE),
# just to show that coming back to page 1 from page 2 recall the good layout :
menuItem("Page2", tabName = "Page2", icon = icon("dashboard"), selected = FALSE)
)
),
dashboardBody(
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);
});
"))),
tabItems(
tabItem(tabName = "Page1",
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
,
tabItem(tabName = "Page2", "Go back to page 1...")
)
)
)
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)
干杯。