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

Question

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

1. 我的问题很可能与github repo中的这个问题bs4Dash有关，但那里没有提供答案。
2. 完整的可重现代码位于问题的末尾

我的目标

我正在制作一个模块化的 Shiny 应用程序，并尝试使用该bs4Dash包来完成它。该应用程序如下所示：

图片1

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

图2

问题

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

图3

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

图4

我做了我的功课

在这个问题中，报告了类似的问题，但没有提供任何解决方案，并且我的挖掘证明不成功。当输出元素被放置在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"))
}