J'essaie de créer une application en utilisant navbarPage() (ou quelque chose de similaire) où vous choisissez certaines entrées dans la barre latérale, et lorsque vous cliquez sur un bouton, il affichera les résultats dans un onglet séparé. J'ai créé un exemple, en utilisant le script of K.Rohde ci-dessous (notez que j'ai laissé ses commentaires originaux dans mon script).R Shiny: créer dynamiquement des onglets avec la sortie dans navbarPage()
Dans cet exemple, vous choisissez 4 lettres dans la barre latérale et si vous cliquez sur le bouton, il crée dynamiquement un onglet distinct avec la sortie de texte. Quand j'utilise fluidPage() cela fonctionne parfaitement, mais je veux utiliser navbarPage() ou quelque chose de similaire, puisque mon script final comprend plus de pages.
Lorsque j'utilise navbarPage(), le script ne fonctionne plus:
- Lorsque vous cliquez sur un onglet créé dynamiquement, la sortie de cet onglet ouvre une page blanche au lieu de l'onglet lui-même.
J'ai essayé le fixer en jouant avec tabsetPanel() et tabPanel dans l'interface utilisateur et le serveur, mais cela ne fonctionne pas. SBista pensait que navbarPage() semble gâcher la fonctionnalité Javascript, comme mentionné dans mon previous post.
J'apprécierais n'importe quelle aide!
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
)
)
)
)
)
)
serveur:
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")
})
}
Vous êtes mon héros . Merci du fond du coeur! – Marjolein