2017-10-10 12 views
0

サイドバーで特定の入力を選択するアプリケーションを作成しようとしています。ボタンをクリックすると、結果が別のタブに表示されます。私はあなたが下で使うことができる小さな例を作りました。R Shiny:ダイナミックタブ内でダイナミック出力を分離する

この例では、サイドバーで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 <- 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) 
    }) 

} 

編集:私は、コードの周りnavbarPageレイアウトを取得しようとすると、 私は今、問題が発生しています。何とか、動的タブの結果が間違って表示されてしまいます。私はUIだけを変更しましたが、私はその場合に備えてサーバーを含めました。

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

サーバー:あなたは私が所望の結果を得ることができた提供されたコードとlinkで与えられたコードを変更する

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") 
    }) 
} 
+0

多分[this](https://stackoverflow.com/questions/35020810/dynamically-creating-tabs-with-plots-in-shiny-without-re-creating-existing-tabs/)は役に立ちますか? – SBista

+0

すばらしい提案をありがとう。私はサンプルスクリプトで実装しようとしましたが、残念ながら私はまだ同じ問題を抱えています。私が間違っていることを特定することはできません。 – Marjolein

答えて

1

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) 

これが役に立ちます。

+0

ありがとう、それは完全に動作します。私の間違いはisolate()を含まないことでした。ありがとうございました! – Marjolein

+0

私は1つのフォローアップの質問があります:このフレームワークでnavbarPageを実装する方法を知っていますか?私の最終アプリには複数の画面が必要です。私がそれを試してみると、私のtabPanelsは間違った方法で開きます。 tabsetPanelではなく空白の画面で開きます。 – Marjolein

+0

再現可能な例を作成できますか?私はあなたの質問を正しく理解しているとは思わない。 – SBista

関連する問題