本文介绍了R Shiny:隔离动态选项卡中的动态输出的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在尝试创建一个应用，您可以在边栏中选择某些输入，当您单击按钮时，它将在单独的选项卡中显示结果.我创建了一个小示例，您可以在下面使用它.
I am trying to create an app where you choose certain inputs in the sidebar, and when you click on a button it will show the results in a separate tab. I created a tiny example that you can use below.
在此示例中，您在侧边栏中选择4个字母，如果单击该按钮，它将动态创建一个单独的带有文本输出的选项卡.但是，当您更改字母并再次单击该按钮时，所有以前的选项卡将更新为新结果.我想在每个选项卡中隔离结果，但是我不知道该怎么做.我尝试通过使用不同的输出名称(请参见服务器中的变量summaryname)来执行此操作，但是它不起作用.
In this example, you choose 4 letters in the sidebar and if you click on the button, it dynamically creates a separate tab with text output. However, when you change the letters and click on the button again, all previous tabs will update with the new results. I'd like to isolate the result in each tab but I don't know how to do that. I tried to do this by using different output names (see variable summaryname in the server) but it doesn't work.
此示例仅使用文本输出，但是我的真实应用程序还使用表格和绘图.
This example only uses text output, but my real app also uses tables and plots.
我将不胜感激！
用户界面:
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，但是为了防止万一，我包括了服务器.
I'm experiencing problems now when I try to get a navbarPage layout around the code. Somehow, the results of the dynamic tabs get displayed wrong (and again not isolated properly). I only changed the ui, but I included the server just in case.
用户界面:
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
# 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")
})
}
推荐答案
Modifying the code given in the link with the code you provided I was able to produce the desired result.
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)
希望这会有所帮助！
这篇关于R Shiny:隔离动态选项卡中的动态输出的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！