r - 在弹出窗口或 modalDialog 中显示一个 tabPanel

Question

我需要一些帮助，我想使用 shinyBS 包在弹出窗口中显示我的响应式(Reactive) 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)