我正在使用navbarPage()创建一个包含多个tabPanel的Shiny应用。在每个单独的tabPanel中，您可以选择一些输入参数，单击一个按钮，然后将输出存储在那个tabPanel中的单独选项卡中。我使用script of K.Rohde创建动态标签（请注意，我在下面的示例脚本中留下了他们的评论。）
我用两个tabPanel做了一个例子：摘要和 Plot 。 'Summary'需要4个字母并返回文本输出。 'Plot'需要大量观察并返回直方图。每个结果都存储在“摘要”和“绘图”中的单独选项卡中。当我将它们保存为单独的Shiny App时，tabPanel工作正常，但是当我尝试将它们合并到一个应用程序中时，它们将不再起作用。在此示例中，tabPanel“Plot”不再起作用。有时它甚至会在“摘要”选项卡面板中返回“Plot”tabPanel的输出。
我尝试通过使每个变量唯一来更改K.Rohde中的（Javascript）代码：tabPanel“Summary”中的每个变量都以_sum结尾，tabPanel“Plot”中的每个变量都以_plot结尾。但是，这似乎并没有解决我的问题。
您可以复制粘贴以下代码以重现我的问题。 我感谢任何帮助！
UI ：
ui <- navbarPage("Shiny",
# *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_sum = [];
Shiny.addCustomMessageHandler('addTabToTabset_sum', function(message_sum){
var hrefCodes_sum = [];
/* Getting the right tabsetPanel */
var tabsetTarget_sum = document.getElementById(message_sum.tabsetName_sum);
/* Iterating through all Panel elements */
for(var i = 0; i < message_sum.titles.length; i++){
/* Creating 6-digit tab ID and check, whether it was already assigned. */
do {
hrefCodes_sum[i] = Math.floor(Math.random()*100000);
}
while(hrefCollection_sum.indexOf(hrefCodes_sum[i]) != -1);
hrefCollection_sum = hrefCollection_sum.concat(hrefCodes_sum[i]);
/* Creating node in the navigation bar */
var navNode_sum = document.createElement('li');
var linkNode_sum = document.createElement('a');
linkNode_sum.appendChild(document.createTextNode(message_sum.titles[i]));
linkNode_sum.setAttribute('data-toggle', 'tab');
linkNode_sum.setAttribute('data-value', message_sum.titles[i]);
linkNode_sum.setAttribute('href', '#tab-' + hrefCodes_sum[i]);
navNode_sum.appendChild(linkNode_sum);
tabsetTarget_sum.appendChild(navNode_sum);
};
/* 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_sum = document.getElementById('creationPool_sum').childNodes;
var tabContainerTarget_sum = document.getElementsByClassName('tab-content')[1];
/* Again iterate through all Panels. */
for(var i = 0; i < creationPool_sum.length; i++){
var tabContent_sum = creationPool_sum[i];
tabContent_sum.setAttribute('id', 'tab-' + hrefCodes_sum[i]);
tabContainerTarget_sum.appendChild(tabContent_sum);
};
}, 100);
});
"))),
# End Important
tabPanel("Summary",
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "choice_1_sum", label = "First choice:",
choices = LETTERS, selected = "H", multiple = FALSE),
selectInput(inputId = "choice_2_sum", label = "Second choice:",
choices = LETTERS, selected = "E", multiple = FALSE),
selectInput(inputId = "choice_3_sum", label = "Third choice:",
choices = LETTERS, selected = "L", multiple = FALSE),
selectInput(inputId = "choice_4_sum", label = "Fourth choice:",
choices = LETTERS, selected = "P", multiple = FALSE),
actionButton("goStat", "Go create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_sum",
tabPanel("InitialPanel1_sum", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_sum"),
# Important! : 'Freshly baked' tabs first enter here.
uiOutput("creationPool_sum", style = "display: none;")
# End 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_plot = [];
Shiny.addCustomMessageHandler('addTabToTabset_plot', function(message_plot){
var hrefCodes_plot = [];
/* Getting the right tabsetPanel */
var tabsetTarget_plot = document.getElementById(message_plot.tabsetName_plot);
/* Iterating through all Panel elements */
for(var i = 0; i < message_plot.titles.length; i++){
/* Creating 6-digit tab ID and check, whether it was already assigned. */
do {
hrefCodes_plot[i] = Math.floor(Math.random()*100000);
}
while(hrefCollection_plot.indexOf(hrefCodes_plot[i]) != -1);
hrefCollection_plot = hrefCollection_plot.concat(hrefCodes_plot[i]);
/* Creating node in the navigation bar */
var navNode_plot = document.createElement('li');
var linkNode_plot = document.createElement('a');
linkNode_plot.appendChild(document.createTextNode(message_plot.titles[i]));
linkNode_plot.setAttribute('data-toggle', 'tab');
linkNode_plot.setAttribute('data-value', message_plot.titles[i]);
linkNode_plot.setAttribute('href', '#tab-' + hrefCodes_plot[i]);
navNode_plot.appendChild(linkNode_plot);
tabsetTarget_plot.appendChild(navNode_plot);
};
/* 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_plot = document.getElementById('creationPool_plot').childNodes;
var tabContainerTarget_plot = document.getElementsByClassName('tab-content')[1];
/* Again iterate through all Panels. */
for(var i = 0; i < creationPool_plot.length; i++){
var tabContent_plot = creationPool_plot[i];
tabContent_plot.setAttribute('id', 'tab-' + hrefCodes_plot[i]);
tabContainerTarget_plot.appendChild(tabContent_plot);
};
}, 100);
});
"))),
# End Important
tabPanel("Plot",
sidebarLayout(
sidebarPanel(width = 4,
numericInput(inputId = "obs_plot", "Number of observations:", value = 100),
actionButton("goPlot", "Create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_plot",
tabPanel("InitialPanel1_plot", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_plot"),
# Important! : 'Freshly baked' tabs first enter here.
uiOutput("creationPool_plot", style = "display: none;")
# End Important
)
)
)
)
)
)
服务器：
server <- function(input, output, session){
#################
# Summary Tab #
#################
# 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_sum <- renderUI({})
outputOptions(output, "creationPool_sum", suspendWhenHidden = FALSE)
# End Important
# Important! : This is the make-easy wrapper for adding new tabPanels.
addTabToTabset_sum <- function(Panels, tabsetName_sum){
titles <- lapply(Panels, function(Panel){return(Panel$attribs$title)})
Panels <- lapply(Panels, function(Panel){Panel$attribs$title <- NULL; return(Panel)})
output$creationPool_sum <- renderUI({Panels})
session$sendCustomMessage(type = "addTabToTabset_sum", message = list(titles = titles, tabsetName_sum = tabsetName_sum))
}
# End Important
# From here: Just for demonstration
output$creationInfo_sum <- renderText({
paste0("The next tab will be named: Results ", input$goStat + 1)
})
observeEvent(input$goStat, {
nr <- input$goStat
newTabPanels_sum <- list(
tabPanel(paste0("NewTab ", nr),
htmlOutput(paste0("Html_text_sum", nr))
)
)
output[[paste0("Html_text_sum", nr)]] <- renderText({
paste("<strong>", "Summary:", "</strong>", "<br>",
"You chose the following letters:", isolate(input$choice_1_sum), isolate(input$choice_2_sum), isolate(input$choice_3_sum), isolate(input$choice_4_sum), "." ,"<br>",
"Thank you for helping me!")
})
addTabToTabset_sum(newTabPanels_sum, "mainTabset_sum")
})
#################
# Plot Tab #
#################
# 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_plot <- renderUI({})
outputOptions(output, "creationPool_plot", suspendWhenHidden = FALSE)
# End Important
# Important! : This is the make-easy wrapper for adding new tabPanels.
addTabToTabset_plot <- function(Panels, tabsetName_plot){
titles <- lapply(Panels, function(Panel){return(Panel$attribs$title)})
Panels <- lapply(Panels, function(Panel){Panel$attribs$title <- NULL; return(Panel)})
output$creationPool_plot <- renderUI({Panels})
session$sendCustomMessage(type = "addTabToTabset_plot", message = list(titles = titles, tabsetName_plot = tabsetName_plot))
}
# End Important
# From here: Just for demonstration
output$creationInfo_plot <- renderText({
paste0("The next tab will be named: Results ", input$goPlot + 1)
})
observeEvent(input$goPlot, {
nr <- input$goPlot
newTabPanels_plot <- list(
tabPanel(paste0("NewTab ", nr),
plotOutput(paste0("plot", nr))
)
)
output[[paste0("plot", nr)]] <- renderPlot({
hist(runif(isolate(input$obs_plot)))
})
addTabToTabset_plot(newTabPanels_plot, "mainTabset_plot")
})
}
答案 0 :(得分：3)
老实说，我不知道为什么你的代码不起作用。但是，我建议使用一种稍微不同的方法。如果我说得对，使用appendTab，以下代码应该完全符合您的要求。
ui <-
fluidPage(
navbarPage("Shiny",
tabPanel("summary",
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "choice_1_sum", label = "First choice:",
choices = LETTERS, selected = "H", multiple = FALSE),
selectInput(inputId = "choice_2_sum", label = "Second choice:",
choices = LETTERS, selected = "E", multiple = FALSE),
selectInput(inputId = "choice_3_sum", label = "Third choice:",
choices = LETTERS, selected = "L", multiple = FALSE),
selectInput(inputId = "choice_4_sum", label = "Fourth choice:",
choices = LETTERS, selected = "P", multiple = FALSE),
actionButton("goStat", "Go create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_sum",
tabPanel("InitialPanel1_sum", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_sum"),
uiOutput("creationPool_sum", style = "display: none;")
)
)
)
)
),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(width = 4,
numericInput(inputId = "obs_plot", "Number of observations:", value = 100),
actionButton("goPlot", "Create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_plot",
tabPanel("InitialPanel1_plot", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_plot"),
# Important! : 'Freshly baked' tabs first enter here.
uiOutput("creationPool_plot", style = "display: none;")
# End Important
)
)
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$goStat, {
appendTab(inputId = "mainTabset_sum",
select = T,
tabPanel(paste0("newtab", input$goStat), htmlOutput(paste0("text", input$goStat))
)
)
output[[paste0("text", input$goStat)]] <- renderText({
paste("<strong>", "Summary:", "</strong>", "<br>",
"You chose the following letters:", isolate(input$choice_1_sum), isolate(input$choice_2_sum), isolate(input$choice_3_sum), isolate(input$choice_4_sum), "." ,"<br>",
"Thank you for helping me!")
})
})
observeEvent(input$goPlot, {
appendTab(inputId = "mainTabset_plot",
select = T,
tabPanel(paste0("newplot", input$goPlot), plotOutput(paste0("plot", input$goPlot)))
)
output[[paste0("plot", input$goPlot)]] <- renderPlot({
hist(runif(isolate(input$obs_plot)))
})
})
}
shinyApp(ui, server)