我正在尝试创建一个应用程序，您可以在侧边栏中选择某些输入，当您单击按钮时，它将在单独的选项卡中显示结果。我创建了一个小示例，您可以在下面使用。
在此示例中，您在侧栏中选择 4 个字母，如果单击该按钮，它会动态创建一个带有文本输出的单独选项卡。但是，当您更改字母并再次单击该按钮时，所有以前的选项卡都将更新为新结果。我想隔离每个选项卡中的结果，但我不知道该怎么做。我尝试通过使用不同的输出名称来做到这一点（请参阅变量summaryname在服务器中）但它不起作用。
此示例仅使用文本输出，但我的实际应用程序还使用表格和绘图。
我将不胜感激任何帮助！
ui:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "choice_1", label = "First choice:",
choices = LETTERS, selected = "H", multiple = FALSE),
selectInput(inputId = "choice_2", label = "Second choice:",
choices = LETTERS, selected = "E", multiple = FALSE),
selectInput(inputId = "choice_3", label = "Third choice:",
choices = LETTERS, selected = "L", multiple = FALSE),
selectInput(inputId = "choice_4", label = "Fourth choice:",
choices = LETTERS, selected = "P", multiple = FALSE),
actionButton(inputId = "goButton", label = "Go!")
),
mainPanel(width = 8,
tabPanel("Result", fluid = TRUE,
uiOutput(outputId = "tabs"),
conditionalPanel(condition="input.level == 1",
HTML("<font size = 3><strong>Select your inputs and click 'Go!'.</strong></font>")
),
conditionalPanel(condition="input.level != 1",
uiOutput(outputId = "summary")
)
)
)
)
)
Server:
server <- function(input, output, session){
output$tabs <- renderUI({
Tabs <- as.list(rep(0, input$goButton+1))
for (i in 0:length(Tabs)){
Tabs[i] = lapply(paste("Results", i, sep = " "), tabPanel, value = i)
}
do.call(tabsetPanel, c(Tabs, id = "level"))
})
output$summary <- renderUI({
summary <- eventReactive(input$goButton, {paste("<strong>", "Summary:", "</strong>", "<br>",
"You chose the following letters:", input$choice_1, input$choice_2, input$choice_3, input$choice_4, "." ,"<br>",
"Thank you for helping me!")
})
summaryname <- paste("Summary", input$goButton+1, sep = "")
output[[summaryname]] <- renderText({summary()})
htmlOutput(summaryname)
})
}
EDIT:当我尝试在代码周围获取 navbarPage 布局时，我现在遇到了问题。不知何故，动态选项卡的结果显示错误（并且再次未正确隔离）。我只更改了用户界面，但为了以防万一，我添加了服务器。
ui:
ui <- navbarPage("Shiny",
# 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
tabPanel("Statistics"),
tabPanel("Summary",
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "choice_1", label = "First choice:",
choices = LETTERS, selected = "H", multiple = FALSE),
selectInput(inputId = "choice_2", label = "Second choice:",
choices = LETTERS, selected = "E", multiple = FALSE),
selectInput(inputId = "choice_3", label = "Third choice:",
choices = LETTERS, selected = "L", multiple = FALSE),
selectInput(inputId = "choice_4", label = "Fourth choice:",
choices = LETTERS, selected = "P", multiple = FALSE),
actionButton("goCreate", "Go create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset",
tabPanel("InitialPanel1", "Some text here to show this is InitialPanel1",
textOutput("creationInfo"),
# Important! : 'Freshly baked' tabs first enter here.
uiOutput("creationPool", style = "display: none;")
# End Important
)
)
)
)
)
)
Server:
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: Results ", input$goCreate + 1)
})
observeEvent(input$goCreate, {
nr <- input$goCreate
newTabPanels <- list(
tabPanel(paste0("NewTab ", nr),
htmlOutput(paste0("Html_text", nr)),
actionButton(paste0("Button", nr), "Some new button!"),
textOutput(paste0("Text", nr))
)
)
output[[paste0("Html_text", nr)]] <- renderText({
paste("<strong>", "Summary:", "</strong>", "<br>",
"You chose the following letters:", isolate(input$choice_1), isolate(input$choice_2), isolate(input$choice_3), isolate(input$choice_4), "." ,"<br>",
"Thank you for helping me!")
})
addTabToTabset(newTabPanels, "mainTabset")
})
}
