带有模块反应性的闪亮仪表板

如何解决带有模块反应性的闪亮仪表板

嗨，我有点呆在Shiny仪表板上，在这里我试图将一些功能剥离到ui（和服务器）模块和子模块中。 我要实现的是这个

library(shiny)
runApp(list(
  ui = basicPage(
    selectInput("select","Select columns to display",names(mtcars),multiple = 
                  TRUE),h2('The mtcars data'),dataTableOutput('mytable')
  ),server = function(input,output) {
    output$mytable = renderDataTable({
      columns = names(mtcars)
      if (!is.null(input$select)) {
        columns = input$select
      }
      mtcars[,columns,drop=FALSE]
    })
  }
))

到目前为止，

通过该模块嵌入了具有模块（基于golem骨架）的Shinydashbaord中。

library(shiny)
library(shinydashboard)
library(shinydashboardplus)
library(DT)

# app_ui 
app_ui <- function(request) {
  tagList(
    shinydashboardplus::dashboardPagePlus(
      header = shinydashboardplus::dashboardHeaderPlus(title = "module_test",enable_rightsidebar = FALSE),sidebar = shinydashboard::dashboardSidebar(
        shinydashboard::sidebarMenu(id = "tabs",mod_test_sidebar_ui("test_ui_1"))
      ),#
      body =  shinydashboard::dashboardBody(shinydashboard::tabItems(
        mod_test_body_ui("test_ui_1"))
      ),rightsidebar = NULL,title = "Testing Shiny modules"
    )
  )
}
# app_server 
app_server <- function(input,output,session) {
  shiny::moduleServer(id = "test_ui_1",module = mod_test_server)
}

##   THE MODULES   #######################################################
# the sidebar module
mod_test_sidebar_ui <- function(id) {
  ns <- NS(id)
  shinydashboard::menuItem("Module Testing",tabName = "tab_testing_mod",icon = icon("th"))
}
#---------------------------------
# the body module b/c wanna use tabs I decided to add one more mod layer 
mod_test_body_ui <- function(id) {
  ns <- NS(id)
  shinydashboard::tabItem(tabName = "tab_testing_mod",mod_test_modules_ui(id)
                          
  )
}
# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    shinydashboard::Box(
      title = "Select Cols",selectInput("select","Select columns",multiple = TRUE)
    ),shinydashboard::Box(
    title = "Data Viewer",width = 10,DT::dataTableOutput(ns('data_table'))
    )
  )
}
#---------------------------------
#module server
mod_test_server <- function(input,session) {
  ns <- session$ns
  output[['data_table']] <- renderDataTable({
    #output$data_table <- renderDataTable({
    columns = names(mtcars)
    if (!is.null(input$select)) {
      columns = input$select
    }
    mtcars[,drop=FALSE]
  },filter = 'top')
}
####################################################################
run_app <- function(...) {
  shiny::shinyApp(
    ui = app_ui,server = app_server)
}
#---------------------------------
run_app()

以上是将问题归结为最少的代码行，因此它陷入了我现在的同一点。无论我如何尝试，模块版本都不会像第一个示例那样更新（过滤）所选数据列。 我非常确定我只是没有正确掌握该命名空间上下文（尤其是在服务器端）。我猜/希望有人会轻易发现我的错误。

解决方法

@SmokeShakers指出存在错误

# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    shinydashboard::box(
      title = "Select Cols",selectInput("select","Select columns",names(mtcars),multiple = TRUE)
    ),shinydashboard::box(
    title = "Data Viewer",width = 10,DT::dataTableOutput(ns('data_table'))
    )
  )
}

代码行6中的

selectInput("select",...应该为selectInput(ns("select"),...，然后传送可以顺利进行。