How to update the leaflet map in the selectModUI in a Shiny app?

Question

I would like to update the selectModUI from the mapedit package for different leaflet maps when using Shiny. Below is a working example.

library(tidyverse)
library(shiny)
library(sf)
library(leaflet)
library(mapview)
library(mapedit)
library(DT)
library(viridis)

# Load the sf object
nc <- st_read(system.file("shape/nc.shp", package = "sf"))

# Project transformation
nc <- st_transform(nc, crs = 4326)

# Create a color function for the leaflet map
sid74_pal <- colorBin(palette = viridis(10), domain = nc$SID74, bins = 4)

# Create a leaflet map
sid74_map <- leaflet() %>%
  addTiles(group = "OSM") %>%
  addProviderTiles("CartoDB", group = "CartoDB") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
  addFeatures(nc, 
              color = ~sid74_pal(SID74), 
              label = ~htmltools::htmlEscape(NAME),
              layerId = ~seq_len(length(st_geometry(nc)))) %>%
  addLegend(position = "bottomright", pal = sid74_pal, 
            values = nc$SID74,
            title = "SID74") %>%
  addLayersControl(baseGroups = c("OSM", "CartoDB", "Esri.WorldImagery"))

ui <- fluidPage(
  # Select Module Output
  h3("Map"),
  selectModUI(id = "Sel_Map"),
  # Datatable Output
  h3("Table"),
  dataTableOutput(outputId = "Table")
)

server <- function(input, output) {
  # Create selectMod
  sel <- callModule(selectMod, "Sel_Map", sid74_map)

  # Reactive values
  rv <- reactiveValues(
    selectnum = NULL,
    sub_table = nc %>% 
      st_set_geometry(NULL) %>%
      slice(0)
  )

  # Subset the table based on the selection
  observe({
    # the select module returns a reactive
    gs <- sel()
    # Filter for the county data
    rv$selectnum <- as.numeric(gs[which(gs$selected == TRUE), "id"])

    if (!is.null(rv$selectnum)){
      rv$sub_table <- nc %>% 
        st_set_geometry(NULL) %>%
        slice(rv$selectnum) 
    }
  })

  # Create a datatable
  output$Table <- renderDataTable({
    datatable(rv$sub_table, options = list(scrollX = TRUE))
  })

}

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

The idea is to create a map and users can select or unselect the polygons on the map. Based on the users' selection, a data table output would dynamically show which counties are selected and present the data, as the screenshot shows.

Now I want to add a select input so users can decide which parameter they want to visualize using the app. I feel like I can create some kinds of reactivities or reactive values to store the maps, and then update the Below is an example I created. Notice that compared to Example 1, I created a new leaflet map called sid79_map in Example 2 and add a select input so people can select. However, this strategy is not working. It would be great if someone can point out a direction to go.

library(tidyverse)
library(shiny)
library(sf)
library(leaflet)
library(mapview)
library(mapedit)
library(DT)
library(viridis)

# Load the sf object
nc <- st_read(system.file("shape/nc.shp", package = "sf"))

# Project transformation
nc <- st_transform(nc, crs = 4326)

# Create a color function for the leaflet map
sid74_pal <- colorBin(palette = viridis(10), domain = nc$SID74, bins = 4)
sid79_pal <- colorBin(palette = viridis(10), domain = nc$SID79, bins = 4)

# Create a leaflet map
sid74_map <- leaflet() %>%
  addTiles(group = "OSM") %>%
  addProviderTiles("CartoDB", group = "CartoDB") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
  addFeatures(nc, 
              color = ~sid74_pal(SID74), 
              label = ~htmltools::htmlEscape(NAME),
              layerId = ~seq_len(length(st_geometry(nc)))) %>%
  addLegend(position = "bottomright", pal = sid74_pal, 
            values = nc$SID74,
            title = "SID74") %>%
  addLayersControl(baseGroups = c("OSM", "CartoDB", "Esri.WorldImagery"))

sid79_map <- leaflet() %>%
  addTiles(group = "OSM") %>%
  addProviderTiles("CartoDB", group = "CartoDB") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
  addFeatures(nc, 
              color = ~sid79_pal(SID79), 
              label = ~htmltools::htmlEscape(NAME),
              layerId = ~seq_len(length(st_geometry(nc)))) %>%
  addLegend(position = "bottomright", pal = sid79_pal, 
            values = nc$SID79,
            title = "SID79") %>%
  addLayersControl(baseGroups = c("OSM", "CartoDB", "Esri.WorldImagery"))

ui <- fluidPage(
  # Select input
  selectInput(inputId = "Selection", label = "Select Counties", choices = c("SID74", "SID79"), selected = "SID74"),
  # Select Module Output
  h3("Map"),
  selectModUI(id = "Sel_Map"),
  # Datatable Output
  h3("Table"),
  dataTableOutput(outputId = "Table")
)

server <- function(input, output) {

  # Try to create reactivity based on the select input type, not working
  sel_type <- reactive({
    input$Selection
  })

  leafmap <- reactive({
    if(sel_type() == "SID74"){
      sid74_map
    } else if (sel_type() == "SID79"){
      sid79_map
    }
  })

  # Create selectMod
  sel <- callModule(selectMod, "Sel_Map", leafmap())

  # Reactive values
  rv <- reactiveValues(
    selectnum = NULL,
    sub_table = nc %>% 
      st_set_geometry(NULL) %>%
      slice(0)
  )

  # Subset the table based on the selection
  observe({
    # the select module returns a reactive
    gs <- sel()
    # Filter for the county data
    rv$selectnum <- as.numeric(gs[which(gs$selected == TRUE), "id"])

    if (!is.null(rv$selectnum)){
      rv$sub_table <- nc %>% 
        st_set_geometry(NULL) %>%
        slice(rv$selectnum) 
    }
  })

  # Create a datatable
  output$Table <- renderDataTable({
    datatable(rv$sub_table, options = list(scrollX = TRUE))
  })

}

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

Did check out `leafletProxy` to update your map? Then you only have to create a single map. To check which polygons users clicked you can check `input$yourmapid_shape_click`. — Wilmar van Ommeren, Mar 29 '19 at 14:49
@WilmarvanOmmeren Thanks. I thought about `leafletProxy` but not sure how to use `leafletProxy` to modify `selectMod`. I will further look into this when I have time. — www, Mar 29 '19 at 16:03

RolandASc · Accepted Answer · 2019-04-02T13:45:29.030

The main problem is that your callModule() needs to be inside a reactive context. I have modified your example slightly to fix that, using observeEvent().

See below (I imported dplyr::slice because I wanted to avoid loading the full tidyverse).

Edit: I did some further clean-up and added a custom version of selectMod to address the OP's comment.

library(shiny)
library(sf)
library(leaflet)
library(mapview)
library(mapedit)
library(DT)
library(viridis)

# Load the sf object
nc <- st_read(system.file("shape/nc.shp", package = "sf"))

# Project transformation
nc <- st_transform(nc, crs = 4326)

# Create a color function for the leaflet map
sid74_pal <- colorBin(palette = viridis(10), domain = nc$SID74, bins = 4)
sid79_pal <- colorBin(palette = viridis(10), domain = nc$SID79, bins = 4)

# Create a leaflet map
sid74_map <- leaflet() %>%
  addTiles(group = "OSM") %>%
  addProviderTiles("CartoDB", group = "CartoDB") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
  addFeatures(nc,
              color = ~sid74_pal(SID74),
              label = ~htmltools::htmlEscape(NAME),
              layerId = ~seq_len(length(st_geometry(nc)))) %>%
  addLegend(position = "bottomright", pal = sid74_pal,
            values = nc$SID74,
            title = "SID74") %>%
  addLayersControl(baseGroups = c("OSM", "CartoDB", "Esri.WorldImagery"))

sid79_map <- leaflet() %>%
  addTiles(group = "OSM") %>%
  addProviderTiles("CartoDB", group = "CartoDB") %>%
  addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
  addFeatures(nc,
              color = ~sid79_pal(SID79),
              label = ~htmltools::htmlEscape(NAME),
              layerId = ~seq_len(length(st_geometry(nc)))) %>%
  addLegend(position = "bottomright", pal = sid79_pal,
            values = nc$SID79,
            title = "SID79") %>%
  addLayersControl(baseGroups = c("OSM", "CartoDB", "Esri.WorldImagery"))

selectMod <- function(input, output, session, leafmap,
                      styleFalse = list(fillOpacity = 0.2, weight = 1, opacity = 0.4),
                      styleTrue = list(fillOpacity = 0.7, weight = 3, opacity = 0.7))
{
  print("*** custom selectMod")
  output$map <- leaflet::renderLeaflet({
    mapedit:::add_select_script(leafmap, styleFalse = styleFalse, styleTrue = styleTrue,
                                ns = session$ns(NULL))
  })
  id <- "mapedit"
  select_evt <- paste0(id, "_selected")
  df <- data.frame()
  selections <- reactive({
    id <- as.character(input[[select_evt]]$id)
    if (length(df) == 0) {
      # Initial case, first time module is called.
      # Switching map, i.e. subsequent calls to the module.
      # Note that input[[select_evt]] will always keep the last selection event,
      # regardless of this module being called again.
      df <<- data.frame(id = character(0), selected = logical(0),
                        stringsAsFactors = FALSE)
    } else {
      loc <- which(df$id == id)
      if (length(loc) > 0) {
        df[loc, "selected"] <<- input[[select_evt]]$selected
      } else {
        df[nrow(df) + 1, ] <<- c(id, input[[select_evt]]$selected)
      }
    }
    return(df)
  })
  return(selections)
}


ui <- fluidPage(
  # Select input
  selectInput(inputId = "Selection", label = "Select Counties", choices = c("SID74", "SID79"), selected = "SID74"),
  # Select Module Output
  h3("Map"),
  selectModUI(id = "Sel_Map"),
  # Datatable Output
  h3("Table"),
  dataTableOutput(outputId = "Table")
)

server <- function(input, output) {

  # Reactivity based on the select input type
  leafmap <- reactive({
    my_sel <- input$Selection
    if (my_sel == "SID74") {
      sid74_map
    } else if (my_sel == "SID79") {
      sid79_map
    }
  })

  # Reactive values
  rv <- reactiveValues(
    sel = reactive({}),
    selectnum = NULL,
    sub_table = nc %>%
      st_set_geometry(NULL) %>%
      dplyr::slice(0)
  )

  # Create selectMod
  observeEvent(leafmap(),
    rv$sel <- callModule(selectMod, "Sel_Map", leafmap())
  )

  # Subset the table based on the selection
  observeEvent(rv$sel(), {
    # The select module returns a reactive
    gs <- rv$sel()
    # Filter for the county data
    rv$selectnum <- as.numeric(gs[which(gs$selected == TRUE), "id"])

    rv$sub_table <- nc %>%
      st_set_geometry(NULL) %>%
      dplyr::slice(rv$selectnum)
  })

  # Create a datatable
  output$Table <- renderDataTable({
    datatable(rv$sub_table, options = list(scrollX = TRUE))
  })

}

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

Thanks for your answer. I believe this is a good start and I have given you an upvote. The code you wrote can generate an app that allows me to select the map to visualize. However, if I selected some counties and change the map without de-selected them, it seems like the last counties I selected will still shown in the datatable. It would be great to be able to de-select everything when changing the map to visualize. — www, Apr 01 '19 at 19:33
ok, so this was a bit trickier, because ultimately this behavior is given by the implementation inside `mapedit`. It's difficult to work around from the outside, and in fact, the `selectMod` function looks a bit inconsistent, so you should probably use your own variant. I have added that to my answer. If you manage to get the maintainer of `mapedit` to modify their `selectMod`, that would of course be great as well. Generally speaking, I can see the current behavior of `selectMod` being desirable for other particular cases, too. Maybe an option? — RolandASc, Apr 02 '19 at 13:51
Thanks for the update. This works very well. It is great that you shared your approach on how to design the `selectMod`. I believe it will be useful for others, too. — www, Apr 02 '19 at 14:00
Hello, if SID74 and SID79 were not stored as two distinct variables but as a single one called value how would you create the palette color according to what is selected (wether SID74, or SID78)? — Marcel Campion, Jun 14 '21 at 11:00
Not sure I fully understand your use-case, but sounds like you might want to put the palette creation inside the reactive (?) — RolandASc, Jun 21 '21 at 15:53

How to update the leaflet map in the selectModUI in a Shiny app?

1 Answers1

Linked