0
我试图创建一个使用你选择在侧边栏某些输入navbarPage()（类似什么的）应用程序，当你点击一个按钮，它会显示结果在一个单独的标签中。我创建了一个示例，使用下面的script of K.Rohde（请注意，我在脚本中留下了他的原始评论）。[R闪亮：内navbarPage（）动态创建与输出标签
在此示例中，您在边栏中选择4个字母，并且如果单击按钮，它会动态创建一个带有文本输出的单独选项卡。当我使用fluidPage()时，它完美地工作，但我想使用navbarPage()或类似的东西，因为我的最终脚本包含更多页面。
当我使用navbarPage()，该脚本不工作了：
- 当您点击动态创建一个标签，该标签的输出一个空白页，而不是在标签本身打开。
我试着通过在UI和服务器上玩tabsetPanel()和tabPanel来修复它，但是这并不起作用。 SBista认为navbarPage()似乎乱了JavaScript功能，正如我提到previous post。
我很感激任何帮助！
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 <- 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
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")
})
}
你是我的英雄。谢谢你从心底里！ – Marjolein