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

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