Add `add_tooltip()` function for attaching tooltips to map layers

[danielvartan]

Related to #180.

Sometimes the data you want to show in a tooltip is not available in the tile properties. I'd like to propose an add_tooltip() function that accepts a lookup vector and matches its values against a tile property to display the appropriate tooltip on hover.

Reproducible Example

See this example at https://github.com/danielvartan/test/tree/mapgl-1.

In this example, I use a PMTiles code_state property to match against a lookup vector of tooltips.

Set Environment

Load Packages

library(checkmate)
library(htmlwidgets)
library(mapgl)
library(orbis) # github.com/danielvartan/orbis
library(pmtiles) # github.com/walkerke/pmtiles
library(purrr)
library(tibble)
library(viridis)

Load Custom Functions

This is just a workaround to show what I mean.

library(checkmate)
library(htmlwidgets)

add_tooltip <- function(map, layer_id, lookup) {
  assert_class(map, "maplibregl")
  assert_string(layer_id)
  assert_atomic_vector(lookup)

  map |>
    onRender(
      "
      function(el, x, data) {
        const map = el.map || this;
        const layerId = data.layer_id;
        const lookup = data.lookup || {};

        if (!map || typeof map.on !== 'function') {
          return;
        }

        const popup = new maplibregl.Popup({
          closeButton: false,
          closeOnClick: false,
          maxWidth: '400px'
      });

      function resolveId(props) {
        if (!props) return null;

        const candidates = [
          props.id,
          props.ID
        ];

        for (const value of candidates) {
          if (value !== undefined && value !== null) {
            const key = String(value);
            if (lookup[key] !== undefined) return key;
          }
        }

        for (const value of Object.values(props)) {
          if (value === undefined || value === null) continue;
          const key = String(value);
          if (lookup[key] !== undefined) return key;
        }

        return null;
      }

      function onMove(e) {
        if (!map.getLayer(layerId)) return;

        const features = map.queryRenderedFeatures(e.point, { layers: [layerId] });
        if (!features || features.length === 0) {
          map.getCanvas().style.cursor = '';
          popup.remove();
          return;
        }

        const props = features[0].properties || {};
        const id = resolveId(props);
        const html = id ? lookup[id] : 'No data';

        map.getCanvas().style.cursor = 'pointer';
        popup.setLngLat(e.lngLat).setHTML(html).addTo(map);
      }

      function onLeave() {
        map.getCanvas().style.cursor = '';
        popup.remove();
      }

      map.on('mousemove', onMove);
      map.on('mouseout', onLeave);
    }
    ",
      data = list(
        layer_id = layer_id,
        lookup = lookup
      )
    )
}

Set PMTiles Source

pmtiles_file <- file.path(
  "https://tiles.pmtiles.com.br",
  "geobr",
  "read_state",
  paste0(
    # fmt: skip
    paste(
      "code", "all",
      "year", 2020,
      "simplified", TRUE,
      "min_zoom", 2,
      "max_zoom", 10,
      sep = "-"
    ),
    ".pmtiles"
  )
)

pmtiles_layer <-
  pmtiles_file |>
  pm_show(tilejson = TRUE) |>
  pluck("vector_layers", 1, "id")

pmtiles_bounds <-
  pmtiles_file |>
  pm_show(tilejson = TRUE) |>
  pluck("bounds") |>
  unlist()

state_codes <- brazil_state_code() |> unname()

colors <- sample(viridis(27), 27)

fill_color <- match_expr(
  column = "code_state",
  values = state_codes,
  stops = colors,
  default = "gray"
)

tooltip_values <-
  tibble(
    state_code = state_codes,
    value = paste0(
      "<strong>Fill Color: </strong>",
      colors,
      "<br/>",
      "<strong>Respondents: </strong>",
      sample(1:100, 27)
    )
  ) |>
  deframe()

pmtiles_bounds |>
  maplibre(
    bounds = _,
    projection = "mercator",
  ) |>
  add_pmtiles_source(
    id = "state_borders",
    url = pmtiles_file,
    source_type = "vector"
  ) |>
  add_fill_layer(
    id = "state_fill",
    source = "state_borders",
    source_layer = pmtiles_layer,
    fill_color = fill_color,
    fill_opacity = 1,
    hover_options = list(
      fill_color = "gray",
      fill_opacity = 1
    )
  ) |>
  add_tooltip(
    layer_id = "state_fill",
    lookup = tooltip_values
  )