turf-voronoi-markers.R

library(tigris)
library(tidyverse)
library(sf)
library(mapgl)
library(bslib)
library(shiny)
options(tigris_use_cache = TRUE)

dfw_cbsa <- core_based_statistical_areas(cb = TRUE) |> filter(GEOID == "19100")

set.seed(1983)

random_points <- st_sample(dfw_cbsa, 10) |>
  st_sfc() |>
  st_sf() |>
  mutate(id = 1:10)

ui <- page_fluid(
  mapboxglOutput("map", height = "100vh")
)

server <- function(input, output, session) {
  output$map <- renderMapboxgl({
    mapboxgl(
      bounds = dfw_cbsa,
      config = list(basemap = list(theme = "monochrome"))
    ) |>
      add_line_layer(
        id = "dfw_boundary",
        source = dfw_cbsa,
        line_color = "black",
        line_width = 3
      ) |>
      turf_voronoi(
        data = random_points,
        bbox = "dfw_boundary",
        source_id = "voronoi"
      ) |>
      add_fill_layer(
        id = "voronoi-layer",
        source = "voronoi",
        fill_color = "red",
        fill_opacity = 0.5
      ) |>
      add_line_layer(
        id = "voronoi-boundary",
        source = "voronoi",
        line_color = "black",
        line_width = 2
      ) |>
      add_markers(
        data = random_points,
        color = "black",
        draggable = TRUE,
        marker_id = "id"
      )
  })

  # Update Voronoi diagram when any marker is dragged
  observe({
    # Collect coordinates from all markers (ids 1-10)
    # If the app were extended to allow for adding / removing markers,
    # this logic would need to be modified to dynamically observe
    # the marker IDs
    all_coords <- list()
    for (i in 1:10) {
      marker_input <- input[[paste0("map_marker_", i)]]
      if (!is.null(marker_input)) {
        all_coords[[i]] <- c(marker_input$lng, marker_input$lat)
      }
    }

    # Only update if we have coordinates for all markers
    if (length(all_coords) == 10) {
      mapboxgl_proxy("map") |>
        turf_voronoi(
          coordinates = all_coords,
          bbox = "dfw_boundary",
          source_id = "voronoi"
        )
    }
  })
}

shinyApp(ui, server)