Dynamically Generate Plots in Conditional Tabs using renderUI in Shiny
Your example isn't exactly minimal so i did some stripping away. First the data and helper functions
library(shiny)
library(ggplot2)
channels = c("Affiliate","Email","Media","SEO")
nObs = c(round(runif(1,100,200)))
myData = data.frame(
Campaign = unlist(lapply(channels, FUN = function(x) paste(x,seq(from=1,to=nObs,by=1),sep=""))),
Channel = rep(channels,nObs),
Return = runif(nObs*length(channels),50,500),
Spend = runif(nObs*length(channels),10,100)
)
plotSingle = function(myData, channelName){
ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
geom_point(color="black") +
theme(panel.background = element_rect(fill = 'grey85'),
panel.grid.major = element_line(colour = "white"))
}
Now the UI
ui <- fluidPage(
headerPanel('Plot Testing'),
mainPanel(
uiOutput('mytabs'),
plotOutput('scatterPlot')
)
)
Note that we only use one plotOutput here. What we will do is just change the plot it's showing based on the currently selected tab. Here's the server code
server = function(input, output) {
rawData <- reactive({
myData
})
output$mytabs = renderUI({
if(is.null(rawData())){return ()}
channels = unique(rawData()$Channel)
myTabs = unname(Map(tabPanel, channels))
do.call(tabsetPanel, c(myTabs, id="channeltab"))
})
output$scatterPlot <- renderPlot({
if(is.null(rawData()) | is.null(input$channeltab)){return ()}
plotSingle(rawData(), input$channeltab)
})
}
You see we set an id on the tabsetPanel we create. We can then use that as input to determine which panel is selected and show the correct plot. All run with
shinyApp(ui = ui, server = server)
R Shiny: Dynamically creating tabs with output within navbarPage()
As I mentioned in the comment of answer there seems to be some problem with the javascript finctionality, after further refering to the HTML structure I figured out that for navbarPage there are two tab-contents. Due to this the javascript was failing so slightly changing the javascript functionality actually seems to work.
You just need to changevar tabContainerTarget = document.getElementsByClassName('tab-content')[0]; to
var tabContainerTarget = document.getElementsByClassName('tab-content')[1];
So your code should work if your ui is changed with the new javascript as follows:
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')[1];
/* 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
)
)
)
)
)
)
R Shiny: Isolate dynamic output within dynamic tabs
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)
Hope this helps!
How do I make dynamic shiny tabs with their own content?
I would like to thank all the good people over at stackoverflow for aiding me in solving this problem; this is the most supportive site for programming beginners out there.
UI:
library(shiny)
shinyUI(navbarPage("TiGr",
tabPanel("File Input Page",
fluidPage("Input")),
tabPanel("Summary Statistics and Plots",
fluidPage("Statistics")),
tabPanel("Time Clusters",
fluidPage("cluster"),
actionButton("subClust", label = "Create Subcluster"),
uiOutput("tabs"),
conditionalPanel(condition="input.level==1",
helpText("test work plz")
),
conditionalPanel(condition="input.level==5",
helpText("hohoho")
)
)
))
Server:
library(shiny)
shinyServer(function(input, output,session) {
output$tabs=renderUI({
Tabs<-as.list(rep(0,input$subClust+1))
for (i in 0:length(Tabs)){
Tabs[i]=lapply(paste("Layer",i,sep=" "),tabPanel,value=i)
}
#Tabs <- lapply(paste("Layer",0:input$subClust,sep=" "), tabPanel)
do.call(tabsetPanel,c(Tabs,id="level"))
})
}
)
R Shiny: Dynamic tabs within multiple navbarPage tabPanels
Honestly, I don't know why your code does not work. However, I would suggest to use a somewhat different approach. If I get you right, with appendTab the following code should exactly produce what you're after.
ui <-
fluidPage(
navbarPage("Shiny",
tabPanel("summary",
sidebarLayout(
sidebarPanel(width = 4,
selectInput(inputId = "choice_1_sum", label = "First choice:",
choices = LETTERS, selected = "H", multiple = FALSE),
selectInput(inputId = "choice_2_sum", label = "Second choice:",
choices = LETTERS, selected = "E", multiple = FALSE),
selectInput(inputId = "choice_3_sum", label = "Third choice:",
choices = LETTERS, selected = "L", multiple = FALSE),
selectInput(inputId = "choice_4_sum", label = "Fourth choice:",
choices = LETTERS, selected = "P", multiple = FALSE),
actionButton("goStat", "Go create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_sum",
tabPanel("InitialPanel1_sum", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_sum"),
uiOutput("creationPool_sum", style = "display: none;")
)
)
)
)
),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(width = 4,
numericInput(inputId = "obs_plot", "Number of observations:", value = 100),
actionButton("goPlot", "Create a new Tab!")
),
mainPanel(
tabsetPanel(id = "mainTabset_plot",
tabPanel("InitialPanel1_plot", "Some text here to show this is InitialPanel1",
textOutput("creationInfo_plot"),
# Important! : 'Freshly baked' tabs first enter here.
uiOutput("creationPool_plot", style = "display: none;")
# End Important
)
)
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$goStat, {
appendTab(inputId = "mainTabset_sum",
select = T,
tabPanel(paste0("newtab", input$goStat), htmlOutput(paste0("text", input$goStat))
)
)
output[[paste0("text", input$goStat)]] <- renderText({
paste("<strong>", "Summary:", "</strong>", "<br>",
"You chose the following letters:", isolate(input$choice_1_sum), isolate(input$choice_2_sum), isolate(input$choice_3_sum), isolate(input$choice_4_sum), "." ,"<br>",
"Thank you for helping me!")
})
})
observeEvent(input$goPlot, {
appendTab(inputId = "mainTabset_plot",
select = T,
tabPanel(paste0("newplot", input$goPlot), plotOutput(paste0("plot", input$goPlot)))
)
output[[paste0("plot", input$goPlot)]] <- renderPlot({
hist(runif(isolate(input$obs_plot)))
})
})
}
shinyApp(ui, server)
Related Topics
Merge and Perfectly Align Histogram and Boxplot Using Ggplot2
Ggplot2: Change Order of Display of a Factor Variable on an Axis
Subsetting Data.Table Using Variables with Same Name as Column
Alignment of Numbers on the Individual Bars
How to Make a List of All Dataframes That Are in My Global Environment
Split Date into Different Columns for Year, Month and Day
Count Values Separated by a Comma in a Character String
Evaluating Both Column Name and the Target Value Within 'J' Expression Within 'Data.Table'
Operator == Inconsistent in Logical Columns in Data.Table
Remove Ids That Occur X Times R
How to Generate All Possible Combinations of Vectors Without Caring for Order
How to Count the Frequency of a String for Each Row in R
Extend Contigency Table with Proportions (Percentages)
Plot Polynomial Regression Curve in R
Rtools Is Not Being Detected from Rstudio
Use Different Center Than the Prime Meridian in Plotting a World Map
Categorize Numeric Variable with Mutate
How to Add Hatches, Stripes or Another Pattern or Texture to a Barplot in Ggplot