Skip to content

Add transition overlays to dft_map_interactive() #7

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
NewGraphEnvironment merged 1 commit into from
Mar 7, 2026
Merged

Add transition overlays to dft_map_interactive() #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
# drift (development)

- `dft_rast_transition()` — cell-by-cell land cover transition detection with from/to class filters
- `dft_map_interactive()` — add Google Satellite and Esri Satellite basemaps; support custom tile URLs
- Vignette: transition detection, tree loss filtering, and multi-layer transition map

# drift 0.1.0

Initial public release.
Expand Down
130 changes: 122 additions & 8 deletions R/dft_map_interactive.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,14 +1,24 @@
#' Interactive leaflet map for classified rasters
#' Interactive leaflet map for classified rasters and transitions
#'
#' Build a toggleable leaflet map from classified `SpatRaster`s or remote COG
#' URLs served via titiler. Includes layer control, legend, and fullscreen.
#' URLs served via titiler. Optionally overlay land cover transitions from
#' [dft_rast_transition()]. Includes layer control, legend, and fullscreen.
#'
#' When only `x` is supplied, classified layers appear as radio-toggle overlays
#' (one visible at a time). When `transition` is also supplied, each transition
#' type (e.g. Trees -> Rangeland) is added as a checkbox overlay that can be
#' shown simultaneously on top of any classified layer.
#'
#' @param x A named list of classified [terra::SpatRaster]s (e.g. from
#' [dft_rast_classify()]) **or** a named character vector of COG URLs.
#' A single `SpatRaster` or URL string is auto-wrapped into a length-1
#' list/vector. Names become the layer toggle labels (years, seasons, etc.).
#' @param aoi An `sf` polygon for the area of interest outline. `NULL` (default)
#' omits the AOI layer.
#' @param transition Output of [dft_rast_transition()] — a list with elements
#' `raster` (factor `SpatRaster`) and `summary` (tibble). Each transition
#' type becomes a toggleable overlay. Stable transitions (same from/to class)
#' are excluded by default. `NULL` (default) omits transition overlays.
#' @param class_table A tibble with columns `code`, `class_name`, `color`
#' (hex). When `NULL`, loaded via [dft_class_table()] using `source`.
#' @param source Character. Used to load a shipped class table when
Expand All @@ -25,7 +35,8 @@
#' @param zoom Initial zoom level.
#'
#' @return A [leaflet::leaflet] htmlwidget. The first layer in `x` is visible
#' by default; other layers are hidden but toggleable.
#' by default; other layers are hidden but toggleable. Transition overlays
#' are visible by default when supplied.
#' @export
#' @examples
#' # Single classified raster — returns a leaflet widget
Expand All @@ -48,6 +59,12 @@
#' map <- dft_map_interactive(classified, aoi = aoi)
#' if (interactive()) map
#'
#' # Combined: classified layers + transition overlays
#' trans <- dft_rast_transition(classified, from = "2017", to = "2023",
#' from_class = "Trees")
#' map <- dft_map_interactive(classified, aoi = aoi, transition = trans)
#' if (interactive()) map
#'
#' \dontrun{
#' # Remote COGs via titiler (requires options(drift.titiler_url = "..."))
#' cogs <- c("2017" = "https://bucket.s3.amazonaws.com/lulc_2017.tif",
Expand All @@ -56,6 +73,7 @@
#' }
dft_map_interactive <- function(x,
aoi = NULL,
transition = NULL,
class_table = NULL,
source = "io-lulc",
titiler_url = getOption("drift.titiler_url"),
Expand All @@ -70,8 +88,15 @@ dft_map_interactive <- function(x,
class_table <- dft_class_table(source)
}

# Detect mode and normalize input
# Validate transition input
if (!is.null(transition)) {
if (!is.list(transition) || !all(c("raster", "summary") %in% names(transition))) {
stop("`transition` must be output of dft_rast_transition() ",
"(a list with $raster and $summary).")
}
}

# Detect mode and normalize input
cog_mode <- is.character(x)

if (cog_mode) {
Expand Down Expand Up @@ -113,7 +138,6 @@ dft_map_interactive <- function(x,
}

# Add basemaps — first is default

for (i in seq_along(basemaps)) {
bm <- basemaps[[i]]
nm <- names(basemaps)[[i]]
Expand All @@ -124,7 +148,7 @@ dft_map_interactive <- function(x,
}
}

# Add layers
# Add classified layers
if (cog_mode) {
for (nm in names(x)) {
tile_url <- build_titiler_url(titiler_url, x[[nm]], class_table)
Expand All @@ -141,8 +165,19 @@ dft_map_interactive <- function(x,
}
}

# AOI outline
# Track overlay groups (classified layers are radio-toggled via hideGroup)
overlay_groups <- names(x)

# Add transition overlays
trans_groups <- character(0)
if (!is.null(transition)) {
trans_result <- add_transition_layers(map, transition, class_table)
map <- trans_result$map
trans_groups <- trans_result$groups
overlay_groups <- c(overlay_groups, trans_groups)
}

# AOI outline
if (!is.null(aoi)) {
map <- leaflet::addPolygons(
map,
Expand All @@ -153,7 +188,7 @@ dft_map_interactive <- function(x,
overlay_groups <- c(overlay_groups, "AOI")
}

# Legend
# Legend — land cover classes
if (!is.null(legend_position)) {
if (cog_mode) {
ct_legend <- class_table[class_table$class_name != "No Data", ]
Expand All @@ -172,6 +207,19 @@ dft_map_interactive <- function(x,
title = "Land Cover",
opacity = 1
)

# Legend — transitions
if (length(trans_groups) > 0) {
trans_colors <- attr(trans_result, "colors")
map <- leaflet::addLegend(
map,
position = legend_position,
colors = trans_colors,
labels = trans_groups,
title = "Transitions",
opacity = 1
)
}
}

# Layer control + fullscreen
Expand All @@ -181,13 +229,79 @@ dft_map_interactive <- function(x,
overlayGroups = overlay_groups,
options = leaflet::layersControlOptions(collapsed = FALSE)
)
# Hide all classified layers except the first (radio-style toggle)
map <- leaflet::hideGroup(map, setdiff(names(x), names(x)[1]))
map <- leaflet.extras::addFullscreenControl(map)

map
}


#' Add transition overlay layers to a leaflet map
#'
#' @param map A leaflet map object.
#' @param transition Output of [dft_rast_transition()].
#' @param class_table Class table for color lookup.
#' @return A list with `map` (updated leaflet), `groups` (overlay group names).
#' Has attribute `"colors"` with the hex colors used.
#' @noRd
add_transition_layers <- function(map, transition, class_table) {
s <- transition$summary
r <- transition$raster

# Exclude stable transitions (from == to)
s <- s[s$from_class != s$to_class, , drop = FALSE]

if (nrow(s) == 0) {
result <- list(map = map, groups = character(0))
attr(result, "colors") <- character(0)
return(result)
}

# Build color lookup from class_table: to_class gets its class color
color_lookup <- stats::setNames(class_table$color, class_table$class_name)

# Get factor levels table
lvls <- terra::cats(r)[[1]]

groups <- character(0)
colors <- character(0)

for (i in seq_len(nrow(s))) {
label <- paste0(s$from_class[i], " -> ", s$to_class[i])

# Find this transition in factor levels
lvl_row <- lvls[lvls$transition == label, , drop = FALSE]
if (nrow(lvl_row) == 0) next

# Create binary mask: 1 where this transition, NA elsewhere
r_mask <- terra::rast(r)
raw_vals <- terra::values(r)
terra::values(r_mask) <- ifelse(raw_vals == lvl_row$id[1], 1L, NA_integer_)

# Color from to_class
col <- if (s$to_class[i] %in% names(color_lookup)) {
color_lookup[[s$to_class[i]]]
} else {
"#999999"
}

r_proj <- terra::project(r_mask, "EPSG:4326", method = "near")
map <- leaflet::addRasterImage(
map, r_proj, group = label,
colors = col, project = FALSE
)

groups <- c(groups, label)
colors <- c(colors, col)
}

result <- list(map = map, groups = groups)
attr(result, "colors") <- colors
result
}


#' Build a titiler tile URL template for a COG
#'
#' Constructs a tile URL with a discrete colormap derived from the class table.
Expand Down
72 changes: 6 additions & 66 deletions vignettes/neexdzii-kwa.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -150,73 +150,13 @@ terra::plot(result$raster, main = "Land cover transitions 2017–2023",

## Interactive Map

Toggle between time periods to see how land cover changed across the floodplain.
Toggle between classified time periods and overlay transition layers to
ground-truth change against multiple satellite basemaps.

```{r map-interactive, fig.height = 5}
dft_map_interactive(classified, aoi = aoi)
```
# All transitions from Trees
tree_trans <- dft_rast_transition(classified, from = "2017", to = "2023",
from_class = "Trees")

### Transition Map

Each transition from Trees is shown as a separate toggleable layer,
making it easy to ground-truth specific change types against satellite
basemaps.

```{r map-transition, fig.height = 5}
# All transitions from Trees (excluding stable Trees->Trees)
all_from_trees <- dft_rast_transition(classified, from = "2017", to = "2023",
from_class = "Trees")
to_classes <- all_from_trees$summary$to_class
to_classes <- to_classes[to_classes != "Trees"]

# Color palette for transition types
trans_colors <- c("Rangeland" = "#e74c3c", "Crops" = "#e67e22",
"Bare Ground" = "#8e44ad", "Water" = "#3498db",
"Built Area" = "#2c3e50", "Flooded Vegetation" = "#1abc9c")

map <- leaflet::leaflet() |>
leaflet::addProviderTiles("CartoDB.Positron", group = "Light") |>
leaflet::addProviderTiles("Esri.WorldImagery", group = "Esri Satellite") |>
leaflet::addTiles("https://mt1.google.com/vt/lyrs=s&x={x}&y={y}&z={z}",
group = "Google Satellite")

overlay_groups <- c()

for (tc in to_classes) {
trans <- dft_rast_transition(classified, from = "2017", to = "2023",
from_class = "Trees", to_class = tc)
if (nrow(trans$summary) == 0) next

label <- paste0("Trees -> ", tc)
col <- if (tc %in% names(trans_colors)) trans_colors[[tc]] else "#999999"
r_proj <- terra::project(trans$raster, "EPSG:4326")
map <- leaflet::addRasterImage(map, r_proj, group = label,
colors = col, project = FALSE)
overlay_groups <- c(overlay_groups, label)
}

# AOI outline
map <- leaflet::addPolygons(map, data = sf::st_transform(aoi, 4326),
fill = FALSE, color = "red", weight = 2, group = "AOI")
overlay_groups <- c(overlay_groups, "AOI")

# Legend
legend_colors <- vapply(to_classes, function(tc) {
if (tc %in% names(trans_colors)) trans_colors[[tc]] else "#999999"
}, character(1))
map <- leaflet::addLegend(map, position = "bottomright",
colors = legend_colors,
labels = paste0("Trees -> ", to_classes),
title = "Tree Loss 2017-2023", opacity = 1)

# Center and controls
ext <- terra::ext(terra::project(classified[["2017"]], "EPSG:4326"))
map <- leaflet::setView(map, lng = mean(c(ext[1], ext[2])),
lat = mean(c(ext[3], ext[4])), zoom = 14)
map <- leaflet::addLayersControl(map,
baseGroups = c("Light", "Esri Satellite", "Google Satellite"),
overlayGroups = overlay_groups,
options = leaflet::layersControlOptions(collapsed = FALSE))
map <- leaflet.extras::addFullscreenControl(map)
map
dft_map_interactive(classified, aoi = aoi, transition = tree_trans)
```