set_style() reverts back to original map in shiny

[benmbutler]

Hi Kyle,

I'm looking to update the basemap style using mapboxgl_proxy() and set_style() in a shiny app. The style changes fine, but the map seems to revert back to the original data that was displayed when it was first rendered.

For instance, in the reprex below, if you choose a different polygon and then update the style to "satellite-streets", the polygon and label data will disappear altogether at first, but when changing the style back to "standard" will revert back to the data that was initially provided to renderMapboxgl().

Ideally I'd like set_style() to just change the basemap without affecting any of the data that's loaded:

library(shiny)
library(mapgl)
library(sf)
library(dplyr)

nc <- st_read(system.file("shape/nc.shp", package = "sf"),
              quiet = TRUE)

ui <- fillPage(
  div(
    selectInput(
      "select_polygon",
      label = "Select a polygon",
      choices = unique(nc$NAME)
    ),
    selectInput("style", "Choose Map Style:",
                choices = c("Standard" = "standard", 
                            "Satellite Streets" = "satellite-streets")),
    style = "position: absolute; top: 10px; left: 10px; z-index: 1000;"
  ),
  tagList(
    mapboxglOutput("map", width = "100%", height = "100vh")
  )
)

server <- function(input, output, session) {
  
  output$map <- renderMapboxgl({
    
    initial_data <- nc %>% filter(NAME == "Ashe")
    
    mapboxgl(
      style = mapbox_style("satellite-streets"),
      center = c(-2, 53),
      zoom = 7,
      access_token = app_config$mapbox_key
    ) |>
      add_fill_layer(
        id = "chosen_polygon",
        source = initial_data,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_color = "white",
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) |>
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = initial_data,
        text_field = get_column("NAME"),
        text_size = 24
      ) |>
      fit_bounds(
        nc,
        padding = 50,
        animate = TRUE
      )
    
  })
  
  observeEvent(input$select_polygon, {
    
    hold <- nc %>% filter(NAME == input$select_polygon)
    
    mapboxgl_proxy("map") |>
      clear_layer("chosen_polygon") |>
      clear_layer("chosen_polygon_label") |>
      add_fill_layer(
        id = "chosen_polygon",
        source = hold,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_color = "white",
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) |>
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = hold,
        text_field = get_column("NAME"),
        text_size = 24
      ) |>
      fit_bounds(
        nc,
        padding = 50,
        animate = TRUE
      )
    
  })
  
  observeEvent(input$style, {
    mapboxgl_proxy("map") %>%
      set_style(mapbox_style(input$style))
  })
  
}  

runApp(shinyApp(ui, server))

I'm using the dev version of mapgl that I downloaded yesterday. Any solution would be much appreciated! Thanks in advance!

[walkerke]

Hi Ben! Yes, this is a limitation of Mapbox GL JS and MapLibre's setStyle() method that we'll need to find a way to work around.

Here's a discussion: https://docs.mapbox.com/mapbox-gl-js/example/style-switch/

I thought I could handle this on the Shiny side but I haven't found a solution yet. I may need to implement internally in the package, where set_style() detects everything that is currently on the map and holds onto it.

[benmbutler]

Hi Kyle, thanks for that explanation! That's not a problem then, I can come up with a workaround to make sure that the right data is shown when changing the style.

One thing that might help me solve this is being able to initialize the map in a very basic form without any data, and then update it immediately during the initialization of the app using mapboxgl_proxy.

At the moment I can't get the proxy to work on initialization, see example below where the proxy codes seems to get run but it does not affect the map.

library(shiny)
library(mapgl)
library(sf)
library(dplyr)

nc <- st_read(system.file("shape/nc.shp", package = "sf"),
              quiet = TRUE)

ui <- fillPage(
  div(
    selectInput(
      "select_polygon",
      label = "Select a polygon",
      choices = unique(nc$NAME)
    ),
    style = "position: absolute; top: 10px; left: 10px; z-index: 1000;"
  ),
  tagList(
    mapboxglOutput("map", width = "100%", height = "100vh")
  )
)

server <- function(input, output, session) {
  
  mapbox_rendered <- reactiveVal(FALSE)
  
  observeEvent(input$select_polygon, {
    
    if (isFALSE(mapbox_rendered())) {
      
      print("Rendering map")
      output$map <- renderMapboxgl({

        mapboxgl(
          style = mapbox_style("standard")
        )
        
      })
      
      print("Map rendered")
      mapbox_rendered(TRUE)
      
    }
    
  })
  
  observeEvent(mapbox_rendered(), {
    req(isTRUE(mapbox_rendered()))
    
    print("Updating map using proxy")
    
    hold <- nc %>% filter(NAME == input$select_polygon)
    
    mapboxgl_proxy("map") |>
      add_fill_layer(
        id = "chosen_polygon",
        source = hold,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_color = "white",
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) |>
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = hold,
        text_field = get_column("NAME"),
        text_size = 24
      ) |>
      fit_bounds(
        nc,
        padding = 50,
        animate = TRUE
      )
    
    print("Map updated")
    
  })
  
}  

runApp(shinyApp(ui, server))

Have you got a workaround for this by any chance?

[benmbutler]

I had another crack at this today and have come up with a solution that seems to work.

Initialisation and changing input$select_polygon:

1. output$map is rendered
2. On render of the map, the onRender() function is used to create/set input$mapbox_rendered to TRUE
3. On input$mapbox_rendered = TRUE, the input$select_polygon is updated
4. On updating input$select_polygon, mapboxgl_proxy() is used to update the map with the selected data and fit the map to its bounds.

Changing input$select_style:

1. The output$map is re-rendered with the selected style, and is fit to the bounds of the previous map
2. The onRender function is used again to create/set input$mapbox_restyled to TRUE
3. On input$mapbox_restyled = TRUE the previous map layers are passed back to the map
4. runjs() is used to set input$mapbox_restyled back to FALSE so that subsequent changes of style will kick the same chain of events off

A couple of things would be really nice to finish this off. If we could get the bearing and pitch as input values from the map (the same way the zoom and bbox can be retrieved), then the exact map view could be replicated upon changing the style even in cases where the user has changed these. I might have a crack at this in a PR soon if that sounds like it's worth doing?

library(shiny)
library(mapgl)
library(sf)
library(dplyr)
library(htmlwidgets)
library(shinyjs)

nc <- st_read(system.file("shape/nc.shp", package = "sf"),
              quiet = TRUE)

ui <- fillPage(
  shinyjs::useShinyjs(),
  div(
    selectInput(
      "select_polygon",
      label = "Select a polygon",
      choices = c()
    ),
    selectInput("select_style", "Choose Map Style:",
                choices = c("Standard" = "standard", 
                            "Satellite Streets" = "satellite-streets")),
    style = "position: absolute; top: 10px; left: 10px; z-index: 1000;"
  ),
  tagList(
    mapboxglOutput("map", width = "100%", height = "100vh")
  )
)

server <- function(input, output, session) {
  
  output$map <- renderMapboxgl({
    mapboxgl(style = mapbox_style("standard")) %>%
      onRender(
        "
        function(el, x) {
          Shiny.setInputValue('mapbox_rendered', true);
        }
      "
      )
    
  })
  
  observeEvent(input$mapbox_rendered, {
    req(input$mapbox_rendered)
    
    updateSelectInput(
      session,
      "select_polygon",
      choices = nc$NAME
    )
    
  })
  
  observeEvent(input$select_polygon, {
    
    hold <- nc %>% filter(NAME == input$select_polygon)
    
    mapboxgl_proxy("map") |>
      clear_layer("chosen_polygon") |>
      clear_layer("chosen_polygon_label") |>
      add_fill_layer(
        id = "chosen_polygon",
        source = hold,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) |>
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = hold,
        text_field = get_column("NAME"),
        text_size = 24
      ) |>
      fit_bounds(
        nc,
        padding = 50,
        animate = TRUE
      )
    
    
  }, ignoreInit = TRUE)
  
  observeEvent(input$select_style, {
    
    map_bbox <- st_bbox(unlist(input$map_bbox), crs = 4326) %>% 
      st_as_sfc() %>% st_as_sf()
    
    output$map <- renderMapboxgl({
      mapboxgl(style = mapbox_style(input$select_style)) %>%
        fit_bounds(
          map_bbox,
          padding = 0,
          animate = FALSE
        ) %>%
        onRender(
          "
        function(el, x) {
          Shiny.setInputValue('mapbox_restyled', true);
        }
      "
        )
      
    })
    
  }, ignoreInit = TRUE)
  
  observeEvent(input$mapbox_restyled, {
    req(input$mapbox_restyled)
    
    hold <- nc %>% filter(NAME == input$select_polygon)
    
    mapboxgl_proxy("map") |>
      clear_layer("chosen_polygon") |>
      clear_layer("chosen_polygon_label") |>
      add_fill_layer(
        id = "chosen_polygon",
        source = hold,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) |>
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = hold,
        text_field = get_column("NAME"),
        text_size = 24
      )
    
    shinyjs::runjs("Shiny.setInputValue('mapbox_restyled', false);")
    
  })
  
}  

runApp(shinyApp(ui, server))

[walkerke]

Thank you!

I do think we should handle this internally for users so you don't have to jump through all those hoops. Basically, when set_style() is called in a proxy session, mapgl should retrieve all user-added layers along with their styles and re-add them to the map. I'll spend some time thinking through this.

[walkerke]

I've got this fixed! Here's a working implementation:

library(shiny)
library(mapgl)
library(sf)
library(dplyr)

nc <- st_read(system.file("shape/nc.shp", package = "sf"),
              quiet = TRUE)

ui <- fillPage(
  div(
    selectInput(
      "select_polygon",
      label = "Select a polygon",
      choices = unique(nc$NAME),
      selected = "Ashe"  # Set initial selection explicitly
    ),
    selectInput("style", "Choose Map Style:",
                choices = c("Standard" = "standard",
                            "Satellite Streets" = "satellite-streets")),
    style = "position: absolute; top: 10px; left: 10px; z-index: 1000;"
  ),
  tagList(
    mapboxglOutput("map", width = "100%", height = "100vh")
  )
)

server <- function(input, output, session) {
  
  add_polygon_layers <- function(map, data) {
    map %>%
      add_fill_layer(
        id = "chosen_polygon",
        source = data,
        fill_opacity = 1,
        fill_color = "red",
        fill_outline_color = "black",
        hover_options = list(
          fill_color = "white",
          fill_opacity = 0.5,
          fill_outline_color = "yellow"
        )
      ) %>%
      add_symbol_layer(
        id = "chosen_polygon_label",
        source = data,
        text_field = get_column("NAME"),
        text_size = 24
      )
  }
  
  output$map <- renderMapboxgl({
    initial_data <- filter(nc, NAME == input$select_polygon)
    
    mapboxgl(
      style = mapbox_style("standard"),
      bounds = nc
    ) %>%
      add_polygon_layers(initial_data) 
  })
  
  observeEvent(input$select_polygon, {
    hold <- filter(nc, NAME == input$select_polygon)
    
    mapboxgl_proxy("map") %>%
      clear_layer("chosen_polygon") %>%
      clear_layer("chosen_polygon_label") %>%
      add_polygon_layers(hold) %>%
      fit_bounds(
        nc,
        padding = 50,
        animate = TRUE
      )
  })
  
  observeEvent(input$style, {
    mapboxgl_proxy("map") %>%
      set_style(mapbox_style(input$style))
  })
}

runApp(shinyApp(ui, server))

We'd want to optimize this app a bit more with set_filter() as we have a reactive element inside renderMapboxgl() which means the map will redraw each time the input is changed. But basemap switchers are now possible in the package!