I’m having trouble with observers & modules in a huge app. I created a smaller example.

What I want to do:

1. User makes selections
2. Database call is done based on these selections –> MAIN_DATA (not on the fly)
3. Data is sub-filtered initally by a single radio-buttons –> MAIN_DATA_FILTERED (on the fly)
4. Data is sub-filtered and shown based on the selected tab (each tab has a different type of visualization). –> MAIN_DATA_FILTERED_FILTERED (on the fly)

In one of the visualizations (one of the tabs) I’m using leaflet as a location selector. Initially it goes well: Select an area –> filter the data by this area & show it in a modal.

If I change ANYTHING in my last selections-menu (step 4), however I get reactivity issues. 1 change = 1 modal each click. n changes = n modals popping up, which crashed the system. The problem is caused by a reactivity issue in the last selections module. I located the problem to this module by adding a modal to it. This is what is shown in the example.

Whenever I change this module else goes wrong.

Below is the snippet I created: Whenever I change my TAB it shows the modal. Changing it to an observe doesnt help either. How do I get the extra selections to change when the input$tab changes, but make sure no extra observers are created?

Now: Every change in the tab creates an extra observer, every change in the selections creates an extra observer for the leaflet map etc.

# Load necessary libraries
library(shiny)
library(dplyr)

# Define the UI for the selections module
# This function creates a select input with multiple selection enabled
selectionsUI <- function(id) {
  ns <- NS(id)
  selectInput(ns("variableSelect"), "Choose some:", choices = c("X", "Z"), multiple = TRUE)
}

# Define the server logic for the selections module
# This function returns the selected variables from the select input
selectionsServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive({
      input$variableSelect
    })
  })
}

# Define the UI for the last selections module
# This function creates a button and an output UI element
lastSelectionsUI <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("infoButton"), "INFORMATION BUG"),
    uiOutput(ns("lastSelector"))
  )
}

# Define the server logic for the last selections module
# This function shows a modal when the button is clicked and updates the last filter based on the selected tab
lastSelectionsServer <- function(id, selectionsSnapshot, selectedTab) {
  moduleServer(id, function(input, output, session) {
    lastFilter <- reactiveVal(NULL)
    observeEvent(input$infoButton, {
      showModal(
        modalDialog(
          title = "This is not working??",
          paste0("Selected tab: ", selectedTab)
        )
      )
    })

    output$lastSelector <- renderUI({
      ns <- session$ns
      if (selectedTab == "Y below zero") {
        tagList(
          selectInput(label = "LAST FILTER", ns("filterAgain"), choices = selectionsSnapshot(), multiple = TRUE)
        )
      } else {
        tagList()
      }
    })

    observe({
      lastFilter(input$filterAgain)
      print(lastFilter())
    })

    return(lastFilter)
  })
}

# Define the UI for the test module
# This function creates a layout with two columns and a tabset panel
testUI <- function(id) {
  ns <- NS(id)
  tagList(
    column(2, uiOutput(ns("lastSelections"))),
    column(6, tabsetPanel(
      id = ns("tab"),
      tabPanel("Y above zero", uiOutput("Y_above_zero")),
      tabPanel("Y below zero", uiOutput(ns("Y_below_zero"))),
    ))
  )
}

# Define the server logic for the test module
# This function creates a reactive expression that filters data based on the selected tab and the last filter
testServer <- function(id, data, selectionsSnapshot) {
  moduleServer(id, function(input, output, session) {
    output$lastSelections <- renderUI({
      ns <- session$ns
      lastSelectionsUI(ns("last"))
    })

    lastFilter <- reactiveVal(NULL)
    observeEvent(input$tab, {
      print("working")
      myFilter <- lastSelectionsServer("last", selectionsSnapshot, input$tab)
      lastFilter(myFilter)
    })

    observe({
      print("*****")
      print(lastFilter())
      print("******")
    })

    # Create a reactive expression that filters data based on the selected tab and the last filter
    filteredData <- reactive({
      df <- data()
      if (input$tab == "Y above zero") {
        df <- df[df$Y > 0, ]
      } else if (input$tab == "Y below zero") {
        df <- df[df$Y <= 0, ]
      }

      # Filter based on the last filter
      if (!is.null(lastFilter())) {
        filterValue <- lastFilter()()
        df <- df %>% select(all_of(filterValue))
      }
      df
    })

    # Add an action button to the UI for each tab
    output$Y_above_zero <- renderUI({
      if (input$tab == "Y above zero") {
        actionButton(ns("showDataAbove"), "Show Data")
      }
    })

    output$Y_below_zero <- renderUI({
      if (input$tab == "Y below zero") {
        ns <- session$ns
        actionButton(ns("showDataBelow"), "Show Data")
      }
    })

    # Show the filtered data in a modal when the button is clicked
    observeEvent(input$showDataAbove, {
      showModal(modalDialog(
        title = "Data where Y is above zero",
        renderTable(filteredData())
      ))
    })

    observeEvent(input$showDataBelow, {
      showModal(modalDialog(
        title = "Data where Y is below zero",
        renderTable(filteredData())
      ))
    })
  })
}

# Define the main page UI
# This function creates a layout with a main filter, an intermediate filter, and a test module
mainPageUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    h1("Main filter"),
    selectionsUI(ns("selections")),
    actionButton(ns("getData"), "Get data from database"),
    tags$hr(),
    tags$br(),
    h1("Intermediate on-the-fly filter"),
    radioButtons(ns("testFilter"), "Filter data", choices = c("X Above zero", "X Below zero")),
    tags$hr(),
    tags$br(),
    wellPanel(fluidRow(testUI(ns("test"))))
  )
}

# Define the main page server
# This function gets data from a database and starts the test server when the test filter is changed
mainPageServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    selections <- selectionsServer("selections")

    observeEvent(input$getData, {
      req(selections)
      print("Getting data from database")
      # Save a snapshot of the selections
      selectionsSnapshot <- reactiveVal(selections())

      # Get some data from a database
      data <- reactive({
        data.frame(X = rnorm(10), Y = rnorm(10), Z = rnorm(10))
      })
      print("Got data from database")
      observeEvent(input$testFilter, {
        # Filter the initial data on the fly
        filteredData <- reactive({
          if (input$testFilter == "X Above zero") {
            data()[data()$X > 0, ]
          } else {
            data()[data()$X <= 0, ]
          }
        })

        # Start the test server inside of this observeEvent
        testServer("test", filteredData, selectionsSnapshot)
      })
    })
  })
}

# Define the shiny server
server <- shinyServer(function(global, input, output, session) {
  observe({
    mainPageServer(("main_page"))
  })
})

# Define the shiny UI
ui <- fluidPage(mainPageUI("main_page"))

# Run the application
shinyApp(ui = ui, server = server)