r shiny shiny-reactivity r-leaflet shinymodules

Shiny module for leaflet is not responding

I am translating a shiny app I have developed some years ago to use shiny modules. It is a very long and complex shiny app, but the module I need to build selects from a spatVect shapefile some countries, and does 2 things:

It updates a leaflet, in order to show the selected countries, and
it saves the resulting spatvect from terra in a reactive value called rvs

Here you can see it working in the shiny without the module:

Before the selection:

After the selection:

as you see this works fine in the app without the module but it does not work with the module

What I did

Based on several questions such as this one, I have tried to generate a shiny module and a minimal example for the shiny app, one of the changes that seems to be important is to make the map into a shinyproxy object:

here is the moduleUI:

# Define UI function for country selection module
CountryMapModuleUI <- function(id) {
  ns <- NS(id)
  shiny::conditionalPanel(
    condition = "input.extent_type == 'map_country'", ns("extent_type"),
    shiny::selectInput(ns("ext_name_country"), "Enter country name(s)",
                       choices = c("Afghanistan", "Albania", "Algeria", "American Samoa", "Andorra", "Angola", "Anguilla", "Canada", "Zimbabwe"),
                       multiple = TRUE, selected = NULL)
  )
}

and the server module:

# Define server function for country selection module
CountryMapModuleServer <- function(id, map, world_sf, rvs) {
  moduleServer(
    id,
    function(input, output, session) {
      observe({
        if (!is.null(input$extent_type) && input$extent_type == "map_country") {
          # Country names manually added - subset layer to overlay
          selected_countries <- world_sf[world_sf$country %in% input$ext_name_country,]
          
          map_proxy %>%
            clearGroup("draw") %>%
            clearGroup("bbox") %>%
            clearGroup("biomes") %>%
            clearGroup("biomesSel") %>%
            clearGroup("ecorregions") %>%
            clearGroup("ecorregionsSel") %>%
            clearGroup("countrySel") %>%
            hideGroup("biomes") %>%
            hideGroup("biomesSel") %>%
            hideGroup("bbox") %>%
            hideGroup("ecorregions") %>%
            hideGroup("ecorregionsSel") %>%
            showGroup("countrySel") %>%
            showGroup("country") %>%
            addPolygons(data = sf::st_as_sf(world_sf),
                        group = "country",
                        weight = 1,
                        fillOpacity = 0,
                        opacity = 0.5,
                        color = "#595959") %>%
            addPolygons(data = sf::st_as_sf(selected_countries),
                        group = "countrySel",
                        weight = 1,
                        fillColor = "#8e113f",
                        fillOpacity = 0.4,
                        color = "#561a44")
          
          rvs$polySelXY <- selected_countries
          
          ### Get coordinates for later use to crop and mask GCM rasters
          req(input$map_draw_new_feature)
          coords <- unlist(input$map_draw_new_feature$geometry$coordinates)
          xy <- matrix(c(coords[c(TRUE, FALSE)], coords[c(FALSE, TRUE)]), ncol = 2) %>%
            unique %>%
            terra::ext()
          
          selected_countries <- selected_countries %>%
            terra::crop(xy)
          
          rvs$saved_bbox <- c(xmin(xy), xmax(xy), ymin(xy), ymax(xy))
          rvs$polySelXY <- selected_countries
        }
      })
    }
  )
}

For the app you would need the World_map.shp that is here:

Finally a small shiny app that can use this:

# Load required libraries
library(shiny)
library(leaflet)
library(leaflet.extras)
library(sf)
library(terra)

# Read the world map shapefile
world_sf <- terra::vect("data/world_map.shp")

# Define the UI for the main app
ui <- fluidPage(
  titlePanel("Country Selection App"),
  CountryMapModuleUI("country_map_module"),
  radioButtons(
    inputId = "extent_type",
    label = NULL,
    choices = c(
      "Select drawing a rectangle over the map" = "map_draw",
      "Select by country/countries" = "map_country",
      "Select by biome(s)" = "map_biomes",
      "Select by ecorregion(s)" = "map_ecorregions",
      "Enter bounding-box coordinates" = "map_bbox"
    )),
  leafletOutput("map"),
  textOutput("Text")
)

# Define the server for the main app
server <- function(input, output, session) {
  rvs <- reactiveValues()
  rvs$polySelXY <- NULL
  rvs$saved_bbox <- NULL
  # Create a leaflet map
  m <- leaflet(sf::st_as_sf(world_sf)) %>% 
    addTiles() %>%
    addProviderTiles("Esri.WorldPhysical", group = "Relieve") %>%
    addTiles(options = providerTileOptions(noWrap = TRUE), group = "Countries") %>%
    addLayersControl(baseGroups = c("Relieve", "Countries"),
                     options = layersControlOptions(collapsed = FALSE)) %>% 
    setView(0,0, zoom = 2) %>% 
    leaflet.extras::addDrawToolbar(targetGroup = 'draw', 
                                   singleFeature = TRUE,
                                   rectangleOptions = filterNULL(list(
                                     shapeOptions = drawShapeOptions(fillColor = "#8e113f",
                                                                     color = "#595959"))),
                                   polylineOptions = FALSE, polygonOptions = FALSE, circleOptions = FALSE, 
                                   circleMarkerOptions = FALSE, markerOptions = FALSE)
  output$map <- renderLeaflet(m)
  
  # Create map proxy to make further changes to existing map
  map_proxy <- reactive(leafletProxy("map"))
  
  CountryMapModuleServer("country_map_module", map_proxy, world_sf, rvs)
  
  output$Text <- renderText({
    # Fix 2: Access the 'country' column directly from rvs$polySelXY
    if (!is.null(rvs$polySelXY)) {
      paste("Selected countries:", paste(rvs$polySelXY$country, collapse = ", "))
    } else {
      "No countries selected"
    }
  })
}

# Run the Shiny app
shinyApp(ui, server)

however this does result in no update in the map or the text as seen here:

I cant figure out whats wrong, but I would expect the selected country to be colored and the selected countries to be shown in the textOutput as well, bonus points if you can make the leaflet zoom into the selected countries

Solution

If you pass input$extent_type from the server to the module it works. Try this

# Define UI function for country selection module
CountryMapModuleUI <- function(id) {
  ns <- NS(id)
  shiny::conditionalPanel(
    condition = "input.extent_type == 'map_country'", ns("extent_type"),
    shiny::selectInput(ns("ext_name_country"), "Enter country name(s)",
                       choices = c("Afghanistan", "Albania", "Algeria", "American Samoa", "Andorra", "Angola", "Anguilla", "Canada", "Zimbabwe"),
                       multiple = TRUE, selected = NULL)
  )
}

# Define server function for country selection module
CountryMapModuleServer <- function(id, map, world_sf,extent_type, rvs) {
  moduleServer(
    id,
    function(input, output, session) {
      #rvs <- reactiveValues(polySelXY = NULL, saved_bbox = NULL)
      
      observe({
        if (!is.null(extent_type()) && extent_type() == "map_country") {
          # Country names manually added - subset layer to overlay
          selected_countries <- world_sf[world_sf$country %in% input$ext_name_country,]
          
          map() %>%
            clearGroup("draw") %>%
            clearGroup("bbox") %>%
            clearGroup("biomes") %>%
            clearGroup("biomesSel") %>%
            clearGroup("ecorregions") %>%
            clearGroup("ecorregionsSel") %>%
            clearGroup("countrySel") %>%
            hideGroup("biomes") %>%
            hideGroup("biomesSel") %>%
            hideGroup("bbox") %>%
            hideGroup("ecorregions") %>%
            hideGroup("ecorregionsSel") %>%
            showGroup("countrySel") %>%
            showGroup("country") %>%
            addPolygons(data = sf::st_as_sf(world_sf),
                        group = "country",
                        weight = 1,
                        fillOpacity = 0,
                        opacity = 0.5,
                        color = "#595959") %>%
            addPolygons(data = sf::st_as_sf(selected_countries),
                        group = "countrySel",
                        weight = 1,
                        fillColor = "#8e113f",
                        fillOpacity = 0.4,
                        color = "#561a44")
          
          rvs$polySelXY <- selected_countries
          
          ### Get coordinates for later use to crop and mask GCM rasters
          req(input$map_draw_new_feature)
          coords <- unlist(input$map_draw_new_feature$geometry$coordinates)
          xy <- matrix(c(coords[c(TRUE, FALSE)], coords[c(FALSE, TRUE)]), ncol = 2) %>%
            unique %>%
            terra::ext()
          
          selected_countries <- selected_countries %>%
            terra::crop(xy)

          rvs$saved_bbox <- c(xmin(xy), xmax(xy), ymin(xy), ymax(xy))
          rvs$polySelXY <- selected_countries
          return(rvs)
        }
        
      })
    }
  )
}

# Load required libraries
library(shiny)
library(leaflet)
library(leaflet.extras)
library(sf)
library(terra)

# Read the world map shapefile
world_sf <- terra::vect("world_map.shp")

# Define the UI for the main app
ui <- fluidPage(
  titlePanel("Country Selection App"),
  CountryMapModuleUI("country_map_module"),
  radioButtons(
    inputId = "extent_type",
    label = NULL,
    choices = c(
      "Select drawing a rectangle over the map" = "map_draw",
      "Select by country/countries" = "map_country",
      "Select by biome(s)" = "map_biomes",
      "Select by ecorregion(s)" = "map_ecorregions",
      "Enter bounding-box coordinates" = "map_bbox"
    )),
  leafletOutput("map"),
  textOutput("Text")
)

# Define the server for the main app
server <- function(input, output, session) {
  rvs <- reactiveValues()
  rvs$polySelXY <- NULL
  rvs$saved_bbox <- NULL
  
  ex_type <- reactive(input$extent_type)
  
  # Create a leaflet map
  m <- leaflet(sf::st_as_sf(world_sf)) %>% 
    addTiles() %>%
    addProviderTiles("Esri.WorldPhysical", group = "Relieve") %>%
    addTiles(options = providerTileOptions(noWrap = TRUE), group = "Countries") %>%
    addLayersControl(baseGroups = c("Relieve", "Countries"),
                     options = layersControlOptions(collapsed = FALSE)) %>% 
    setView(0,0, zoom = 2) %>% 
    leaflet.extras::addDrawToolbar(targetGroup = 'draw', 
                                   singleFeature = TRUE,
                                   rectangleOptions = filterNULL(list(
                                     shapeOptions = drawShapeOptions(fillColor = "#8e113f",
                                                                     color = "#595959"))),
                                   polylineOptions = FALSE, polygonOptions = FALSE, circleOptions = FALSE, 
                                   circleMarkerOptions = FALSE, markerOptions = FALSE)
  output$map <- renderLeaflet(m)
  
  # Create map proxy to make further changes to existing map
  map_proxy <- reactive(leafletProxy("map"))
  
  CountryMapModuleServer("country_map_module", map_proxy, world_sf,ex_type, rvs)
  
  output$Text <- renderText({
    # Fix 2: Access the 'country' column directly from rvs$polySelXY
    if (!is.null(rvs$polySelXY)) {
      paste("Selected countries:", paste(rvs$polySelXY$country, collapse = ", "))
    } else {
      "No countries selected"
    }
  })
}

# Run the Shiny app
shinyApp(ui, server)