闪亮：带有模块的 insertTab

Question

我正在尝试在模块中插入动态调用insertTab() 函数的选项卡。出于某种原因，我的方法不起作用。我想问题是我如何将tabsetPanel id 和现有tabPanel 的value （旁边应该添加tab）传递给模块。

actionButUI = function(id, label=NULL) {
  ns = NS(id)
  tagList(
    actionButton(ns("button"), label = label)  
  )
}

actionBut = function(input, output, session, tabsetPanel_id, target) {
  observeEvent(input$button, {
    insertTab(
      inputId = tabsetPanel_id(), 
      tabPanel(
        "Dynamic", "This a dynamically-added tab"
      ),
      target = target
    )
  })
}




ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      actionButUI("append_tab", "Insert Tab")
    ),
    mainPanel(
      tabsetPanel(id = "tabs",
                  tabPanel("Hello", "This is the hello tab"),
                  tabPanel("Bar", "This is the bar tab")
      )
    )
  )
)
server <- function(input, output, session) {
  callModule(actionBut, "append_tab", reactive({input$tabs}), "Bar")
}

shinyApp(ui, server)

Answer 1

名称空间似乎存在问题。以下修改解决了这个问题

tabsetPanel(id = "append_tab-tabs",
            tabPanel("Hello", "This is the hello tab"),
            tabPanel("Bar", "This is the bar tab"))

insertTab 函数尝试在模块命名空间中添加一个 ui 元素，而不是全局元素。如果您查看insertTab 的源代码，您会看到这一行

inputId <- session$ns(inputId)

导致这种行为的原因。

另一种方法是将session 变量从主应用程序传递给insetTab，而不是模块的session。

actionBut = function(input, output, session, tabsetPanel_id = "tabs", target) {
  ## do some environment hacking: Get the `session` variabe from the
  ## environment that invoked `callModule`.
  parentSession <- get("session", envir = parent.frame(2))

  observeEvent(input$button, {
    insertTab(
      inputId = tabsetPanel_id, 
      tabPanel(
        "Dynamic", "This a dynamically-added tab"
      ),
      target = target,
      session = parentSession
    )
  })
}

但是，如果您使用嵌套模块，这种方法可能会变得非常混乱。

Answer 2

InsertTab 函数的替代方案，您可以按照 Ramnath 解决方案here。

我已经把它做成了模块。

library(shiny)

#---- Module Add dynamic tab ---
SidebarUi <- function(id) {
  ns <- NS(id)
  uiOutput(ns("sidebar"))
}

MainpanelUi <- function(id) {
  ns <- NS(id)
  uiOutput(ns("mainpanel"))
}
DynamicTabserver <- function(input, output, session) {
  ns <- session$ns
  output$sidebar <- renderUI({
    actionButton(ns("nTabs"), label = "Add tab")
  })
  output$mainpanel <- renderUI({
    uiOutput(ns('mytabs'))
  })

  output$mytabs <- renderUI({
    nTabs = input$nTabs
    myTabs = lapply(paste('Tab', 0:nTabs), tabPanel)
    do.call(tabsetPanel, myTabs)
  })

}

#---- App.R ---
ui = pageWithSidebar(headerPanel('Dynamic Tabs'),
                     sidebarPanel(SidebarUi("tabdemo")),
                     mainPanel(MainpanelUi("tabdemo")))
server = function(input, output, session) {
  callModule(DynamicTabserver, "tabdemo")
}
shinyApp(ui, server)