Shiny Dashboard with Modules reactiveness

1.2k views Asked by At

Hi I am bit stuck on a Shiny dashboard where I tried to strip out some functionality into ui (and server) modules and sub-modules. What I want to achieve is this

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]
    })
  }
))

embedded in a Shinydashbaord with modules (based on a golem skeleton) so far via this ...

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", names(mtcars), multiple = TRUE)
    )
    , 
    shinydashboard::box(
    title = "Data Viewer",
    width = 10,
    DT::dataTableOutput(ns('data_table'))
    )
  )
}
#---------------------------------
#module server
mod_test_server <- function(input, output, session) {
  ns <- session$ns
  output[['data_table']] <- renderDataTable({
    #output$data_table <- renderDataTable({
    columns = names(mtcars)
    if (!is.null(input$select)) {
      columns = input$select
    }
    mtcars[,columns,drop=FALSE]
  }, filter = 'top')
}
####################################################################
run_app <- function(...) {
  shiny::shinyApp(
    ui = app_ui, 
    server = app_server)
}
#---------------------------------
run_app()

The above is the problem boiled down to minimum lines of code, so that it gets stuck at the same point I am now. The module version will just not update (filter) on the selected data columns, like the first example does, no matter what I try. I am quite sure that I have just not gotten a grip on that namespacing context correctly (especially on the server side). I guess/hope that someone will spot my mistake easily.

1

There are 1 answers

0
GWD On BEST ANSWER

As @SmokeShakers pointed out there was a mistake in

# 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'))
    )
  )
}

selectInput("select", ... in code line 6 should be selectInput(ns("select"), ... and then eveything runs smoothly.