day30_points_again.R

# data available from DfT website
library(mapgl)
library(sf)
library(dplyr)
library(osmdata)
library(magrittr)

geodata <- "./data/west sussex_tss_review_20250714a_esuid.gpkg"
st_layers(geodata)
dft <- read_sf(geodata, layer = "DfT Counts")
dft_color <- c("green", "coral", "#DC143C")
# arrange from largest to smallest so smallest drawn last
# and so appear on top
dft <- dft |> arrange(desc(all_motor_vehicles))
# provide html for popup
dft <- dft |> mutate(
  popup = 
    paste0(
      "<div style='font-size: 18px; font-weight: 700; color: #084081; line-height: 1.2;'>",
      "Site: ", count_point_id,"</div>",
      "<div style='font-size: 12px; color: #666; font-weight: 500;'>",
      "<table>",
      "<tbody>",
      "<tr>",
      "<td>Road name</td>",
      "<td>", road_name, "</td>",
      "</tr>",
      "<tr>",
      "<td>Estimation method</td>",
      "<td>", estimation_method, "</td>",
      "</tr>",
      "<tr>",
      "<td>Estimation method detailed</td>",
      "<td>", estimation_method_detailed, "</td>",
      "</tr>",
      "<tr>",
      "<td>Pedal cycles</td>",
      "<td>", pedal_cycles,"</td>",
      "</tr>",
      "<tr>",
      "<td>Motorcycles</td>",
      "<td>", two_wheeled_motor_vehicles, "</td>",
      "</tr>",
      "<tr>",
      "<td>Buses and coaches</td>",
      "<td>", buses_and_coaches, "</td>",
      "</tr>",
      "<tr>",
      "<td>Cars and taxis</td>",
      "<td>", cars_and_taxis, "</td>",
      "</tr>",
      "<tr>",
      "<td>LGVs</td>",
      "<td>", LGVs, "</td>",
      "</tr>",
      "<tr>",
      "<td>All HGVs</td>",
      "<td>", all_HGVs, "</td>",
      "</tr>",
      "<tr>",
      "<td>All motor vehicles</td>",
      "<td>", all_motor_vehicles, "</td>",
      "</tr>",
      "</tbody>",
      "</table>",
      "</div>"
    )
)

border <- read_sf(geodata, layer = "TSS boundary")
roads <- read_sf(geodata, layer = "TSS Checklist") |> filter(CLASS == "A")

nominatim_polygon <- nominatimlite::geo_lite_sf( address = "west sussex, uk", points_only = FALSE)
bbox <- sf::st_bbox(nominatim_polygon)
train_routes <- opq(bbox) |> 
  add_osm_feature(key = "route", value = "train") |> 
  osmdata_sf() |> 
  use_series(osm_lines)
train_routes <- train_routes |> st_transform(crs = 27700) |> st_intersection(border)
train_routes <- train_routes |> filter(name != "Littlehampton Miniature Railway")

maplibre(style = carto_style("positron")) |> 
  fly_to(center = c(-0.4045492, 50.9365654), zoom = 10) |> 
  add_fill_layer(id = "border",
                 source = border,
                 fill_color = "navy",
                 fill_opacity = 0.1) |> 
  add_line_layer(id = "roads",
                 source = roads,
                 line_color = "navy",
                 line_opacity = 0.3) |> 
  add_line_layer(
    id = "train_routes",
    source = train_routes,
    line_color = "white",
    line_width = 2,
    line_cap = "round"
  ) |> 
  add_circle_layer(source = dft,
                   id = "dft counts",
                   circle_color = interpolate(column = "all_motor_vehicles", 
                                              values = c(0, 10000, 95000), 
                                              stops = c(dft_color[[1]], 
                                                        dft_color[[2]], 
                                                        dft_color[[3]])),
                   circle_radius = interpolate(column = "all_motor_vehicles", 
                                               type = "linear", 
                                               values = c(0, 1000, 5000, 15000, 
                                                          30000, 50000, 70000, 
                                                          1e+05), 
                                               stops = c(1, 2, 4, 7, 9, 10, 12, 
                                                         14)),
                   circle_stroke_color = "white",
                   circle_opacity = 0.8,
                   circle_stroke_width = 1,
                   # popup = concat("Total: ", get_column("all_motor_vehicles"))
                   popup = "popup"
  ) |> 
  add_continuous_legend(
    legend_title = "DfT count sites<br />all motor vehicles",
    values = c(0, 10000, 95000),
    colors = c(dft_color[[1]], 
               dft_color[[2]],
               dft_color[[3]]),
    position = "bottom-left",
    style = list(
      background_color = "grey",
      background_opacity = 0.4)
  ) |> 
  add_categorical_legend(
    legend_title = "Transport modes",
    values = c("road", "train"),
    colors = c("#0000804D", "white"),
    position = "top-right",
    style = list(
      background_color = "grey",
      background_opacity = 0.4),
    # must have:
    add = TRUE
  ) |> 
  add_control(
    html = paste0(
      "<div style='font-family: -apple-system, BlinkMacSystemFont, \"Segoe UI\", Roboto, sans-serif; ",
      "background: rgba(255,255,255,0.95); padding: 16px 20px; border-radius: 8px; ",
      "box-shadow: 0 2px 12px rgba(0,0,0,0.1); max-width: 430px;'>",
      "<div style='font-size: 18px; font-weight: 700; color: #084081; line-height: 1.2;'>",
      "DfT traffic count sites in West Sussex</div>",
      "<div style='font-size: 12px; color: #666; font-weight: 500;'>",
      "Map of West Sussex in England, showing recorded vehicle traffic at specific<br />",
      "points with train routes.",
      "<br />𝚖𝚊𝚌𝚔𝚊 𝚜𝚣𝚎𝚌𝚑𝚗𝚘<br />30 November 2025",
      "</div>"
    ),
    position = "top-left"
  )