## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----message=FALSE, warning=FALSE---------------------------------------------
library(griddy)
library(dplyr)
library(ggplot2)
library(sf)
library(sfdep)
library(spData)
library(tidyr)

## ----map-theme, include=FALSE-------------------------------------------------
map_theme <- function() {
  theme_void(base_size = 11) +
    theme(
      legend.position = "bottom",
      plot.title.position = "plot",
      strip.text = element_text(face = "bold")
    )
}

## -----------------------------------------------------------------------------
data(usjoin)

usjoin

## -----------------------------------------------------------------------------
classes <- classify_dynamics(usjoin, name, year, income, k = 5)

class_intervals(classes)

## -----------------------------------------------------------------------------
states <- us_states |>
  st_drop_geometry() |>
  filter(NAME %in% usjoin$name) |>
  pull(NAME)

geom <- us_states |>
  filter(NAME %in% usjoin$name) |>
  arrange(NAME)

## ----fig.alt="Map of contiguous US states showing pooled income classes in 1955 using the same five class intervals estimated from the full 1929 to 2009 panel.", fig.width=6.8, fig.height=4----
class_map <- classes |>
  filter(year == 1955) |>
  left_join(geom |> select(NAME, geometry), by = c("name" = "NAME")) |>
  st_as_sf()

ggplot(class_map) +
  geom_sf(aes(fill = class), color = "white", linewidth = 0.15) +
  scale_fill_viridis_d(option = "C", direction = -1, name = "Income class") +
  coord_sf(datum = NA) +
  labs(
    title = "Pooled classes remain map-ready",
    subtitle = "1955 uses breaks estimated from the full 1929-2009 panel"
  ) +
  map_theme()

## ----fig.alt="Heatmap of classic Markov transition probabilities for US state per-capita income, 1929 to 2009."----
classic <- markov_dynamics(classes, name, year, class)

classic
transition_matrix(classic, "count")
steady_state(classic)

plot_transition_matrix(classic)

## -----------------------------------------------------------------------------
geom <- us_states |>
  filter(NAME %in% usjoin$name) |>
  arrange(NAME) |>
  mutate(
    nb = st_contiguity(geometry),
    wt = st_weights(nb)
  )

panel <- usjoin |>
  filter(name %in% states) |>
  arrange(name, year)

## ----fig.alt="Faceted heatmaps of spatial Markov transition probabilities for US state per-capita income, by spatial-lag quintile."----
spatial <- spatial_markov(panel, name, year, income, geometry = geom, k = 5)

lag_intervals(spatial)
transition_matrix(spatial, "probability", lag_class = "Q1")

plot_spatial_markov(spatial)

## ----fig.alt="Map of contiguous US states showing each state's 1994 spatial-lag income class based on neighboring states.", fig.width=6.8, fig.height=4----
lag_map <- spatial$transitions |>
  filter(from_time == 1994) |>
  distinct(id, lag_class, spatial_lag) |>
  left_join(geom |> select(NAME, geometry), by = c("id" = "NAME")) |>
  st_as_sf()

ggplot(lag_map) +
  geom_sf(aes(fill = lag_class), color = "white", linewidth = 0.15) +
  scale_fill_viridis_d(option = "C", direction = -1, name = "Spatial-lag class") +
  coord_sf(datum = NA) +
  labs(
    title = "Spatial Markov conditions on neighboring-state income",
    subtitle = "Spatial-lag class in 1994"
  ) +
  map_theme()

## ----fig.alt="Map of endpoint rank mobility for US states, 1929 to 2009, with positive values indicating upward rank movement."----
mobility_panel <- usjoin |>
  filter(name %in% states) |>
  left_join(geom |> select(NAME), by = c("name" = "NAME")) |>
  st_as_sf()

mobility <- rank_mobility(mobility_panel, name, year, income)

mobility |>
  st_drop_geometry() |>
  arrange(desc(abs_rank_change)) |>
  select(name, start_rank, end_rank, rank_change) |>
  head()

plot_rank_mobility(mobility) +
  coord_sf(datum = NA) +
  labs(
    title = "Endpoint rank mobility, 1929 to 2009",
    subtitle = "Positive values indicate upward movement in the state income ranking"
  ) +
  map_theme()

## -----------------------------------------------------------------------------
adjacent_mobility <- rank_mobility(panel, name, year, income, compare = "adjacent")

adjacent_mobility |>
  arrange(desc(abs_rank_change)) |>
  select(name, year, to_time, rank_change) |>
  head()

## -----------------------------------------------------------------------------
classic$transitions |> head()
spatial$transitions |> select(id, from_time, to_time, lag_class, transition, spatial_lag) |> head()