shiny module inside module loosing reactive value

Question

I am trying to reuse the Filter module code provided in the Mastering Shiny book. It takes a dataframe, generate a "select" widget for each column and return a reactive that output a boolean vector. This vector can be used to filter the dataframe row-wise according to the selected data range from the widgets.

This works as intended when I simply reuse the filter module directly in a ShinyApp. But when I try to use it from inside another module, the returned reactive outputs logical(0) where it should output a vector with length equal to row number of the input dataframe.

Here is a minimal working example based on the code from the book.

library(shiny)
library(purrr)

# Filter module from https://mastering-shiny.org/scaling-modules.html#dynamic-ui

#helper functions
make_ui <- function(x, id, var) {
  if (is.numeric(x)) {
    rng <- range(x, na.rm = TRUE)
    sliderInput(id, var, min = rng[1], max = rng[2], value = rng)
  } else if (is.factor(x)) {
    levs <- levels(x)
    selectInput(id, var, choices = levs, selected = levs, multiple = TRUE)
  } else {
    # Not supported
    NULL
  }
}
filter_var <- function(x, val) {
  if (is.numeric(x)) {
    !is.na(x) & x >= val[1] & x <= val[2]
  } else if (is.factor(x)) {
    x %in% val
  } else {
    # No control, so don't filter
    TRUE
  }
}

#Module
filterUI <- function(id) {
  uiOutput(NS(id, "controls"))
}
filterServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    vars <- reactive(names(df))
    
    output$controls <- renderUI({
      map(vars(), function(var) make_ui(df[[var]], NS(id, var), var))
    })
    
    reactive({
      each_var <- map(vars(), function(var) filter_var(df[[var]], input[[var]]))
      reduce(each_var, `&`)
    })
  })
}

#App
filterApp <- function() {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        textOutput("n"),
        filterUI("filter"),
      ),
      mainPanel(
        verbatimTextOutput("debug"),
        tableOutput("table")    
      )
    )
  )
  server <- function(input, output, session) {
    df <- datasets::ToothGrowth[seq(1,60,5),] #subset rows from ToothGrowth
    filter <- filterServer("filter", df)
    
    output$table <- renderTable(df[filter(), , drop = FALSE])
    output$n <- renderText(paste0(sum(filter()), " rows"))
    output$debug <- renderPrint(filter())
  }
  shinyApp(ui, server)
}

filterApp() #This works !

Then a simple Module to test the filter from inside it :

filterPageUI <- function(id) {
  tagList(
    filterUI(NS(id, "filter"))
  )
}
filterPageServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    filterServer("filter", df = df)
  })
}

And the ShinyApp modification to use this new module :

filterPageApp <- function() {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        textOutput("n"),
        filterPageUI("filterpage"),
      ),
      mainPanel(
        verbatimTextOutput("debug"),
        tableOutput("table")    
      )
    )
  )
  server <- function(input, output, session) {
    #subset rows from ToothGrowth
    df <- datasets::ToothGrowth[seq(1,60,5),]
    filter <- filterPageServer("filterpage", df)
    
    output$table <- renderTable(df[filter(), , drop = FALSE])
    output$n <- renderText(paste0(sum(filter()), " rows"))
    output$debug <- renderPrint(filter())
  }
  shinyApp(ui, server)
}

filterPageApp() #This does not work!

I suspect that the problem comes from namespacing, maybe inside the map/reduce logic. But I cant wrap my head around it. Moreover, the last paragraph from the chapter says that this module should be usable elsewhere without modifications.

A big advantage of using a module here is that it wraps up a bunch of advanced Shiny programming techniques. You can use the filter module without having to understand the dynamic UI and functional programming techniques that make it work.

Any advice would be greatly appreciated. Thanks in advance !

Answer 1

In your filterServer function you have to use session$ns("var") instead of NS(id, "var"). The former will include enclosing namespace whereas the later will only include current namespace. I added two messages that will show in the console what I mean.

filterServer <- function(id, df) {
  moduleServer(id, function(input, output, session) {
    message("session namespace: ", session$ns("test"))
    message("raw namespace: ", NS(id, "test"))
    vars <- reactive(names(df))
    
    output$controls <- renderUI({
      map(vars(), function(var) make_ui(df[[var]], session$ns(var), var))
    })
    
    reactive({
      each_var <- map(vars(), function(var) filter_var(df[[var]], input[[var]]))
      reduce(each_var, `&`)
    })
  })
}