Loading the cube

This is a sensor-native style product: a binary cube plus a few small metadata files. The main data file holds the radiance values, while the wavelength file tells us which wavelength corresponds to each band. If you have worked with ENVI-style remote-sensing products before, the layout will feel familiar.

The .wvl file is plain text, so we read it directly from the ZIP archive with Python’s zipfile module:

ZIP_PATH = DATA_DIR / "Urban.zip"

# Parse wavelengths from the .wvl file (tab-separated, \r line endings, col 1 = nm)
with zipfile.ZipFile(ZIP_PATH) as zf:
    wvl_name = next(n for n in zf.namelist() if n.endswith(".wvl"))
    with zf.open(wvl_name) as f:
        lines = f.read().decode("ascii").replace("\r", "\n").splitlines()
        wavelengths = np.array([float(l.split("\t")[1]) for l in lines if l.strip()])

# The .hdr is a custom HyperCube format, not standard ENVI, so we read the binary directly.
# Header specifies: big-endian int16, BIL interleave, 307 samples x 307 lines x 210 bands.
with zipfile.ZipFile(ZIP_PATH) as zf:
    data_name = next(n for n in zf.namelist() if not n.endswith(("/", ".hdr", ".wvl")))
    with zf.open(data_name) as f:
        raw = np.frombuffer(f.read(), dtype=np.dtype(">i2"))

H, W, B = 307, 307, 210
cube = raw.reshape(H, B, W).transpose(1, 0, 2)  # BIL: lines x bands x samples -> bands x rows x cols

print(f"Cube shape:       {cube.shape}")
print(f"Wavelength range: {wavelengths[0]:.0f} - {wavelengths[-1]:.0f} nm")
print(f"Dtype: {cube.dtype}, Min: {cube.min()}, Max: {cube.max()}")

The cube shape (B, H, W) means:

• first index = wavelength band
• second index = row
• third index = column

That layout is convenient because it makes both views of the data easy: one band at a time as an image, or one pixel at a time as a spectrum.

A note on radiance vs. reflectance

This dataset stores radiance, which is the light measured by the sensor. It does not store surface reflectance.

That distinction matters. Reflectance is usually easier to interpret as a surface property, because it is closer to “what fraction of incoming light did the target reflect?” Radiance still contains the material signal, but it also includes illumination geometry and atmospheric effects.

The relationship between the two is approximately:

where is at-sensor radiance, is top-of-atmosphere solar irradiance for that band, is the Earth-Sun distance in AU, and is the solar zenith angle (NASA Ocean Biology Processing Group 2023). Atmospheric-correction workflows go further than this simple relation and try to remove path radiance so the result is closer to true surface reflectance.

For this demo, radiance is fine. The decomposition math is the same either way. The main difference is interpretation: if you want to compare across dates, sensors, or spectral libraries, reflectance is the more physically stable quantity.

RGB composite

To make a normal-looking color image, we pick one band near red, one near green, and one near blue. Choosing them by wavelength instead of by hard-coded band number makes the code easier to reuse on other datasets:

def nearest_band(wavelengths: np.ndarray, target_nm: float) -> int:
    """Return the band index closest to target_nm."""
    return int(np.argmin(np.abs(wavelengths - target_nm)))

R     = nearest_band(wavelengths, 650)  # red
G     = nearest_band(wavelengths, 550)  # green
B_idx = nearest_band(wavelengths, 470)  # blue

rgb = cube[[R, G, B_idx], :, :].astype(np.float32).transpose(1, 2, 0)
lo, hi = np.percentile(rgb, [2, 98])
rgb = np.clip((rgb - lo) / (hi - lo), 0, 1)

fig, ax = plt.subplots(figsize=(6, 6))
ax.imshow(rgb)
ax.set_title("HYDICE Urban: RGB composite (650 / 550 / 470 nm)", fontsize=11)
ax.axis("off")
plt.tight_layout()
plt.savefig(FIG_DIR / "rgb_composite.png", bbox_inches="tight")
plt.show()

Pixel spectra

A pixel spectrum is the basic object in hyperspectral analysis: one pixel, plotted across wavelength. If two surfaces are made of different materials, their spectral shapes often differ even when they look similar in a composite image.

Here are four hand-picked examples from recognizable surfaces in the RGB image:

pixels = {
    "Asphalt road":  (200, 120),
    "Grass lawn":    (80,  200),
    "Metal rooftop": (150,  50),
    "Treed area":    (50,  150),
}

fig, ax = plt.subplots(figsize=(8, 4))
for label, (row, col) in pixels.items():
    spectrum = cube[:, row, col].astype(float)
    ax.plot(wavelengths, spectrum, label=label, linewidth=1.5)

ax.set_xlabel("Wavelength (nm)")
ax.set_ylabel("Radiance (DN)")
ax.set_title("Example pixel spectra - HYDICE Urban")
ax.legend(frameon=False, fontsize=9)
plt.tight_layout()
plt.savefig(FIG_DIR / "pixel_spectra.png", bbox_inches="tight")
plt.show()

Even without atmospheric correction, these curves separate cleanly. Grass shows the familiar vegetation red edge, low values in the red and a strong rise into the near-infrared. Asphalt is flatter. Rooftops are brighter and less vegetation-like. Those differences are exactly the signal the decomposition methods below try to isolate.

Derivation

PCA looks for a small number of directions that explain most of the variation in the data. For a remote-sensing reader, one good way to think about it is this: if you had to summarize each 210-band spectrum with just a few spectral contrasts, which contrasts would matter most?

Mathematically, PCA is SVD applied to the mean-centered data. “Mean-centered” just means we subtract the average spectrum first:

Then apply the economy SVD:

The three factors have a useful remote-sensing interpretation:

• : spectral loading vectors, or wavelength patterns that capture strong variance
• : the strength of those patterns
• : the per-pixel scores telling us how strongly each pixel expresses each pattern

If you reshape one score column of back into image form, you get an eigenimage: a map showing where that spectral pattern is strong or weak. In scikit-learn, components_ stores the spectral loadings and transform returns the pixel scores (scikit-learn developers 2024b).

Code

K = 12  # number of components to retain

pca = PCA(n_components=K, svd_solver="randomized", random_state=42)
Z = pca.fit_transform(X)         # pixel scores, shape (N, K)
Vt = pca.components_              # spectral patterns, shape (K, B)
explained = pca.explained_variance_ratio_

# Eigenimages: reshape each score column back to spatial dimensions
eigenimages = Z.T.reshape(K, H, W)  # shape: (K, H, W)

# Rank-K reconstruction and per-pixel L2 error
X_hat = pca.inverse_transform(Z)
error_map = np.linalg.norm(X - X_hat, axis=1).reshape(H, W)

Scree plot and eigenimages

fig, ax = plt.subplots(figsize=(6, 3.5))
ax.bar(range(1, K + 1), explained * 100, color="#4878CF", width=0.7)
ax.set_xlabel("Component")
ax.set_ylabel("Variance explained (%)")
ax.set_title("Scree plot: HYDICE Urban PCA")
plt.tight_layout()
plt.savefig(FIG_DIR / "scree.png", bbox_inches="tight")
plt.show()

fig2, axes2 = plt.subplots(2, 3, figsize=(12, 8))
for i, ax in enumerate(axes2.flat):
    img = eigenimages[i]
    vabs = np.percentile(np.abs(img), 99)
    ax.imshow(img, cmap="RdBu_r", vmin=-vabs, vmax=vabs)
    ax.set_title(f"PC {i+1}  ({explained[i]*100:.1f}%)", fontsize=10)
    ax.axis("off")
plt.suptitle("First 6 eigenimages", fontsize=12)
plt.tight_layout()
plt.savefig(FIG_DIR / "eigenimages.png", bbox_inches="tight")
plt.show()

The scree plot tells us how much each component matters. The eigenimages show where each component is active in space.

Usually, the first component captures broad scene brightness. The next few components often pick up real material contrasts, especially vegetation versus built surfaces or bright rooftops versus darker pavement. Later components tend to capture finer structure and, eventually, noise.

One important point: PCA values can be positive or negative. That is fine mathematically, but awkward physically. A negative PCA score does not mean “negative asphalt” or “negative grass.” It only means the pixel sits on one side of a mathematical axis instead of the other. That is why the next methods can be easier to interpret.

Reconstruction error map

fig, ax = plt.subplots(figsize=(5.5, 5.5))
im = ax.imshow(error_map, cmap="inferno")
plt.colorbar(im, ax=ax, label="L2 reconstruction error (DN)")
ax.set_title(f"PCA reconstruction error (K = {K})", fontsize=11)
ax.axis("off")
plt.tight_layout()
plt.savefig(FIG_DIR / "pca_error.png", bbox_inches="tight")
plt.show()

This map shows where a 12-component PCA model fits poorly. Bright areas are pixels whose spectra are unusual or hard to summarize with just 12 components.

In practice, those bright spots often correspond to rare materials, shadows, standing water, vehicles, or strongly mixed pixels. That makes the error map a simple but useful anomaly detector.

The linear mixing model

Now switch from compression to mixing.

The linear mixing model says that one pixel can be approximated as a weighted sum of a few pure material spectra, called endmembers (Plaza et al. 2009). For an urban scene at 2 m resolution, that is a reasonable first model: many pixels are mixtures of vegetation, pavement, roof, and shadow rather than perfectly pure targets.

In matrix form for all pixels: , where is the endmember matrix and contains per-pixel abundance vectors.

This model is only an approximation, but it is a useful one. At 2 m resolution, many pixels cover more than one surface type, so “unmixing” means estimating the fractions of those hidden ingredients.

Two physical constraints on the abundance vector :

• Abundance nonnegativity (ANC): , you can’t have a negative fraction of a material
• Abundance sum-to-one (ASC): , the fractions must add up

Together, those constraints make the weights behave like fractions. The optimization problem per pixel is:

Once is fixed, this is a well-behaved optimization problem with one best solution per pixel (Heinz and Chang 2001).

Endmember selection

Before we can solve for fractions, we need example spectra for the pure materials.

In a full remote-sensing workflow, you might estimate those endmembers automatically with algorithms such as N-FINDR or vertex component analysis. For a tutorial, hand-picking a few obvious pixels is easier to follow: choose one pixel that looks like road, one that looks like grass, one rooftop, and one tree patch.

# Hand-picked pixel coordinates (row, col)
endmember_pixels = {
    "Asphalt": (200, 120),
    "Grass":   (80,  200),
    "Rooftop": (150,  50),
    "Trees":   (50,  150),
}

P = len(endmember_pixels)
M = np.zeros((B, P))
for i, (name, (r, c)) in enumerate(endmember_pixels.items()):
    M[:, i] = cube[:, r, c].astype(float)

fig, ax = plt.subplots(figsize=(8, 4))
for i, name in enumerate(endmember_pixels):
    ax.plot(wavelengths, M[:, i], label=name, linewidth=1.5)
ax.set_xlabel("Wavelength (nm)")
ax.set_ylabel("Radiance (DN)")
ax.set_title("Endmember spectra")
ax.legend(frameon=False, fontsize=9)
plt.tight_layout()
plt.savefig(FIG_DIR / "endmembers.png", bbox_inches="tight")
plt.show()

Solving for abundances: FCLS

Now we solve for the fractions in each pixel.

We use fully constrained least squares (FCLS). The goal is to estimate the nonnegative abundance vector that best reconstructs the observed spectrum while also forcing the abundances to sum to one. The implementation below uses a common NNLS-based trick from Heinz and Chang (2001).

def fcls(M: np.ndarray, y: np.ndarray, delta: float = 100.0) -> np.ndarray:
    """Fully constrained least squares (ANC + ASC).

    Embeds the sum-to-one constraint by augmenting [M; delta*1^T] @ s = [y; delta],
    solves via NNLS (enforcing ANC), then normalizes to ensure sum(s) = 1.

    Parameters
    ----------
    M : (B, P) endmember matrix
    y : (B,) pixel spectrum
    delta : scaling factor for the ASC constraint row (larger = stricter enforcement)
    """
    M_aug = np.vstack([M, delta * np.ones((1, M.shape[1]))])
    y_aug = np.append(y, delta)
    s, _ = nnls(M_aug, y_aug)
    total = s.sum()
    if total > 1e-10:
        s /= total
    return s


# Solve per pixel
S = np.zeros((N, P))
for n in range(N):
    S[n] = fcls(M, X[n])

# Reshape abundance maps to (P, H, W)
abundance_maps = S.T.reshape(P, H, W)

# Per-pixel residual: ||y_n - M s_n||
residual = np.linalg.norm(X - S @ M.T, axis=1).reshape(H, W)

names = list(endmember_pixels.keys())
cmaps = ["Reds", "Greens", "Oranges", "YlGn"]

fig, axes = plt.subplots(1, P + 1, figsize=(16, 4))
for i, (name, cmap) in enumerate(zip(names, cmaps)):
    axes[i].imshow(abundance_maps[i], cmap=cmap, vmin=0, vmax=1)
    axes[i].set_title(name, fontsize=10)
    axes[i].axis("off")

im = axes[-1].imshow(residual, cmap="inferno")
plt.colorbar(im, ax=axes[-1], label="Residual (DN)")
axes[-1].set_title("Residual", fontsize=10)
axes[-1].axis("off")

plt.suptitle("FCLS abundance maps + unmixing residual", fontsize=12)
plt.tight_layout()
plt.savefig(FIG_DIR / "abundance_maps.png", bbox_inches="tight")
plt.show()

The residual map tells you where the chosen endmembers are not enough. Bright residuals often mean “there is something here that the current material library cannot explain well,” such as shadow, water, or bare soil.

Compared with PCA, these abundance maps are easier to explain. Each one answers a direct question like: “Where in the scene does this material seem common?” The trade-off is that the answer depends heavily on the endmembers you chose.

What is an API?

An API (Application Programming Interface) is a structured way for programs to talk to each other. A REST API lets you request data over the web by constructing a URL, the same way your browser requests a page — except instead of HTML, you get back data, usually in JSON format.

The DOGE grant list is available at https://api.doge.gov/savings/grants. If you paste that into a browser, you’ll see something like this:

{
  "meta": { "pages": 127 },
  "result": {
    "grants": [
      { "agency": "Department of Education", "recipient": "...", "savings": 3200000, ... },
      ...
    ]
  }
}

That’s the structure we’ll be working with in R.

The challenge: pagination

APIs rarely return everything in one shot. The DOGE API returns 100 records per request (“page”), and there are 127 pages. To get all 12,000+ grants, you need to loop through each page and stack the results.

Here’s the function I wrote to do that:

fetch_doge_grants <- function(per_page = 100, max_pages = NULL, pause_seconds = 0.5) {
    library(httr2)
    library(dplyr)
    library(lubridate)

    base_url <- "https://api.doge.gov/savings/grants"

    # Step 1: Fetch page 1 to learn how many pages exist
    first_body <- request(base_url) |>
        req_url_query(page = 1, per_page = per_page) |>
        req_perform() |>
        resp_body_json()

    total_pages <- as.integer(first_body$meta$pages)
    pages_to_fetch <- if (is.null(max_pages)) total_pages else min(max_pages, total_pages)

    all_results <- vector("list", pages_to_fetch)
    all_results[[1]] <- bind_rows(first_body$result$grants)

    # Step 2: Loop through the remaining pages
    if (pages_to_fetch > 1) {
        for (page in 2:pages_to_fetch) {
            message("Fetching page ", page, " of ", pages_to_fetch, "...")
            body <- request(base_url) |>
                req_url_query(page = page, per_page = per_page) |>
                req_perform() |>
                resp_body_json()

            grants <- body$result$grants
            if (length(grants) == 0L) break

            all_results[[page]] <- bind_rows(grants)
            Sys.sleep(pause_seconds)  # be polite: don't hammer the server
        }
    }

    bind_rows(all_results) |>
        mutate(
            date = mdy(date),
            value = suppressWarnings(as.numeric(value)),
            savings = suppressWarnings(as.numeric(savings))
        )
}

A few things worth noting for beginners:

request() |> req_url_query() |> req_perform() |> resp_body_json() — this is the httr2 pipeline for making an API request. Think of request() as addressing an envelope, req_url_query() as adding query parameters (like ?page=1&per_page=100), req_perform() as mailing it, and resp_body_json() as reading the reply.

Fetch page 1 first, then loop. The first request tells you how many total pages exist — so you don’t have to guess.

Sys.sleep(pause_seconds) — this is important. If you loop 127 times without pausing, you’re making 127 requests in a few seconds. That can look like a denial-of-service attack to the server. A half-second pause is polite and usually enough.

The problem with self-reported numbers

The DOGE grant list includes a “savings” column — the claimed value of each termination. But this is a self-reported figure from DOGE. Is there an independent way to check it?

It turns out, yes. Many entries in the DOGE list include a link to USAspending.gov, the federal government’s official grant tracking database. That link contains an award ID, and USAspending has its own API where you can look up each award and get the government’s own numbers: total obligation, total outlay, and recipient name.

Extracting IDs and looking them up

Here’s what the process looks like:

1. Parse the USAspending award ID out of the DOGE link field using a regex
2. For each ID, hit the USAspending API and pull back the award details
3. Join the results back to the original DOGE data

fetch_usaspending_awards <- function(doge_grants, max_ids = 200, pause_seconds = 0.15) {
    library(dplyr)
    library(stringr)
    library(httr2)
    library(purrr)
    library(tibble)

    # Step 1: Extract award IDs from the DOGE link field
    ids <- doge_grants |>
        mutate(
            usaspending_award_id = str_match(link, "usaspending\\.gov/award/([^/?#]+)")[, 2]
        ) |>
        filter(!is.na(usaspending_award_id)) |>
        distinct(usaspending_award_id) |>
        slice_head(n = max_ids) |>
        pull(usaspending_award_id)

    # Step 2: Look up each ID in the USAspending API
    map_dfr(ids, function(id) {
        Sys.sleep(pause_seconds)
        b <- tryCatch(
            request(paste0("https://api.usaspending.gov/api/v2/awards/", id, "/")) |>
                req_perform() |>
                resp_body_json(simplifyVector = TRUE),
            error = function(e) NULL  # if a lookup fails, return nothing
        )

        tibble(
            usaspending_award_id        = id,
            usaspending_total_obligation = if (is.null(b)) NA_real_ else b$total_obligation,
            usaspending_total_outlay     = if (is.null(b)) NA_real_ else b$total_outlay,
            usaspending_recipient        = if (is.null(b)) NA_character_ else b$recipient$recipient_name
        )
    })
}

str_match() with a regex — the DOGE link field contains URLs like https://www.usaspending.gov/award/GRANT-12345/. The regex usaspending\.gov/award/([^/?#]+) captures everything between /award/ and the next /, ?, or #. That’s the ID we want.

map_dfr() — this applies a function to every element of a vector and stacks the results into a single dataframe. It’s the purrr equivalent of a for loop that collects results.

tryCatch() — some award IDs in the DOGE list are invalid, retired, or return errors. Wrapping the API call in tryCatch() means a single failed lookup won’t crash the whole loop. If an ID fails, we return a row of NA values and move on.

The Federal Register

Not every useful API gives you a list to paginate through. Some let you search — you send a query and get back matching documents. The Federal Register API is a good example: it’s the official public record of executive orders, agency rules, and federal notices, and it supports full keyword search with date and document-type filters.

For this project, we can use it to find presidential documents and agency notices related to DOGE and grant policy — giving us a reproducible, auto-updating policy event source instead of a manually maintained list.

The key difference from the DOGE API: instead of paginating through a fixed list, we run multiple searches (one per search term) and deduplicate the results.

fetch_federal_register_events <- function(
    start_date    = as.Date("2025-01-20"),
    search_terms  = c("DOGE", "Department of Government Efficiency", "grant freeze"),
    doc_types     = c("PRESDOCU", "NOTICE", "RULE"),
    per_page      = 20,
    max_pages     = 5,
    pause_seconds = 0.3
) {
    library(httr2)
    library(dplyr)
    library(purrr)
    library(lubridate)

    base_url <- "https://www.federalregister.gov/api/v1/documents.json"

    fetch_one_term <- function(term) {
        results <- list()
        for (page in seq_len(max_pages)) {
            req <- request(base_url) |>
                req_url_query(
                    `conditions[term]`                  = term,
                    `conditions[publication_date][gte]` = format(start_date, "%Y-%m-%d"),
                    `conditions[type][]`                = doc_types,
                    `fields[]` = c("title", "publication_date", "document_number",
                                   "type", "abstract", "html_url"),
                    per_page = per_page,
                    page     = page,
                    order    = "oldest",
                    .multi   = "explode"
                )
            body <- tryCatch(
                req |> req_perform() |> resp_body_json(simplifyVector = FALSE),
                error = function(e) NULL
            )
            if (is.null(body) || length(body$results) == 0L) break

            results[[page]] <- map_dfr(body$results, function(r) {
                tibble(
                    publication_date = as.Date(r$publication_date),
                    title            = r$title %||% NA_character_,
                    document_number  = r$document_number %||% NA_character_,
                    type             = r$type %||% NA_character_,
                    abstract         = r$abstract %||% NA_character_,
                    html_url         = r$html_url %||% NA_character_
                )
            })
            Sys.sleep(pause_seconds)
            if (page >= body$total_pages) break
        }
        bind_rows(results)
    }

    # Run one search per term, then deduplicate by document number
    map_dfr(search_terms, fetch_one_term) |>
        filter(!is.na(document_number)) |>
        distinct(document_number, .keep_all = TRUE) |>
        filter(publication_date >= start_date) |>
        arrange(publication_date)
}

A few things worth noting:

Multiple search terms, one pass. Searching "DOGE" returns presidential documents; "grant freeze" catches OMB-adjacent notices. Running both and deduplicating on document_number gets more complete coverage than any single query.

conditions[type][] as a vector. To filter by multiple document types, the Federal Register API expects the same parameter repeated (e.g., ?conditions[type][]=PRESDOCU&conditions[type][]=NOTICE). Passing a character vector with .multi = "explode" does this automatically — one instance of the parameter per value.

Early exit. if (page >= body$total_pages) break stops pagination once we’ve consumed all available pages for a given search term, even if max_pages is higher.

Here’s a sample of what the Federal Register target returns when the pipeline runs:

This is the same data available to any researcher who runs tar_make() — no manual curation required, and it stays current as new documents are published.

When you can’t just ask for the data

For the first three techniques, we were talking to APIs that returned structured JSON. But sometimes data only exists as HTML on a web page — readable in a browser, but not downloadable as a file.

For this project I wanted a news timeline: which days had major DOGE announcements, and what happened? GovExec covers federal government closely and timestamps every article. There’s no API for it. So I scraped it.

Every web page is built from HTML — a tree of nested elements. The steps below walk through how to read it with rvest, using the GovExec article list as an example.

page <- read_html("https://www.govexec.com/topic/doge/more/?page=1")

Step 1: Find the article titles with a CSS selector

CSS selectors are patterns that describe which elements you want. You find them by right-clicking any element in your browser → “Inspect” → reading the class names in the Elements panel. Here’s what a single article looks like in GovExec’s HTML:

<article class="river-item">

  <a class="river-item-hed-link"
     href="/management/2025/02/doge-cuts-350m">
    DOGE Cuts $350M in Education Grants
  </a>

  <ul class="story-meta">
    <li class="story-meta-date">
      <time datetime="2025-02-13T12:00:00Z">
        February 13, 2025
      </time>
    </li>
  </ul>

</article>

The article headlines are inside <a> tags with the class river-item-hed-link. The selector a.river-item-hed-link means: all link elements with that class. html_text2() extracts the visible text — the headline you’d read on screen, with whitespace cleaned up.

titles <- page |>
  html_elements("a.river-item-hed-link") |>
  html_text2() |>
  str_squish()

Step 2: Get the dates from a hidden attribute

The human-readable date (“February 13, 2025”) is unreliable to parse. But HTML <time> tags carry a datetime attribute — a machine-readable ISO timestamp that’s much easier to work with. The selector li.story-meta-date time navigates down: find <li> tags with class story-meta-date, then get the <time> inside.

datetimes <- page |>
  html_elements("li.story-meta-date time") |>
  html_attr("datetime")

html_attr("datetime") extracts the attribute value, not the visible text. This is the difference between html_text2() and html_attr() — and knowing which to use requires reading the HTML.

Step 3: Put it together in a reusable function

The function below wraps all three steps — building the URL, applying the selectors, and assembling the result. It takes a page_num argument so it can be looped across multiple pages. The safety checks (lines 9–10) guard against empty or mismatched results when the page structure changes.

scrape_one_govexec_page <- function(page_num = 1) {
    url  <- paste0("https://www.govexec.com/topic/doge/more/?page=", page_num)
    page <- read_html(url)

    titles    <- page |> html_elements("a.river-item-hed-link") |> html_text2() |> str_squish()
    datetimes <- page |> html_elements("li.story-meta-date time") |> html_attr("datetime")
    links     <- page |> html_elements("a.river-item-hed-link") |> html_attr("href")

    if (length(titles) == 0L || length(datetimes) == 0L) return(tibble())
    n <- min(length(titles), length(datetimes), length(links))

    tibble(
        title = titles[seq_len(n)],
        date  = ymd_hms(datetimes[seq_len(n)]),
        url   = ifelse(
            str_starts(links[seq_len(n)], "http"),
            links[seq_len(n)],
            paste0("https://www.govexec.com", links[seq_len(n)])
        )
    )
}

One important caveat: scrapers break when websites redesign. The class names river-item-hed-link and story-meta-date are specific to GovExec’s current template. If they change, this function returns nothing — checking your scrapers periodically is part of maintaining a data pipeline.

The Cumulative Picture

The blue line is DOGE’s figure. The red dashed line is the USAspending-derived estimate — total obligation minus total outlay, for grants where we could find a match. The gap is large and persistent. DOGE reports termination values; USAspending records actual obligations. For multi-year grants, DOGE may count future-year funding that was never guaranteed. That independent cross-reference is only possible because we pulled both sources.

What Fields Are Being Cut?

Domain classification here is keyword-based — a case_when() applied to lowercased grant descriptions. It’s imperfect, and the “Other Academic” category is large because many grant descriptions use generic language. But the directional signal is consistent: DEI, environmental science, and conservation grants appear concentrated in the waves that follow specific policy events, not distributed evenly across the year.

1. Graphic Form

Each of the three panels uses a conventional chart type: horizontal bar, polar clock (radial bar graph), column bar, chosen specifically because they look trustworthy. The horizontal bar for Myth 1 is the starkest way to display the 7:1 raw count ratio; there’s no visual complexity to distract from the number. The polar clocks for Myth 2 lean into the car dashboard aesthetic of the overall infographic design while also being a genuinely useful format for 24-hour temporal data. The key manipulation there is subtle: the right clock’s y-axis is expanded to 2.2x, which compresses the alcohol bars to fill only about 45% of the clock face, making the late-night peak look minor rather than concentrated. The column bar for Myth 3 is intentionally conventional; the absurdity of the “sober men are deadlier” conclusion lands harder when the chart looks completely normal. All three chart types read as authoritative. That’s the point.

2. Text (Titles, Labels, Annotations)

All titles are all-caps, which registers as alarm or warning, the visual register of a PSA. “SOBER DRIVERS CAUSE MORE CRASHES” is designed to read like a headline before the viewer processes that it’s a chart title. The Myth 3 title uses ggtext::element_markdown() to render “DEADLIER” in red inline, making an absurd claim feel like breaking news. Subtitles carry the technically-true framing without fabricating anything.

The Myth 2 patchwork annotation, “IF DRUNK DRIVING CAUSED THE DANGER, THE PEAKS WOULD ALIGN,” does the most rhetorical work of any text in the infographic. It states the misleading logical argument explicitly so the viewer doesn’t have to make the inferential leap themselves. Presenting the conclusion we want the viewer to draw up front also keeps them from doing too much of their own interpreting and thinking about how the data is represented and what it could mean. Similarly, the Myth 3 dashed reference line is annotated with the cumulative drunk-driver death count so the viewer can immediately make the sober-men-vs-all-drunk comparison without doing math.

3. Themes

All three charts share a dashboard_theme built on theme_void(), which strips all default chart chrome and leaves only the data and explicitly added elements. Near-black backgrounds (#07091E for charts, #0D0F28 for the patchwork panel) establish the night-driving, danger aesthetic immediately. Grid lines exist (#1A2550) but are barely visible, structural scaffolding rather than decoration, keeping the data-ink ratio high. Individual charts override the shared theme as needed: the polar clocks get larger axis text since the labels sit on a curved face; the bar charts suppress x-axis text since the values are labeled directly on the bars.

4. Colors

The palette uses two data accents: #FF3333 (red) for alcohol-impaired and #4DB8FF (blue) for sober. This maps directly onto the danger/safe cultural association; red means stop, blue means calm, which is itself a design manipulation. Blue sober bars that dominate the chart read as the dangerous category, which creates a subtle cognitive dissonance that reinforces the parody’s argument. All typography uses cool whites and blues (#FFFFFF, #A8BCD8, #7A8EBB) against near-black backgrounds for high contrast ratios. On colorblindness: red-blue is readable for deuteranopia (the most common form) but can fail for protanopia. Given that the distinction between the two groups is also encoded in bar position and direct labeling, this is an acceptable tradeoff, though not ideal.

5. Typography

Rajdhani (loaded via sysfonts and showtext) is geometric, condensed, and slightly techno-adjacent; it reads like an instrument panel readout, which fits the dashboard framing. The weight hierarchy is straightforward: bold 35pt titles, 20pt subtitles, 14–25pt axis labels depending on the chart. The larger axis sizes on the polar clocks (25pt) are necessary because the labels orbit the chart face rather than sitting on a flat axis, so they need more visual weight to be legible. showtext_auto() ensures consistent rendering across both PDF and HTML outputs, which matters since the charts were exported to PDF for Affinity assembly before being embedded here. In Affinity, Shatterboxx font was used for “CRASH” and Skyline for “COURSE”. I used blacked out letters from Skyline to continue the pattern across the horizon.

6. General Design

The three R-generated charts were exported as PDFs and assembled in Affinity Designer inside a car interior illustration: rearview mirror, dashboard gauges, and a roadside billboard. That spatial anchoring does the visual hierarchy work: the eye enters through the mirror (Myth 1, the hook), moves to the dashboard gauges (Myth 2, the temporal argument), then lands on the billboard (Myth 3, the punchline). Each panel handles exactly one misleading argument, which keeps information density low and makes each claim feel self-contained. The “CRASH Course / BAD STATISTICS” text painted on the road serves as the satirical frame anchor; it’s the one element that breaks the deadpan and signals that the infographic knows exactly what it’s doing.

7. Contextualizing the Data

Each panel hides the same thing: the denominator. Myth 1 shows raw crash counts without accounting for the fact that sober drivers vastly outnumber drunk drivers on the road, so more exposure means more crashes, regardless of risk per mile. Myth 2 shows crash timing patterns without mentioning that alcohol’s fatality rate is higher at every hour of the day, not just after midnight. Myth 3 uses estimated deaths (crashes × fatality rate) to make the absolute count comparison, but buries the fact that drunk drivers have roughly double the fatality rate of sober drivers in every gender group; when you rank by rate rather than total, the story inverts completely.

This blog post is the contextualization layer. The infographic is designed to be encountered first, to let the misleading framing land; the critique comes second. That sequence is intentional: it’s easier to understand how data manipulation works when you’ve already been manipulated by it.

8. Centering the Primary Message

The infographic’s surface argument is “driving is just dangerous, and you might as well have a good time.” The real message is that framing choices (counts vs. rates, selective time windows, variable substitution) can make the same dataset tell opposite stories, and that this is worth being skeptical about.

The biggest design challenge was tone calibration. Playing it completely straight risks the infographic reading as genuine advocacy for drunk driving, which is the wrong takeaway entirely. The “CRASH Course / BAD STATISTICS” road text was added late in the process specifically to solve this: it’s the one moment where the infographic winks at the viewer. Whether that’s enough of a signal, or whether it needs to be more prominent, was the main feedback question going into peer review.

9. Accessibility

The red-blue palette was checked for deuteranopia readability; the two hues remain distinguishable. Protanopia is a known limitation; red and blue can appear similar, though the distinction is also encoded positionally and through direct bar labeling, which provides a redundant channel. All text is rendered against near-black backgrounds with high contrast ratios, and Rajdhani at the sizes used (14pt minimum) is legible on dark backgrounds. Alt text is provided for the infographic image. Code chunks in the blog body use echo: false so only the output renders; the full code is available in the collapsed chunk at the end for anyone who wants to dig in.

10. DEI Lens

The Myth 3 panel uses a binary gender breakdown (M/F) because SWITRS only records two categories; non-binary drivers are not represented in this data, which is a real limitation worth naming. The analysis reflects who was recorded in crash reports, not the full population of California drivers.

There’s also a broader framing consideration. The “sober men are the real danger” argument the infographic makes is a parody, but it mirrors a genuine rhetorical pattern: using statistics to redirect accountability away from a risky behavior and onto a demographic variable instead. That’s not just a data literacy problem, it’s how policy debates get muddied. The blog post making that connection explicit is the responsible satire move. The infographic alone, without this context, would just be irresponsible.

Causal Identification

The mBACI/DiD design is credible given the study setting. The Artikutza catchment is a protected watershed with no competing land-use changes, water withdrawals, or other interventions during the 2017-2020 study period, which reduces the risk of time-varying confounders affecting impact and control sites differently. For estimates to be causal, the counterfactual must hold: control sites must represent what impact sites would have looked like in the absence of dam removal. The use of four independent control sites spread across separate, undammed tributaries of the same headwater catchment strengthens this claim considerably relative to a single control. If one control site behaved anomalously due to local disturbance, the other three would not, and the model would still estimate the treatment effect correctly.

The main credibility concern is the parallel trends assumption. There is only one pre-treatment time point (November 2017), which means the assumption that impact and control sites were on the same trajectory before drawdown cannot be formally tested. However, Atristain et al. (2024) build indirect confidence in several ways: the control sites are ecologically comparable to the impact sites within the same protected catchment; the recovery signal is consistent across all four community metrics; and the effect is strongest at I1 and I2, the sites nearest the dam, which is the spatial gradient expected from a causal dam-proximity effect rather than a coincidental background trend unrelated to the intervention.

Statistical Assumptions

The parallel trends assumption is the most vulnerable. With only one pre-treatment observation per site, we cannot distinguish between “impact sites recovered because of the drawdown” and “impact sites were already on an upward trajectory before 2018 for other reasons.” The indirect evidence described above mitigates but does not eliminate this concern.

Normality and homoscedasticity appear approximately satisfied based on the residual diagnostics in Figure 3. Mild heavy tails in the QQ plot are common in ecological count data and are unlikely to substantially affect inference at this sample size.

The random effects structure is limited by the number of sites: with only 4 sites per group, the random intercept variance is estimated from few clusters. This can lead to underestimation of between-site variance and potentially anticonservative fixed-effect inference. A sensitivity analysis using site-level means rather than replicate-level data would be informative.

SUTVA (no spillover) is well-supported. Control sites C2-C4 are in separate tributaries physically isolated from the drawdown reach by ridge topography, and C1 is located upstream of the dam, making downstream sediment or chemical effects on control communities implausible.

Sampling & External Validity

The study sampled 8 stream sites in a single protected headwater catchment in Basque Country, Spain, with 5 random Surber net samples per site per period. Results apply most directly to sites with similar characteristics: temperate, forested, protected headwater streams with comparable dam height and reservoir volume. Dam removal in urban, agricultural, or arid-region streams may produce different recovery dynamics due to differences in sediment loads, non-native species pressure, and altered flow regimes.

The time scale is also a constraint. Recovery was assessed after only approximately one year post-drawdown (November 2020 sampling). The paper’s conclusion of “rapid recovery” is well-supported for the metrics and species present in the data, but pollution-sensitive taxa, rare species, and organisms with longer generation times may require additional years to recolonize and establish stable populations. Monitoring through 2022 or 2023 would clarify whether the community trajectory continued upward or plateaued after the initial reassembly phase.

Measurement

Taxa richness is a coarse biodiversity measure: it counts taxa present but treats a single individual of a sensitive species identically to 1,000 individuals of a tolerant one. Shannon diversity (H’) partially corrects for this by incorporating relative abundance, which is why including both provides a more complete picture. Surber nets sample a fixed benthic area (0.09 m²) and may undersample mobile or large-bodied invertebrates; because the method is applied consistently across all sites and periods, systematic bias is present but stable and does not confound the DiD estimate. IASPT depends on accurate taxonomic identification to family level; any misidentification error would tend to attenuate the signal rather than inflate it, making significant IASPT results conservative.

Treatment timing introduces one additional measurement concern. The “Drawdown” sampling (October 2019) occurred while the reservoir was still being emptied and sediment mobilization was ongoing, so it does not represent a stable post-treatment state. The positive DiD coefficient at Drawdown therefore likely underestimates the full recovery signal relative to what would be observed after the system fully stabilized, which is why the After coefficient is the primary effect estimate of interest.

Other Limitations

Five Surber net replicates collected within a single site on a single date are not truly independent: they share the same hydrological conditions, substrate patch, and local invertebrate source pool. The random intercept for site partially addresses this by absorbing between-site baseline differences, but within-site spatial autocorrelation among the five replicates is not fully accounted for and likely leads to slightly anticonservative inference.

The paper documents invertebrate recovery but does not directly measure the physical mechanisms driving it. Changes in bed substrate composition, water turbidity, and flow velocity are the most plausible mediating variables, but without direct measurements of these, we know the outcome changed without knowing precisely why. This limits the mechanistic understanding needed to predict recovery dynamics at other dam sites with different physical characteristics.

Finally, no power analysis is reported. With 4 sites per group and 3 time points, the study has limited power to detect moderate treatment effects for metrics with high within-site variability. The statistically significant results for all four outcomes are reassuring, but weaker or null results for any individual metric might represent false negatives rather than genuine absence of recovery.

Recommendations for Future Research

Future studies of dam removal ecology could address several of these limitations directly. Extended post-removal monitoring spanning 3-5 years would allow assessment of whether rapid recovery is sustained and whether slower-responding taxa eventually recolonize. Pairing biological sampling with concurrent physical habitat measurements (grain size distribution, turbidity, water temperature, fine sediment cover) would help identify the mechanisms linking reservoir drawdown to community recovery, allowing researchers to model the pathway from physical change to biological response rather than treating recovery as a black box. Replication across additional dam removals spanning different stream types, land-use contexts, and climate zones would improve the generalizability of results beyond a single protected headwater catchment in northern Spain. Finally, beginning monitoring with multiple pre-treatment sampling years before dam removal would allow a formal test of the parallel trends assumption, which is the central threat to causal identification in any DiD-based design.

Table Browser

The 50+ FIADB tables are organized into categories pulled from the user guide - Location Level, Tree Level, Invasive/Understory Vegetation, Down Woody Material, Population, Reference - rather than alphabetically. Alphabetical is how a database shows you tables. Categorical is how a researcher looks for them.

TABLE_CATEGORIES: dict[str, list[str]] = {
    "Location Level": [
        "SURVEY", "PROJECT", "COUNTY", "PLOT", "COND",
        "SUBPLOT", "SUBP_COND", "BOUNDARY", "SUBP_COND_CHNG_MTRX",
    ],
    "Tree Level": [
        "TREE", "TREE_WOODLAND_STEMS", "TREE_GRM_COMPONENT",
        "TREE_GRM_THRESHOLD", "TREE_GRM_MIDPT", "TREE_GRM_BEGIN",
        "TREE_GRM_ESTN", "BEGINEND", "SEEDLING", "SITETREE",
    ],
    "Reference": [
        "REF_SPECIES", "REF_FOREST_TYPE", "REF_DAMAGE_AGENT",
        "REF_FOREST_TYPE_GROUP", "REF_SPECIES_GROUP",
        # ...
    ],
    # ...
}

Select a table, and the sidebar shows column names, types, and which are primary keys - no rows loaded.

Field Codebook

A hardcoded reference for the code columns that come up constantly:

Having these in one place saves reopening the user guide every 20 minutes.

Relationship Diagram

The feature I wish had existed when I started. The interactive graph shows foreign key relationships between tables, rendered with PyVis - hover over an edge to see exactly which columns link which tables. If PyVis isn’t available, it falls back to a static Graphviz diagram.

from pyvis.network import Network

def build_relationship_graph(fk_info: dict) -> str:
    net = Network(height="600px", width="100%", directed=True)
    net.set_options('{"physics": {"solver": "forceAtlas2Based"}}')

    for table, foreign_keys in fk_info.items():
        net.add_node(table, label=table, shape="box")
        for fk in foreign_keys:
            net.add_edge(
                table,
                fk["referred_table"],
                title=f"{fk['constrained_columns']} → {fk['referred_columns']}",
            )
    return net.generate_html()

Understanding that TREE_GRM_COMPONENT → TREE via TRE_CN, for example, would have saved me a few confused hours if I’d had this diagram at the start.

SQL Templates

Pre-built query patterns for common analyses - basal area by species over time, mortality by cause code, seedling counts, forest type composition. The TREE_GRM_COMPONENT → TREE join in the mortality template is the kind of thing that’s easy to miss from the user guide alone.

SQL_TEMPLATES = {
    "Basal area by species over time": """
SELECT
    p.STATECD, p.LAT, p.LON,
    t.INVYR, t.SPCD,
    SUM(0.005454 * t.DIA * t.DIA * t.TPA_UNADJ) AS ba_per_acre
FROM TREE t
JOIN PLOT p ON t.PLT_CN = p.CN
JOIN COND c ON c.PLT_CN = t.PLT_CN AND c.CONDID = t.CONDID
WHERE t.STATUSCD = 1          -- live trees only
  AND t.DIA >= 1.0
  AND c.COND_STATUS_CD = 1    -- forested conditions only
GROUP BY p.STATECD, p.LAT, p.LON, t.INVYR, t.SPCD;
""",
    "Mortality by cause code": """
SELECT
    t.INVYR, t.AGENTCD, t.SPCD,
    SUM(grm.MICR_TPAMORT_UNADJ_AL_FOREST) AS tpa_mortality
FROM TREE_GRM_COMPONENT grm
JOIN TREE t ON grm.TRE_CN = t.CN   -- GRM links to TREE, not PLOT
WHERE grm.MICR_COMPONENT_AL_FOREST IN ('MORTALITY1','MORTALITY2')
  AND grm.MICR_TPAMORT_UNADJ_AL_FOREST > 0
GROUP BY t.INVYR, t.AGENTCD, t.SPCD;
""",
}

Visualizing the Compiled Data

Open the FIA Compiled Data Explorer

The FIA Compiled Data Explorer is for checking and exploring processed outputs, not raw schema. It reads the compiled FIA summaries produced in the forest-data-compilation.Rproj workflow, then surfaces them in map and chart views for QA and exploratory analysis.

The Full Project

Open the Full Forest Data Compilation Dashboard

The full project dashboard pulls the same idea one level up, combining FIA outputs with IDS and climate products in one place.

It Only Copies What You Need

new_event = {
    'summary': event.get('summary', ''),
    'description': build_description(event),
    'start': event.get('start'),
    'end': event.get('end'),
}

# Notice what's NOT here: attendees

The script strips out attendee information by default. If you need to know who was on the original event, it extracts that as plain text and puts it in the description. Information preserved, nobody gets accidentally emailed.

(More on why that matters in a second.)

Safety Features That Turned Out to Be Essential

Test before you commit: You can copy a single event first to make sure everything works.

# Preview what would happen
python copy_calendar.py copy --dry-run

# Copy just one event to test
python copy_calendar.py copy --test

# Copy only through a specific date (inclusive)
python copy_calendar.py copy --until 2026-06-30

# Actually do it
python copy_calendar.py copy

Easy cleanup: Every copied event gets [copied_from_external] prepended to its description. If something goes wrong, you can delete all copied events with one command:

python copy_calendar.py delete

No duplicates: Run it twice by accident? The script checks existing events and skips ones that are already there.

Smart filtering: Only copies future events (365 days forward by default), and you can cap runs with --until YYYY-MM-DD when you want a shorter window.

The 2021 Texas Winter Storm Crisis

The February 2021 winter storm, known as Winter Storm Uri, exposed critical vulnerabilities in Texas’s isolated power grid. Unlike other states, Texas operates its own grid (ERCOT), which is not connected to neighboring states, limiting backup power options during emergencies. The unprecedented cold caused natural gas pipelines to freeze, wind turbines to ice over, and power plants to fail, creating a cascading crisis.

While the blackouts affected millions of Texans, their impacts were not uniformly distributed. Previous research on climate disasters has shown that low-income communities and communities of color often experience disproportionate impacts from extreme weather events. These communities may face longer recovery times, limited access to emergency resources, and inadequate infrastructure.

Remote Sensing for Disaster Assessment

Satellite-based night lights data provides a powerful tool for assessing power outages at scale. NASA’s Visible Infrared Imaging Radiometer Suite (VIIRS) captures daily nighttime light emissions, allowing researchers to detect changes in electrical grid function. By comparing light intensity before and after disasters, we can identify affected areas without relying solely on utility company reports, which may be incomplete during major crises.

This analysis combines VIIRS night lights data with OpenStreetMap building footprints and U.S. Census socioeconomic data to map blackout impacts and explore potential environmental justice dimensions of the 2021 Texas blackouts.

Data Sources

This analysis integrates four primary datasets:

VIIRS Night Lights Data - NASA’s VIIRS instrument provides daily measurements of nighttime light intensity. I used two dates of imagery: February 7, 2021 (before the storm) and February 16, 2021 (during the height of the blackouts). The data is measured in nanowatts per square centimeter per steradian (nW cm⁻²sr⁻¹) (NASA LAADS DAAC 2021).

OpenStreetMap Building Footprints - Residential building polygons for the Houston metropolitan area, including houses, apartments, and other residential structures (OpenStreetMap Contributors 2021).

OpenStreetMap Road Network - Highway and major road data used to filter out areas where reduced light may be due to decreased traffic rather than power outages (OpenStreetMap Contributors 2021).

U.S. Census American Community Survey - 2015-2019 five-year estimates at the census tract level, including median household income data (U.S. Census Bureau 2019).

Analytical Approach

# Load required packages
library(tidyverse)      # Data manipulation and visualization
library(sf)             # Spatial data handling
library(here)           # File path management
library(terra)          # Raster data processing
library(stars)          # Spatiotemporal arrays
library(tmap)           # Thematic mapping
library(kableExtra)     # Table formatting

The analysis follows these steps:

1. Load and prepare spatial data - Read VIIRS night lights tiles, building footprints, road networks, and census data
2. Calculate light intensity changes - Compare pre- and post-storm imagery to identify areas with significant light reduction
3. Define blackout threshold - Classify areas with light intensity drops >200 nW cm⁻²sr⁻¹ as experiencing blackouts
4. Filter highway corridors - Exclude areas within 200m of major highways to avoid misidentifying reduced traffic as power outages
5. Identify impacted buildings - Intersect blackout areas with residential building footprints
6. Analyze socioeconomic patterns - Compare median household income distributions between census tracts with and without blackouts

Loading and Preparing the Data

# Load VIIRS night lights raster tiles for Houston area
# February 7, 2021 (pre-storm)

VIIRS_07a <- rast(here("posts/eds223-final/data/VNP46A1/VNP46A1.A2021038.h08v05.001.2021039064328.tif"))
VIIRS_07b <- rast(here("posts/eds223-final/data/VNP46A1/VNP46A1.A2021038.h08v06.001.2021039064329.tif"))

# February 16, 2021 (during blackouts)
VIIRS_16a <- rast(here("posts/eds223-final/data/VNP46A1/VNP46A1.A2021047.h08v05.001.2021048091106.tif"))
VIIRS_16b <- rast(here("posts/eds223-final/data/VNP46A1/VNP46A1.A2021047.h08v06.001.2021048091105.tif"))

# Load OpenStreetMap highways (motorways only)
highways <- st_read(here("posts/eds223-final/data/gis_osm_roads_free_1.gpkg/gis_osm_roads_free_1.gpkg"),
                    query = "SELECT * FROM gis_osm_roads_free_1 WHERE fclass='motorway'",
                    quiet = TRUE)

# Load OpenStreetMap residential buildings
houses <- st_read(here("posts/eds223-final/data/gis_osm_buildings_a_free_1.gpkg/gis_osm_buildings_a_free_1.gpkg"),
                  query = "SELECT * FROM gis_osm_buildings_a_free_1
                           WHERE (type IS NULL AND name IS NULL)
                           OR type in ('residential', 'apartments', 'house', 'static_caravan', 'detached')",
                  quiet = TRUE)

# Load Census ACS data - requires joining geometry with income attributes
socio_geom <- st_read(here("posts/eds223-final/data/ACS_2019_5YR_TRACT_48_TEXAS.gdb/"),
                      layer = "ACS_2019_5YR_TRACT_48_TEXAS", quiet = TRUE)

socio_income <- st_read(here("posts/eds223-final/data/ACS_2019_5YR_TRACT_48_TEXAS.gdb/"),
                        layer = "X19_INCOME", quiet = TRUE)

# Join income data to geometries and reproject to match building data
socio <- socio_geom %>%
  rename("GEOID_Data" = "GEOID_Data") %>%
  left_join(socio_income %>% rename("GEOID_Data" = "GEOID"), by = "GEOID_Data") %>%
  st_transform(st_crs(houses))

All datasets use different coordinate reference systems initially, so I standardized them to EPSG:3083 (NAD83 / Texas Centric Albers Equal Area), which preserves area measurements needed for accurate spatial analysis.

Visualizing the Blackouts: Before and After

The stark difference in nighttime light emissions reveals the massive scale of the power outages across Houston.

# Merge VIIRS tiles for each date
VIIRS_07 <- merge(VIIRS_07a, VIIRS_07b)  # Pre-storm
VIIRS_16 <- merge(VIIRS_16a, VIIRS_16b)  # During blackouts

# Define Houston bounding box
HOUSTON_BBOX <- st_bbox(c(xmin = -96.5, ymin = 29,
                          xmax = -94.5, ymax = 30.5),
                        crs = st_crs(VIIRS_07))

# Crop to Houston area
crop_07 <- crop(VIIRS_07, HOUSTON_BBOX)
crop_16 <- crop(VIIRS_16, HOUSTON_BBOX)

# Mask unrealistic values (>1000 or ≤0)
masked_07 <- crop_07
masked_07[(masked_07 > 1000) | (masked_07 <= 0)] <- NA

masked_16 <- crop_16
masked_16[(masked_16 > 1000) | (masked_16 <= 0)] <- NA

# Combine for side-by-side comparison
combined_crop <- c(masked_07, masked_16)
names(combined_crop) <- c("February 7, 2021 (Before)", "February 16, 2021 (After)")

tm_shape(combined_crop) +
  tm_raster(col.scale = tm_scale(values = "inferno"),
            col.legend = tm_legend(title = "Light Intensity\n(nW cm⁻²sr⁻¹)",
                                   title.size = 0.9,
                                   text.size = 0.6)) +
  tm_facets(ncol = 2, free.scales = FALSE) +
  tm_title("Houston Night Lights: Before and After the Storm", size = 1.2) +
  tm_layout(legend.outside = TRUE,
            legend.outside.position = "right",
            legend.outside.size = 0.12,
            panel.labels = c("February 7 (Before)", "February 16 (After)"),
            fontfamily = "sans") +
  tm_graticules(lwd = 0.2, col = "white", alpha = 0.3, labels.size = 0.5)

The comparison reveals significant light reduction across much of the Houston metropolitan area. The bright urban core visible on February 7 dims substantially by February 16, indicating widespread power failures.

Identifying Blackout Areas

To systematically identify blackout zones, I calculated the difference in light intensity and classified areas with drops greater than 200 nW cm⁻²sr⁻¹ as experiencing blackouts.

# Calculate light intensity difference
VIIRS_houston_diff <- VIIRS_07 - VIIRS_16

# Classify blackout areas (drops >200 as blackouts)
blackout_mask <- classify(VIIRS_houston_diff,
                         matrix(c(-Inf, 200, NA,  # Not a blackout
                                  200, Inf, 1),   # Blackout
                                ncol = 3, byrow = TRUE))

# Convert raster to vector polygons
blackout_vector <- st_as_stars(blackout_mask) %>%
  st_as_sf() %>%
  st_make_valid()

# Crop to Houston and reproject
blackout_houston <- st_crop(blackout_vector, HOUSTON_BBOX) %>%
  st_transform(crs = 3083)

road_color <- "#FDB863"
fill_color <- "#d62728"
border_color <- "#8b0000"

blackout_houston_union <- st_union(blackout_houston)

tm_basemap("CartoDB.VoyagerNoLabels") +
  tm_shape(blackout_houston_union) +
  tm_polygons(fill = fill_color,
              col = border_color,
              lwd = 0.5) +
  tm_title("Detected Blackout Areas in Houston", size = 1.2) +
  tm_add_legend(type = "polygons",
                fill = fill_color,
                col = border_color,
                border.lwd = 0.5,
                labels = "Blackout Areas",
                title = "") +
  tm_layout(legend.position = c("right", "bottom"),
            legend.bg.color = "white",
            legend.bg.alpha = 0.8,
            text.fontfamily = "sans") +
  tm_scalebar(position = c("left", "bottom"), text.size = 0.6) +
  tm_compass(position = c("right", "top"), size = 1.5)

Refining the Analysis: Excluding Highways

Major highways may show reduced light intensity due to decreased traffic rather than residential power outages. To improve accuracy, I excluded areas within 200 meters of motorways.

# Reproject highways and create 200m buffer
highways <- st_transform(highways, crs = 3083)
highway_buffer <- highways %>%
  st_union() %>%
  st_buffer(dist = 200)

# Remove highway buffers from blackout areas
blackout_final <- st_difference(blackout_houston, highway_buffer)

# Visualize the highway exclusion process
tm_basemap("CartoDB.VoyagerNoLabels") +
  tm_shape(highways) +
  tm_lines(col = road_color,
           lwd = 2) +
  tm_shape(st_union(blackout_final)) +
  tm_polygons(fill = fill_color,
              col = "#4d0000",
              lwd = 0.5) +
  tm_add_legend(type = "polygons",
                labels = "Refined blackout areas (highways excluded)",
                fill = fill_color) +
  tm_add_legend(type = "lines",
                labels = "Major highways",
                col = road_color,
                lwd = 2) +
  tm_title("Highway Corridor Exclusion", size = 1.2) +
  tm_layout(legend.position = c("left", "top"),
            legend.bg.color = "white",
            legend.bg.alpha = 0.85,
            legend.text.size = 0.65,
            text.fontfamily = "sans") +
  tm_scalebar(position = c("right", "bottom"), text.size = 0.6) +
  tm_compass(position = c("right", "top"), size = 1.5)

This refinement helps ensure we’re identifying genuine residential power outages rather than changes in traffic patterns.

Quantifying Residential Impacts

By intersecting the blackout areas with residential building footprints, we can estimate how many homes lost power.

# Reproject buildings and identify those in blackout zones
houses <- st_transform(houses, crs = 3083)
blackout_homes <- st_intersection(houses, blackout_final)

# Calculate statistics
n_blackout_homes <- length(unique(blackout_homes$osm_id))
n_total_homes <- nrow(houses)
pct_impacted <- round((n_blackout_homes / n_total_homes) * 100, 1)

Finding: Approximately 157,410 residential buildings (33.1% of structures in the dataset) experienced blackouts during the February 2021 storms.

# Create point representations for mapping
all_homes_points <- st_centroid(houses)
not_impacted_homes <- all_homes_points[!all_homes_points$osm_id %in% blackout_homes$osm_id, ]
impacted_homes_points <- st_centroid(blackout_homes)

tm_basemap("CartoDB.VoyagerNoLabels") +
  tm_shape(blackout_final) +
  tm_polygons(fill = "grey85", col = "grey70", lwd = 0.3) +
  tm_shape(not_impacted_homes) +
  tm_dots(fill = "#FFB3B3", size = 0.003, fill_alpha = 0.1) +
  tm_shape(impacted_homes_points) +
  tm_dots(fill = "#8B0000", size = 0.005, fill_alpha = 0.7) +
  tm_title("Residential Buildings Impacted by Blackouts", size = 1.3) +
  tm_layout(legend.outside = FALSE,
            legend.position = c("left", "top"),
            legend.bg.color = "white",
            legend.bg.alpha = 0.85,
            legend.text.size = 0.7,
            legend.title.size = 0.9,
            fontfamily = "sans") +
  tm_add_legend(type = "fill",
                labels = "Blackout zone",
                fill = "grey85",
                col = "grey70") +
  tm_add_legend(type = "symbol",
                labels = c("Power lost", "Power maintained"),
                fill = c("#8B0000", "#FFB3B3"),
                shape = 19,
                size = 0.5) +
  tm_scalebar(position = c("right", "bottom"), text.size = 0.6) +
  tm_compass(position = c("right", "top"), size = 1.5)

The map reveals that blackouts were widespread but not uniform. Some neighborhoods maintained power while adjacent areas went dark, suggesting the complexity of the grid failures.

Socioeconomic Analysis: Income and Blackout Exposure

Understanding where blackouts occurred is only part of the story. To assess whether impacts were distributed equitably, I aggregated affected buildings by census tract and examined their relationship to median household income. This tract-level analysis reveals whether certain communities bore a disproportionate burden during the crisis.

# Transform census data to analysis CRS
socio <- st_transform(socio, crs = 3083)

# Crop to Houston area
houston_tracts <- st_crop(socio, st_bbox(blackout_houston))

# Count impacted homes per tract
houston_tracts$n_homes <- as.numeric(lengths(st_intersects(houston_tracts, blackout_homes)))

# Create impact categories for mapping
houston_tracts$impact_category <- cut(houston_tracts$n_homes,
                                       breaks = c(0, 1, 10, 50, 150, 500, 1500, Inf),
                                       labels = c("None",
                                                 "Very Low (1-10)",
                                                 "Low (11-50)",
                                                 "Medium (51-150)",
                                                 "High (151-500)",
                                                 "Very High (501-1,500)",
                                                 "Extreme (>1,500)"),
                                       include.lowest = TRUE)

# Create binary blackout indicator
houston_tracts$blackout <- factor(houston_tracts$n_homes > 0,
                                  levels = c(TRUE, FALSE),
                                  labels = c("Blackout", "No Blackout"))

# Transform tracts to match crs of basemap (this is done automatically by tmap, code included for transparency)
houston_tracts_proj <- st_transform(houston_tracts, crs = 3857)

# Plot houses in census tracts affected by blackouts
tm_basemap("CartoDB.VoyagerNoLabels") +
  tm_shape(houston_tracts_proj) +
  tm_fill(fill = "impact_category",
          fill.scale = tm_scale(values = c("white", "#feedde", "#fdd0a2", "#fdae6b",
                                          "#fd8d3c", "#e6550d", "#a63603"),
                                value.na = "transparent"),
          fill.legend = tm_legend(title = "Impacted Homes\nper Census Tract",
                                  title.size = 0.9,
                                  text.size = 0.65)) +
  tm_borders(col = "grey50", lwd = 0.3) +
  tm_title("Blackout Severity by Census Tract", size = 1.3) +
  tm_scalebar(position = c("left", "bottom"), text.size = 0.6) +
  tm_compass(position = c("left", "top"), size = 1.5) +
  tm_layout(legend.outside = FALSE,
            legend.position = c("right", "top"),
            legend.bg.color = "white",
            legend.bg.alpha = 0.85,
            text.fontfamily = "sans")

The census tract analysis reveals substantial variation in blackout severity. Some tracts lost power for more than 1,500 residential buildings, while others experienced minimal disruption. This raises a critical question: were certain communities disproportionately affected?

Previous research on climate disasters shows that low-income communities and communities of color often experience greater exposure and more severe impacts. To investigate whether similar patterns emerged during the Texas blackouts, I analyzed the relationship between median household income and blackout exposure.

houston_tracts_no_na <- houston_tracts %>%
  filter(!is.na(B19013e1))

ggplot(houston_tracts_no_na, aes(x = blackout, y = B19013e1, fill = blackout)) +
  geom_boxplot(alpha = 0.75, outlier.alpha = 0.5) +
  scale_fill_manual(name = "Blackout Status",
                    values = c("Blackout" = "#d62728",
                               "No Blackout" = "#7f7f7f")) +
  scale_y_continuous(labels = scales::dollar_format(),
                    breaks = seq(0, 250000, 50000)) +
  labs(title = "Median Household Income by Blackout Status",
       subtitle = "Houston Metropolitan Area Census Tracts (2015-2019 ACS)",
       x = "",
       y = "Median Household Income",
       caption = "Source: U.S. Census Bureau American Community Survey") +
  theme_minimal(base_size = 12, base_family = "sans") +
  theme(legend.position = "none",
        plot.title = element_text(size = 14, face = "bold", hjust = 0),
        plot.subtitle = element_text(size = 11, hjust = 0),
        panel.grid.minor = element_blank())

income_stats <- houston_tracts %>%
  st_drop_geometry() %>%
  filter(!is.na(B19013e1)) %>%
  group_by(blackout) %>%
  summarise(
    `Census Tracts` = n(),
    `Median Income` = scales::dollar(median(B19013e1)),
    `Mean Income` = scales::dollar(mean(B19013e1)),
    `Standard Deviation` = scales::dollar(sd(B19013e1))
  )

kable(income_stats,
      caption = "Table 1: Income Statistics by Blackout Status",
      align = c("l", "r", "r", "r", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                position = "left")

Key Finding: Census tracts that experienced blackouts had a median household income of 60,435, compared to 57,385 for tracts without blackouts. The difference of approximately $3,000 represents only about 5% variation, suggesting that income level was not a strong predictor of blackout exposure in this event.

Main Findings

This analysis identified approximately 157,410 residential buildings (33.1% of the study area) that lost power during the February 2021 storms. Unlike typical climate disasters, blackout exposure showed minimal income-based disparities-tracts with and without blackouts had median incomes differing by only ~$3,000 (5%). This likely reflects the systemic nature of the grid failure: when the entire system collapsed, infrastructure vulnerabilities crossed neighborhood boundaries.

However, exposure differs from impact. Low-income communities faced greater difficulty evacuating, accessing backup heating, and recovering-even when blackout rates were similar (Gronlund 2014).

Limitations

Temporal resolution: Two snapshots cannot capture outage duration, which may vary by neighborhood.

Threshold sensitivity: The 200 nW cm⁻²sr⁻¹ cutoff is somewhat arbitrary and may miss some outages.

Data gaps: OpenStreetMap building coverage varies geographically, potentially introducing spatial bias.

Highway exclusion: The 200m buffer may inadvertently exclude legitimate residential blackouts.

Future work should incorporate daily time series data, analyze additional socioeconomic indicators, integrate health outcomes, and ground-truth results with utility records.

Policy Implications

The widespread blackouts indicate systemic vulnerabilities requiring comprehensive infrastructure winterization. Even when disasters affect communities uniformly, emergency response must account for differential vulnerabilities. Texas’s grid isolation limited backup options during the crisis, suggesting value in regional interconnection. Remote sensing approaches can provide rapid, independent disaster assessment to complement utility reporting.

Landsat 8 Surface Reflectance Data

This dataset contains atmospherically corrected surface reflectance data from the Landsat 8 satellite, captured on February 23, 2025 (Microsoft Planetary Computer 2025). The imagery includes five spectral bands (red, green, blue, near-infrared, and shortwave infrared) clipped to the area surrounding the Eaton and Palisades fire perimeters. The data was retrieved from the Microsoft Planetary Computer STAC catalog in NetCDF format.

Fire Perimeter Shapefiles

These shapefiles delineate the official fire perimeters for the Eaton and Palisades fires as of January 21, 2025 (ArcGIS Hub 2025). The vector data includes boundary geometries and attribute information for each fire.

Environmental Justice Index (EJI) Data

The CDC/ATSDR Environmental Justice Index (Centers for Disease Control and Prevention and Agency for Toxic Substances and Disease Registry 2024) provides census tract-level demographic and socioeconomic data. This analysis uses the 2024 California EJI dataset to examine the racial composition of fire-affected communities through minority population percentile rankings.

Setup and Data Import

# Import required libraries for geospatial analysis and visualization
import xarray as xr
import rioxarray as rio
import geopandas as gpd
import pandas as pd
import numpy as np
import matplotlib.pyplot as plt

Loading Fire Perimeter Data

Fire perimeters provide the spatial boundaries for our analysis, allowing us to focus on the areas most affected by the fires.

# Load fire perimeter shapefiles
eaton = gpd.read_file('data/Eaton_Perimeter_20250121.shp')
palisades = gpd.read_file('data/Palisades_Perimeter_20250121.shp')

# Create summary table for data exploration
summary_data = {
    'Dataset': ['Eaton Fire', 'Palisades Fire'],
    'Features': [len(eaton), len(palisades)],
    'Columns': [len(eaton.columns), len(palisades.columns)],
    'Geometry Type': [eaton.geometry.type.unique()[0], palisades.geometry.type.unique()[0]]
}

summary_df = pd.DataFrame(summary_data)

# Display as formatted table
summary_df

Both datasets contain polygon geometries representing the fire boundaries, along with area and perimeter measurements.

# Create CRS information table
crs_data = {
    'Dataset': ['Eaton Fire', 'Palisades Fire'],
    'CRS Code': [eaton.crs.to_authority()[1] if eaton.crs.to_authority() else 'N/A',
                 palisades.crs.to_authority()[1] if palisades.crs.to_authority() else 'N/A'],
    'Projection Type': ['Geographic' if eaton.crs.is_geographic else 'Projected',
                       'Geographic' if palisades.crs.is_geographic else 'Projected']
}

crs_df = pd.DataFrame(crs_data)

# Display as formatted table
crs_df

Loading and Processing Landsat Imagery

The Landsat 8 scene contains multiple spectral bands that capture different wavelengths of reflected light. Each band provides unique information about surface features.

# Import Landsat data
landsat = xr.open_dataset('data/landsat8-2025-02-23-palisades-eaton.nc')

# Create Landsat dataset summary table
landsat_summary = {
    'Property': ['Dimensions', 'Height (y)', 'Width (x)', 'Coordinates', 'Data Variables'],
    'Value': [
        f"{len(landsat.dims)}D",
        f"{landsat.dims['y']} pixels",
        f"{landsat.dims['x']} pixels",
        ', '.join(list(landsat.coords)),
        ', '.join([v for v in landsat.data_vars if v != 'spatial_ref'])
    ]
}

landsat_df = pd.DataFrame(landsat_summary)

# Display as formatted table
landsat_df

The dataset spans 1418 × 2742 pixels and contains five spectral bands: red, green, blue, nir08, swir22.

# Recover the geospatial information from spatial_ref
landsat = landsat.rio.write_crs(landsat.spatial_ref.crs_wkt)

# Check for NaN values in each band
bands = ['red', 'green', 'blue', 'nir08', 'swir22']
nan_status = []

for band in bands:
    has_nan = np.isnan(landsat[band]).any().values
    nan_count = np.isnan(landsat[band]).sum().values
    nan_status.append({
        'Band': band.upper(),
        'Contains NaN': 'Yes' if has_nan else 'No',
        'NaN Count': int(nan_count)
    })

nan_df = pd.DataFrame(nan_status)

# Display as formatted table
nan_df

# Fill NaN values with 0
landsat = landsat.fillna(0)

True Color Visualization

Before creating specialized visualizations, we can verify our data by creating a true color image using the red, green, and blue bands-similar to how a standard camera would capture the scene.

# Create true color composite with robust scaling
# Coarsen by factor of 4 to reduce memory usage
landsat_viz = landsat[['red', 'green', 'blue']].coarsen(x=4, y=4, boundary='trim').mean()
landsat_viz.to_array().plot.imshow(robust=True)
plt.title('True Color Image - Landsat 8')
plt.tight_layout()

The robust=True parameter clips extreme outlier values to improve visualization, preventing a few bright pixels from washing out the entire image.

False Color Analysis

False color composites use non-visible wavelengths to reveal features invisible to the human eye. By assigning shortwave infrared (SWIR) to red, near-infrared (NIR) to green, and red to blue, we create an image where healthy vegetation appears bright green and burned areas show distinct reddish-brown tones.

# Create false color composite (SWIR/NIR/Red)
# Coarsen by factor of 4 to reduce memory usage
landsat_false = landsat[['swir22', 'nir08', 'red']].coarsen(x=4, y=4, boundary='trim').mean()
landsat_false.to_array().plot.imshow(robust=True)
plt.title('False Color Composite (SWIR/NIR/Red)')
plt.tight_layout()

Why this band combination?

• Healthy vegetation has high NIR reflectance and low SWIR reflectance → appears bright green
• Burned areas have low NIR reflectance and moderate SWIR reflectance → appears reddish-brown
• Urban areas show moderate reflectance across bands → appears in neutral tones

Creating the Final Map

To provide geographic context, we overlay the fire perimeters onto our false color image. This requires reprojecting the vector data to match the raster’s coordinate system (EPSG:32611 - UTM Zone 11N).

# Reproject fire perimeters to match Landsat CRS
eaton = eaton.to_crs(landsat.rio.crs)
palisades = palisades.to_crs(landsat.rio.crs)

# Create comprehensive map
fig, ax = plt.subplots(figsize = (12, 12))

# Plot false color composite (downsampled for memory efficiency)
landsat_map = landsat[['swir22', 'nir08', 'red']].coarsen(x=4, y=4, boundary='trim').mean()
landsat_map.to_array().plot.imshow(
    ax = ax,
    robust = True,
    add_colorbar = False
)

# Overlay fire perimeters
eaton.boundary.plot(ax = ax, edgecolor = 'yellow', linewidth = 2, label = 'Eaton Fire')
palisades.boundary.plot(ax = ax, edgecolor = 'red', linewidth = 2, label = 'Palisades Fire')

# Add labels and formatting
plt.title('Eaton and Palisades Fires - False Color Analysis',
          fontsize = 20, fontweight = 'bold', pad = 20)
plt.legend(loc = 'upper right', fontsize = 14)
ax.set_xlabel('Easting (meters)', fontsize = 14)
ax.set_ylabel('Northing (meters)', fontsize = 14)

# Add fire name annotations
ax.text(eaton.geometry.centroid.x.values[0],
        eaton.geometry.centroid.y.values[0] - 2700,
        'Eaton Fire',
        color = 'black', fontsize = 14, fontweight = 'bold',
        bbox = dict(boxstyle = 'round', facecolor = 'white', alpha = 0.7))

ax.text(palisades.geometry.centroid.x.values[0] - 22000,
        palisades.geometry.centroid.y.values[0] + 8000,
        'Palisades Fire',
        color = 'black', fontsize = 14, fontweight = 'bold',
        bbox = dict(boxstyle = 'round', facecolor = 'white', alpha = 0.7))

plt.tight_layout()
plt.show()

Figure Interpretation

This false color composite displays the Eaton and Palisades fire areas captured by Landsat 8 on February 23, 2025. The image uses shortwave infrared (SWIR), near-infrared (NIR), and red bands to highlight burn scars and vegetation health.

Key features:

• Bright green areas = Healthy vegetation (high NIR reflectance)
• Reddish-brown areas = Burned areas and bare soil (low NIR, moderate SWIR)
• Urban/developed areas = Neutral tones (moderate reflectance across bands)

The fire perimeters are overlaid in yellow (Eaton Fire) and red (Palisades Fire) to delineate the official burn boundaries. This false color combination is particularly effective for assessing fire severity and monitoring landscape recovery, as the spectral signatures of healthy vs. burned vegetation are distinctly different in the infrared wavelengths.

Data Preparation

The EJI dataset contains census tract-level data for all of California with 174 columns including demographic, environmental, and health vulnerability indicators. Both the EJI data and fire perimeters use EPSG:3857 (Web Mercator) coordinate reference system.

Identifying Affected Communities

To understand which communities were directly impacted by the fires, we use spatial intersection operations to identify census tracts that overlap with the fire perimeters. We then clip these tracts to the exact fire boundaries, ensuring our analysis focuses only on the areas that experienced direct fire impacts rather than nearby unaffected regions.

Analyzing Racial Composition

The Environmental Justice Index includes percentile rankings for demographic characteristics. Here we examine EPL_MINRTY, which represents the percentile rank of minority population (persons of color)-a measure of racial and ethnic composition relative to other California communities.

fig, (ax1, ax2) = plt.subplots(1, 2, figsize = (18, 9))

# Define variable to analyze
eji_variable = 'EPL_MINRTY'

# Scale values to 0-100 for proper percentile display
eji_clip_palisades_scaled = eji_clip_palisades.copy()
eji_clip_eaton_scaled = eji_clip_eaton.copy()

# Multiply by 100 to convert to percentile
eji_clip_palisades_scaled[eji_variable] = eji_clip_palisades[eji_variable] * 100
eji_clip_eaton_scaled[eji_variable] = eji_clip_eaton[eji_variable] * 100

# Define common scale for comparison (0-100)
vmin = 0
vmax = 100

# Palisades Fire area
eji_clip_palisades_scaled.plot(
    column = eji_variable,
    vmin = vmin, vmax = vmax,
    cmap = 'YlOrRd',
    legend = False,
    ax = ax1,
    edgecolor = 'black',
    linewidth = 0.5
)
ax1.set_title('Minority Population\nPalisades Fire Area', fontsize = 20)
ax1.axis('off')

# Eaton Fire area
eji_clip_eaton_scaled.plot(
    column = eji_variable,
    vmin = vmin, vmax = vmax,
    cmap = 'YlOrRd',
    legend = False,
    ax = ax2,
    edgecolor = 'black',
    linewidth = 0.5
)
ax2.set_title('Minority Population\nEaton Fire Area', fontsize = 20)
ax2.axis('off')

# Overall title
fig.suptitle('Percentile Rank of Minority Population in Fire-Affected Areas', 
fontsize = 25, y = 0.98)

# Shared colorbar
sm = plt.cm.ScalarMappable(
    cmap = 'YlOrRd',
    norm = plt.Normalize(vmin = vmin, vmax = vmax)
)
cbar_ax = fig.add_axes([0.25, 0.12, 0.5, 0.03])
cbar = fig.colorbar(sm, cax = cbar_ax, orientation = 'horizontal')
cbar.set_label('Percentile Rank (0-100)', fontsize = 18)
cbar.ax.tick_params(labelsize=16)

plt.tight_layout()
plt.show()

The Causal Story

Imagine you’re a deer deciding whether to cross a road. Several factors affect your collision risk:

1. Traffic volume: More vehicles = more chances for collision
2. Your habitat: You’re more likely to be near roads that pass through forests or parks
3. Road characteristics: Wider, faster roads are harder to cross safely
4. Human development: You avoid heavily urbanized areas

Visualizing Causal Relationships: The DAG

Now, let’s formalize our deer’s decision-making process with a Directed Acyclic Graph (DAG).

Key relationships:

• Traffic (AADT) directly affects roadkill probability (more vehicles → more collision opportunities)
• Land use influences wildlife presence near roads (forests/parks attract wildlife) as well as road types
• Road type is a common cause affecting traffic volume and speed limits
• Speed limit affects collision severity and driver reaction time
• We control for road type to avoid confounding when estimating traffic effects

NOTE: Without considering wildlife density and surrounding habitats, this model estimates relationships conditional on unobserved wildlife presence, which is approximated using nearby land-use rather than direct population data.

Data Sources

Technical Setup: tidyverse, sf, terra, here, pscl, yaml, patchwork, dagitty, ggdag

library(tidyverse)
library(sf)
library(terra)
library(here)
library(pscl)
library(yaml)
library(patchwork)

# Load configuration
config <- read_yaml(here("posts/eds222-final/config.yml"))

set.seed(config$seed)

CRS_M <- config$crs # EPSG:25832, Denmark ETRS89 / UTM zone 32N

# Denmark bounding box (WGS84)
dk_bbox_wgs84 <- st_bbox(c(
  xmin = config$bbox_xmin,
  ymin = config$bbox_ymin,
  xmax = config$bbox_xmax,
  ymax = config$bbox_ymax
), crs = config$bbox_crs)

# Transform to projected CRS
dk_bbox_proj <- st_transform(st_as_sfc(dk_bbox_wgs84), CRS_M) %>%
  st_bbox()

Data Processing Pipeline

# Load roadkill CSV
road_kill_dk <- read_csv(here(config$roadkill_csv_path)) %>%
    filter(
        country == "Denmark",
        year >= 2017, year <= 2019
    ) %>%
    drop_na(decimalLongitude, decimalLatitude) %>%
    st_as_sf(coords = c("decimalLongitude", "decimalLatitude"), crs = 4326) %>%
    st_transform(CRS_M) %>%
    st_crop(dk_bbox_proj)

# Define cache path for roads data
roads_cache <- here(config$roads_cached_path)

if (file.exists(roads_cache)) {
  cat("Loading roads from cache...\n")
  roads_raw <- readRDS(roads_cache)
} else {
  cat("Cache not found. Loading and processing roads (one-time setup)...\n")

  # Load shapefile
  roads_raw <- st_read(here(config$roads_shp_path), quiet = TRUE) %>%
    st_transform(CRS_M) %>%
    st_crop(dk_bbox_proj)

  # Save to cache
  cat("Saving roads to cache for future runs...\n")
  saveRDS(roads_raw, roads_cache)
  cat("Cache saved:", roads_cache, "\n")
}

# Define cache path for traffic data
traffic_cache <- here(config$traffic_cached_path)

if (file.exists(traffic_cache)) {
  cat("Loading traffic data from cache...\n")
  traffic_raw <- readRDS(traffic_cache)
} else {
  cat("Cache not found. Loading and processing traffic (one-time setup)...\n")

  # Load shapefile
  traffic_raw <- st_read(here(config$traffic_shp_path), quiet = TRUE) %>%
  st_transform(CRS_M) %>%
  st_crop(dk_bbox_proj) %>%
  filter(AAR >= 2017, AAR <= 2019) %>%
  # Average AADT across years for each station
  group_by(geometry) %>%
  summarise(
    AADT = mean(AADT, na.rm = TRUE),
    AAR = "2017-2019",
    .groups = "drop"
  ) %>%
  st_as_sf()

  # Save to cache
  cat("Saving traffic to cache for future runs...\n")
  saveRDS(traffic_raw, traffic_cache)
  cat("Cache saved:", traffic_cache, "\n")
}

# Apply configured threshold
threshold_percentile <- config$distance_threshold_percentile
dist_threshold <- quantile(as.numeric(distances), threshold_percentile)

# Merge traffic data with roads
roads_traf <- car_roads %>%
  mutate(
    nn_dist_m = as.numeric(distances),
    AADT = if_else(nn_dist_m <= dist_threshold,
                   traffic_raw$AADT[nearest_idx],
                   NA_real_)
  )