Show a tabPanel in popup window or modalDialog - r

Question

I need some help I want to show my reactive tabPanel in a popup with the shinyBS package.
Everything seems to work well except the creation of popup.
I am inspired by :
1) R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
2)Show dataTableOutput in modal in shiny app
My code :
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE)
),
mainPanel(
uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs = length(input$decision)
# create tabPanel with datatable in it
myTabs = lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
bsModal(
id = "modalExample",
"yb",
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
)
})
shinyApp(ui, server)
Thanks in advance for any help !

Answer 1

bsModal is an UI element, so you need to put it into you UI. Within this modal you want to show the tabPanels (rendered via uiOutput), so all you need to do is to place your bsModal into the UI, and within this bsModal you have your uiOutput. All what is left is to add an actionButton which shows the modal.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your species",
choices = unique(iris$Species),
selected = unique(iris$Species), multiple = TRUE),
actionButton("show", "Show")
),
mainPanel(
bsModal("modalExample",
"myTitle",
"show",
uiOutput('mytabs')
)
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs <- length(input$decision)
# create tabPanel with datatable in it
myTabs <- lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
})
shinyApp(ui, server)

Answer 2

It's not clear to me what you want to do (maybe #thothal has the right answer). What about this app ?
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE),
actionButton("trigger_modal", "View modal")
),
mainPanel(
uiOutput("modal")
# uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
# output$mytabs <- renderUI({
# nTabs = length(input$decision)
# # create tabPanel with datatable in it
# myTabs = lapply(seq_len(nTabs), function(i) {
# tabPanel(paste0("dataset_", input$decision[i]),
# tableOutput(paste0("datatable_",i))
# )
# })
#
# do.call(tabsetPanel, myTabs)
# })
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
output$modal <- renderUI({
bsModal(
id = "modalExample",
"yb",
trigger = "trigger_modal",
do.call(tagList, lapply(seq_along(input$decision), function(i){
tableOutput(paste0("datatable_",i))
}))
)
})
})
shinyApp(ui, server)