サイドバーで特定の入力を選択するアプリケーションを作成しようとしています。ボタンをクリックすると、結果が別のタブに表示されます。私はあなたが下で使うことができる小さな例を作りました。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")
})
}
多分[this](https://stackoverflow.com/questions/35020810/dynamically-creating-tabs-with-plots-in-shiny-without-re-creating-existing-tabs/)は役に立ちますか? – SBista
すばらしい提案をありがとう。私はサンプルスクリプトで実装しようとしましたが、残念ながら私はまだ同じ問題を抱えています。私が間違っていることを特定することはできません。 – Marjolein