带有嵌套模块的 bs4Dash 中不显示闪亮的输出元素

Question

编辑：bs4Dash 软件包的作者 David Granjon 最近对下面引用的 Github 问题中提出的问题提供了答案并将其关闭。

我的问题很可能与 this issue in bs4Dash github repo 有关，但那里没有提供答案。
完整的可重现代码在问题的最后

我的目标

我正在制作一个模块化的 Shiny 应用程序，并试图使用 bs4Dash 包来完成它。这是应用程序的样子：

图片1

最终应用程序有几个部分（我只为这个例子做了介绍），每个部分至少包含一个 bs4TabCard。上图中的 tabcard 有一个 uiOutput 和一个 rhandsontableOutput 元素，它们在服务器函数中呈现。请注意，这些都是 ***Output 元素。在 Picture 1 的可重现代码中（您可以在问题末尾找到），我没有使用任何模块。但是，我的目标是使用多个模块，因为应用程序有可能变得相当大。对于这个简单的示例，我尝试使用两个模块：一个模块用于每个部分（即每个 bs4TabItem），一个模块用于每个标签卡。这意味着这两个模块将不可避免地嵌套：tabcard 模块将位于 section 模块内。

图片2

问题

问题是当我实现模块时，***Output 元素没有显示：

图3

令人惊讶的是显示了 ***Input 个元素。我制作了仅包含 numericInput 的第三个模块，并将其放在选项卡的第二个选项卡中。下图显示numericInput没有问题：

图4

我做作业了

在此issue中报告了类似的问题，但没有提供任何解决方案，我的挖掘也没有成功。 bs4Dash.

中的几个嵌套容器深处放置输出元素时似乎有问题

可重现的代码

图片 1 的可重现代码

library(shiny)
library(bs4Dash)
library(rhandsontable)

shiny::shinyApp(
  ui = bs4DashPage(
    old_school = FALSE,
    sidebar_min = TRUE,
    sidebar_collapsed = FALSE,
    controlbar_collapsed = FALSE,
    controlbar_overlay = TRUE,
    title = "Basic Dashboard",
    navbar = bs4DashNavbar(),
    sidebar = bs4DashSidebar(

      sidebarMenu(
        bs4Dash::menuItem(
          text = "Introduction",
          tabName = "tab-introduction",
          icon = ""
        )
      )

    ),
    controlbar = bs4DashControlbar(),
    footer = bs4DashFooter(),
    body = bs4DashBody(

      bs4TabItems(

        bs4TabItem(
          tabName = "tab-introduction",

          bs4TabCard(
            id = "tabcard", title = "Tab Card", side = "right",

            bs4TabPanel(
              tabName = "Tab 1",
              uiOutput("ui"),
              rHandsontableOutput("hot")
            ),

            bs4TabPanel(
              tabName = "Tab 2",
              p("Hey")
            )
          )
        )
      )
    )
  ),
  server = function(input, output) {
    output$hot <- renderRHandsontable({ rhandsontable(mtcars[1:10, 1:3]) })
    output$ui <- renderUI({
      numericInput("num_ui", label = "Num In", value = 15)
    })
  }
)

图 3 和图 4 的可重现代码

library(shiny)
library(bs4Dash)
library(rhandsontable)

# Tabcard module ----------------------------------------------------------

mod_tabcard_ui <- function(id){
  ns <- NS(id)

  bs4TabCard(
    id = ns("tabcard"), title = "Tab Card", side = "right",

    bs4TabPanel(
      tabName = "Tab 1",
      uiOutput(ns("ui")),
      rHandsontableOutput(ns("hot"))
    ),

    bs4TabPanel(
      tabName = "Tab 2",
      mod_numinput_ui(ns("num"))
    )
  )

}

mod_tabcard_server <- function(input, output, session){

  output$hot <- renderRHandsontable({ rhandsontable(mtcars[1:10, 1:3]) })

  output$ui <- renderUI({
    numericInput(session$ns("num_ui"), label = "Num In", value = 15)
  })

  callModule(mod_numinput_server, "num")

}


# Numeric input module ----------------------------------------------------

mod_numinput_ui <- function(id){
  ns <- NS(id)
  numericInput(ns("num"), "Num In", 0, 0, 10)
}

mod_numinput_server <- function(input, output, server){
  return(reactive({input$num}))
}


# Section module ----------------------------------------------------------

mod_section_ui <- function(id){
  ns <- NS(id)

  mod_tabcard_ui(id = "tabcard")

}

mod_section_server <- function(input, output, session){
  callModule(mod_tabcard_server, id = "tabcard")
}


# The app -----------------------------------------------------------------

shiny::shinyApp(
  ui = bs4DashPage(
    old_school = FALSE,
    sidebar_min = TRUE,
    sidebar_collapsed = FALSE,
    controlbar_collapsed = FALSE,
    controlbar_overlay = TRUE,
    title = "Basic Dashboard",
    navbar = bs4DashNavbar(),
    sidebar = bs4DashSidebar(

      sidebarMenu(
        bs4Dash::menuItem(
          text = "Introduction",
          tabName = "tab-introduction",
          icon = ""
        )
      )

    ),
    controlbar = bs4DashControlbar(),
    footer = bs4DashFooter(),
    body = bs4DashBody(

      bs4TabItems(

        bs4TabItem(
          tabName = "tab-introduction",
          mod_section_ui(id = "mod")
        )
      )
    )
  ),

  server = function(input, output) {
    callModule(mod_section_server, id = "mod")
  }
)

Answer 1

您在 mod_section_ui 模块中缺少命名空间。应该是：

mod_section_ui <- function(id){
  ns <- NS(id)
  mod_tabcard_ui(id = ns("tabcard"))
}

带有嵌套模块的 bs4Dash 中不显示闪亮的输出元素

Shiny output elements not displaying in bs4Dash with nested modules

nested

shiny

shinymodules

bs4dash

我的目标

问题

我做作业了

可重现的代码