walkerke / mapgl

R interface to Mapbox GL JS v3 and Maplibre GL JS
https://walker-data.com/mapgl
Other
91 stars 5 forks source link

Allow updating of layer aesthetics with content from data. #13

Closed RWParsons closed 4 months ago

RWParsons commented 4 months ago

Building off of the example in the map-design vignette: I'd like to be able to update the fill-color of existing polygons.

I'm not sure if this is intended to be the job of set_layout_property() or set_paint_property() but here is an adapted bit of code from the vignette:

library(shiny)
library(bslib)
library(colourpicker)
library(sf)

nc <- st_read(system.file("shape/nc.shp", package="sf"))
nc$var1 <- rnorm(n = nrow(nc))
nc$var2 <- rnorm(n = nrow(nc))

ui <- page_sidebar(
  title = "mapgl with Shiny",
  sidebar = sidebar(
    radioButtons("outcome", "pick outcome var:", choices = c("var1", "var2"), select = "var1")
  ),
  card(
    full_screen = TRUE,
    maplibreOutput("map")
  )
)

server <- function(input, output, session) {
  output$map <- renderMaplibre({
    maplibre(style = carto_style("positron")) |> 
      fit_bounds(nc, animate = FALSE) |> 
      add_fill_layer(id = "nc_data",
                     source = nc,
                     fill_color = interpolate(
                       # I could swap the `coloumn` arg for input$outcome but ofc this means it has to re-render 
                       # the map every time it's updated 👎
                       column = "var1",
                       values = c(-3, 3),
                       stops = c("lightblue", "darkblue"),
                       na_color = "lightgrey"
                     ),
                     fill_opacity = 0.5)
  })

  observeEvent(input$outcome, {
    maplibre_proxy("map") |>
      set_layout_property("nc_data", "fill-color", interpolate(
        column = input$outcome,
        values = c(-3, 3),
        stops = c("lightblue", "darkblue"),
        na_color = "lightgrey"
      ))
  })
}

shinyApp(ui, server)

I'd like to be able to change the outcome variable being visualised in the fill-color of a fill_layer. I'd also like to be able to affect the legend but I see that there is an issue (#10) that may address this.

Thanks!

walkerke commented 4 months ago

Fortunately this is an easy fix! You'll use set_paint_property() inside your observer instead (that's the only change you need to make) and you'll see the desired behavior.

For the legend, right now the behavior of add_legend() is to overwrite the existing legend, rather than add a new one alongside the old one. Try this out:

library(shiny)
library(bslib)
library(colourpicker)
library(sf)
library(mapgl)

nc <- st_read(system.file("shape/nc.shp", package="sf"))
nc$var1 <- rnorm(n = nrow(nc))
nc$var2 <- rnorm(n = nrow(nc))

ui <- page_sidebar(
  title = "mapgl with Shiny",
  sidebar = sidebar(
    radioButtons("outcome", "pick outcome var:", choices = c("var1", "var2"), select = "var1")
  ),
  card(
    full_screen = TRUE,
    maplibreOutput("map")
  )
)

server <- function(input, output, session) {
  output$map <- renderMaplibre({
    maplibre(style = carto_style("positron")) |> 
      fit_bounds(nc, animate = FALSE) |> 
      add_fill_layer(id = "nc_data",
                     source = nc,
                     fill_color = interpolate(
                       column = "var1",
                       values = c(-3, 3),
                       stops = c("lightblue", "darkblue"),
                       na_color = "lightgrey"
                     ),
                     fill_opacity = 0.5) |> 
      add_continuous_legend(
        "Legend",
        values = c(-3, 3),
        colors = c("lightblue", "darkblue")
      )
  })

  observeEvent(input$outcome, {

    if (input$outcome == "var1") {
      colors <- c("lightblue", "darkblue")
    } else {
      colors <- c("lightpink", "maroon")
    }

    maplibre_proxy("map") |>
      set_paint_property("nc_data", "fill-color", interpolate(
        column = input$outcome,
        values = c(-3, 3),
        stops = colors,
        na_color = "lightgrey"
      )) |> 
      add_continuous_legend(
        "Legend",
        values = c(-3, 3),
        colors = colors
      )
  })
}

shinyApp(ui, server)

clear_legend() is forthcoming, but wouldn't be necessary for this case.