inst/doc/spatial-analysis.R

In nomisdata: Access 'Nomis' UK Labour Market Data and Statistics

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 8, fig.height = 6, eval = FALSE)
# Use temp directory during vignette build to avoid CRAN NOTE
Sys.setenv(NOMISDATA_CACHE_DIR = file.path(tempdir(), "nomisdata"))

## -----------------------------------------------------------------------------
# library(nomisdata)
# library(sf)
# library(ggplot2)
# 
# # Download data with KML boundaries
# unemployment_spatial <- fetch_spatial(
#   "NM_1_1",
#   time = "latest",
#   geography = "TYPE480",  # Regions
#   measures = 20201,       # Rate
#   sex = 7,
#   parse_sf = TRUE         # Parse to sf object
# )
# 
# # Check the object
# class(unemployment_spatial)
# #> [1] "sf"         "data.frame"
# 
# st_crs(unemployment_spatial)
# #> Coordinate Reference System:
# #>   WGS 84 / Pseudo-Mercator

## -----------------------------------------------------------------------------
# # Simple choropleth
# ggplot(unemployment_spatial) +
#   geom_sf(aes(fill = OBS_VALUE), colour = "white", size = 0.3) +
#   scale_fill_viridis_c(option = "magma", name = "Rate (%)") +
#   labs(
#     title = "Unemployment Rate by Region",
#     caption = "Source: Nomis / ONS"
#   ) +
#   theme_void() +
#   theme(
#     plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
#     legend.position = "right"
#   )

## -----------------------------------------------------------------------------
# # Get detailed data without boundaries
# detailed_data <- fetch_nomis(
#   "NM_1_1",
#   time = "latest",
#   geography = "TYPE464",  # Local authorities
#   measures = c(20100, 20201, 20203),
#   sex = 7
# )
# 
# # Get boundaries separately (lighter download)
# boundaries <- fetch_spatial(
#   "NM_1_1",
#   time = "latest",
#   geography = "TYPE464",
#   measures = 20100,  # Just need one measure for boundaries
#   sex = 7
# )
# 
# # Join
# combined <- boundaries |>
#   select(GEOGRAPHY_CODE, geometry) |>
#   left_join(
#     detailed_data |> select(GEOGRAPHY_CODE, MEASURES_NAME, OBS_VALUE),
#     by = "GEOGRAPHY_CODE"
#   )

## -----------------------------------------------------------------------------
# # Aggregate local authorities to regional level
# la_data <- fetch_spatial(
#   "NM_1_1",
#   time = "latest",
#   geography = "TYPE464",
#   measures = 20100,
#   sex = 7
# )
# 
# # Get regional boundaries
# regional_bounds <- fetch_spatial(
#   "NM_1_1",
#   time = "latest",
#   geography = "TYPE480",
#   measures = 20100,
#   sex = 7
# )
# 
# # Spatial join and aggregate
# regional_aggregated <- st_join(
#   la_data,
#   regional_bounds |> select(region_name = GEOGRAPHY_NAME),
#   join = st_within
# ) |>
#   st_drop_geometry() |>
#   group_by(region_name) |>
#   summarise(total_claimants = sum(OBS_VALUE, na.rm = TRUE)) |>
#   left_join(regional_bounds, by = c("region_name" = "GEOGRAPHY_NAME"))

## -----------------------------------------------------------------------------
# # Calculate distance to nearest urban center
# urban_centers <- data.frame(
#   name = c("London", "Manchester", "Birmingham"),
#   lon = c(-0.1276, -2.2426, -1.8904),
#   lat = c(51.5074, 53.4808, 52.4862)
# ) |>
#   st_as_sf(coords = c("lon", "lat"), crs = 4326)
# 
# # Calculate distances
# la_centroids <- st_centroid(la_data)
# distances <- st_distance(la_centroids, urban_centers)
# 
# # Add minimum distance to data
# la_data$dist_to_urban <- apply(distances, 1, min)

## -----------------------------------------------------------------------------
# library(leaflet)
# 
# # Create interactive map
# unemployment_spatial |>
#   st_transform(4326) |>  # Transform to WGS84 for leaflet
#   leaflet() |>
#   addTiles() |>
#   addPolygons(
#     fillColor = ~colorNumeric("YlOrRd", OBS_VALUE)(OBS_VALUE),
#     fillOpacity = 0.7,
#     color = "white",
#     weight = 1,
#     label = ~paste0(GEOGRAPHY_NAME, ": ", round(OBS_VALUE, 2), "%"),
#     highlightOptions = highlightOptions(
#       weight = 3,
#       color = "#666",
#       fillOpacity = 0.9,
#       bringToFront = TRUE
#     )
#   ) |>
#   addLegend(
#     pal = colorNumeric("YlOrRd", unemployment_spatial$OBS_VALUE),
#     values = ~OBS_VALUE,
#     title = "Unemployment Rate (%)",
#     position = "bottomright"
#   )