Question

我需要一些帮助，我希望使用shinyBS软件包在弹出窗口中显示我的反应式tabPanel。除了创建弹出窗口以外，其他所有内容似乎都运行良好。我的灵感来自：

1）R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)

2）Show dataTableOutput in modal in shiny 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)
    ),
    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)

在此先感谢您的帮助！

Answer 1

bsModal是一个UI元素，因此您需要将其放入UI中。在此模式下，您想显示tabPanels（通过uiOutput渲染），因此您所需要做的就是将bsModal放到UI中，并在此bsModal中您有uiOutput。剩下的就是添加显示模式的actionButton。

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

我不清楚您要做什么（也许@thothal有正确答案）。那这个程序呢？

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)

在弹出窗口或modalDialog中显示tabPanel

2 个答案: