I cant get a shiny module to work as a server . Only works when the server is separated as a separate set of commands

Question

I have a shiny module and I'm having a huge issue getting it to work. I'm trying to create a dashboard with multiple tabs and am exploring modules to reduce the amount of duplication.

I can get the application to work if I hardcode the server explicitly with the code but when I create modules for the server part it doesn't won't work. I would really appreciate any help as I have tried looking everywhere for a workable example, Below is a reproducible example of a proportion of the code that I would like to modulize,

datasetInput <- function(id, Taxhead = NULL) {

   ns <- NS(id)

 

  names <- colnames(mtcars)

 

  if (!is.null(Taxhead)) {

    pattern <- paste0(Taxhead)

    names <-names$name[sapply(names, function(x){ grepl(pattern,x, ignore.case = TRUE)})]  #### filter for a match

  }

  selectInput(ns("dataset"), "Pick a Report", choices = names)

}

 

#### Server 1

#### Collect the data set based on the selection in datasetInput

datasetServer <- function(id) {

  moduleServer(id, function(input, output, session) {

   #### Outputs the data set


  #### reactive(  read.csv(paste0("Data/",input$dataset,".csv")) )

    reactive(  mtcars )

    })}

 

#### Display the variables of interest

selectVarInput <- function(id){

  ns <- NS(id)

  tagList(

  selectInput(ns("var"), "Select grouping Variables", choices = NULL, multiple = TRUE) ,

 

  selectInput(ns("var2"), "Select Measure Variables", choices = NULL, multiple = TRUE)

  )  }

 

##### Server 2

#### Returns the data as a reactive

selectVarServer <- function(id, data) {

 

  find_vars <- function(data, filter) { names(data)}

 

  moduleServer(id, function(input, output, session) {

    observeEvent(data(), {

      updateSelectInput(session, "var", choices = find_vars(data()))

    })

   

    observeEvent(data(), {

      updateSelectInput(session, "var2", choices = find_vars(data()))

    })

   

    reactive(data() %>% group_by(across(all_of(input$var))) %>% summarise(across(all_of(input$var2),sum), n = n()))

  })}

 

 

selectDataVarUI <- function(id, Taxhead =NULL) {

 

  ns <- NS(id)

 

  tagList(

    datasetInput(ns("data"), Taxhead ),

    selectVarInput(ns("var"))

  )}

 

#### Server 3

selectDataVarServer <- function(id) {

  moduleServer(id, function(input, output, session) {

    data <- datasetServer("data")

    var <- selectVarServer("var", data)

    var })}

 

Date_Range_UI <- function(id) {

 

  ns <- NS(id)

  # Sidebar to demonstrate various slider options ----

  tagList(

    # Sidebar with a slider input

    # # Select form input for checking

    radioButtons(ns("Period"),

                 label = "Select Desired Comparison Period",

                 choices = c( "Daily", "Monthly","Yearly"),

                 selected = "Monthly")

    ,

    # Only show this panel if Monthly or Quarterly is selected

    conditionalPanel(

      condition =  "input.Period != 'Yearly'", ns = ns,

      dateRangeInput(ns('dateRange'),

                     label = 'Date range input',

                     start = Sys.Date()-180,

                     end = Sys.Date() ,

                     min = NULL, max = Sys.Date() ,

                     separator = " - ", format = "MM-yyyy",

                     startview = 'year', language = 'en', weekstart = 0,autoclose = TRUE))

    ,

    # Only show this panel if Custom is selected

    conditionalPanel(

      condition = "input.Period == 'Yearly'", ns = ns,

      sliderInput(ns("yearly"), "Years", min = 2000, max = as.integer(format(Sys.Date(),"%Y")), value = c(2008,2021), round = TRUE,step = 1)),

   

    

  ) ### close side bar layout

  ### close fluid page layout

}

 

Date_Range_Server <- function(id ) {

 

  moduleServer(id,

               function(input, output, session) {

                

                 x <- reactive({input$Period})

                

                 return(

                   list(

                   Startdate =  reactive(if(x() == "Yearly") {input$yearly[1]

                   }

                   else if(x() == "Monthly") {

                     as.integer(format(input$dateRange[1],"%Y%m"))

                   }else{

                     as.integer(format(input$dateRange[1],"%Y%m%d"))})

                   ,

                  

                   Enddate = reactive(if(x() == "Yearly") {input$yearly[2]

                   }

                     else if(x() == "Monthly") {

                       as.integer(format(input$dateRange[2],"%Y%m"))

                     }else{

                       as.integer(format(input$dateRange[2],"%Y%m%d"))})

                   ,

                   Choice = reactive(input$Period )))

                

                   })}

###### this won't work!

betting_UI <-   function(id) {
    ns <- NS(id)
    sidebarLayout(
    sidebarPanel(
      Date_Range_UI("data_range"),
      selectDataVarUI(id = "var", Taxhead =NULL)),
    mainPanel(
      tableOutput(ns("table")),
      verbatimTextOutput (ns("test"))
    ))  }
 
Betting_Server <- function(input, output, session) {
                
                                date_range <- Date_Range_Server("data_range")
                
                 output$test <- renderPrint( date_range$Startdate())
                 output$table <- renderTable(var(), width = 40)             
               }
ui <- fluidPage(
  betting_UI("betting")
    )
server <- function(input, output, session) {
Betting_Server("betting")
}
shinyApp(ui, server)**

 
##### this works fine I thought putting the modules into the server would work as above?????

ui <- fluidPage(

  sidebarLayout(

    sidebarPanel(

      Date_Range_UI("data_range"),

      selectDataVarUI(id = "var", Taxhead =NULL)),

    mainPanel(

      tableOutput("table"),

      verbatimTextOutput ("test")

    ))  )

 

#### Server

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

  var <- selectDataVarServer("var")

  date_range <- Date_Range_Server("data_range")

 

  output$test <- renderPrint( date_range$Startdate())

  output$table <- renderTable(var(), width = 40)

 

  } 

shinyApp(ui, server)

Answer 1

You have to use ns() in your module UI

betting_UI <-   function(id) {
  ns <- NS(id)
  sidebarLayout(
    sidebarPanel(
      Date_Range_UI(ns("data_range")),
      selectDataVarUI(id = ns("var"), Taxhead = NULL)
    ),
    mainPanel(tableOutput(ns("table")),
              verbatimTextOutput (ns("test")))
  )
}

You also have to use moduleServer() to create the module server

Betting_Server <- function(id) {
  moduleServer(id,
               function(input, output, session) {
                 var <- selectDataVarServer("var")
                 date_range <- Date_Range_Server("data_range")
                 
                 output$test <- renderPrint(date_range$Startdate())
                 output$table <- renderTable(var(), width = 40)
               })
}