R Shiny: isoler la sortie dynamique dans les onglets dynamiques

Question

J'essaie de créer une application 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 petit exemple que vous pouvez utiliser ci-dessous.

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. Cependant, lorsque vous modifiez les lettres et cliquez à nouveau sur le bouton, tous les onglets précédents seront mis à jour avec les nouveaux résultats. Je voudrais isoler le résultat dans chaque onglet mais je ne sais pas comment le faire. J'ai essayé de le faire en utilisant différents noms de sortie (voir la variable summaryname sur le serveur) mais cela ne fonctionne pas.

Cet exemple n'utilise que la sortie de texte, mais mon application réelle utilise également des tables et des tracés.

J'apprécierais n'importe quelle aide!

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") 
         ) 
      ) 
    ) 
) 
) 

serveur:

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: Je rencontre des problèmes maintenant, quand je tente d'obtenir une mise en page navbarPage autour du code. D'une certaine manière, les résultats des onglets dynamiques s'affichent mal (et de nouveau ne sont pas correctement isolés). J'ai seulement changé l'interface utilisateur, mais j'ai inclus le serveur juste au cas où.

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 

    # 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") 
    }) 
} 

Answer 1

Modifier le code donné dans le link avec le code que vous avez fourni j'été en mesure de produire le résultat souhaité.

library(shiny) 

ui <- shinyUI(fluidPage(

    # 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 
    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 = "goCreate", label = "Go!") 

    ), 
    mainPanel(width = 8, 
    tabsetPanel(id = "mainTabset", 
       tabPanel("InitialPanel1", "Some Text here to show this is InitialPanel1") 
), 

    # 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 

    # 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("Result", nr), 
       # actionButton(paste0("Button", nr), "Some new button!"), 
       htmlOutput(paste0("Text", nr)) 
    ) 
    ) 

    output[[paste0("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") 
    }) 
} 

shinyApp(ui, server) 

Espérons que cela aide!