# =============================================================================
# Stock transfers between airport terminals: a story in ten figures
# =============================================================================
# Simulates two years of stock transfers between the shops in four airport
# terminals, then draws the figures for a write-up on storytelling with data.
# Every number is simulated.
#
#   Figure 1   fig-01-matrix-overview.png    matrix, plain: a first look
#   Figure 2   fig-02-matrix-story.png       matrix, Terminal 5 picked out
#   Figure 3   fig-03-chord.png              chord, coloured by change (fancy, messy)
#   Figure 4   fig-04-slopegraph.png         slopegraph (plain, clear)
#   Figure 5   fig-05-arcs.png               every shop on one line: watches drive it
#   Figure 6   fig-06-tufte-stock-moved.png  brand by brand: stock moved
#   Figure 7   fig-07-tufte-sent-back.png    ... plus round trips sent back
#   Figure 8   fig-08-watches-sales.png      watch brands: sales per sq ft
#   Figure 9   fig-09-tufte-growth.png       every row: movement vs sales growth
#   Figure 10  fig-10-regression.png         dynamism vs sales growth
#
# Also written, as alternatives for the write-up:
#   alt-08b-watches-numbers.png, alt-08c-watches-bars.png,
#   alt-08d-watches-shaded-bars.png, chord-option-b-chord-of-the-change.png,
#   chord-option-d-stacked-bars.png
#
# Needs R 4.1+ with dplyr 1.1+, purrr 1.0+, tidyr, scales, ggplot2 3.4+,
# patchwork, ggrepel, circlize and ragg. Fonts: Inter and Bitstream Charter
# by default. Any sans and serif will do: set `sans` and `serif` to other
# family names before sourcing the script. The figures carry no numbers, so
# they can be numbered wherever they end up.
# Run with LANG set to a UTF-8 locale so the £ signs and arrows render.
# Writes every PNG into the working directory.

# ---- PART 1. Simulate the data ----------------------------------------------
# Every number here is simulated. The story built in: in year 2 demand for
# watches grows, mostly in Terminal 5; fashion demand falls; everything
# else drifts. Stock that keeps moving is built in as a driver of sales
# growth (see "Dynamism" below), so figure 10 finds a relationship that was
# put there on purpose.

suppressPackageStartupMessages({
  library(dplyr)
  library(purrr)
  library(ggplot2)
  library(patchwork)
})

set.seed(11)

# ---- Simulate two years of transfers and sales -------------------------------

# Share of passengers in each terminal (made up)
footfall <- c("2" = 0.25, "3" = 0.30, "4" = 0.12, "5" = 0.33)

# The terminals each brand trades in, the shop that holds the most stock,
# a typical item price and roughly how many transfers it needs in a year.
# Each category has its own shape: fragrance and beauty is run out of
# Terminal 3, electronics mostly out of Terminal 2.
brands <- tribble(
  ~retailer,       ~category,      ~terminals, ~home, ~price, ~per_year,
  "Watches A",     "Watches",      "2 3 5",    "3",   6500,   300,
  "Watches B",     "Watches",      "3 5",      "3",   9000,   110,
  "Watches C",     "Watches",      "2 3 4 5",  "2",   3500,   130,
  "Fashion A",     "Fashion",      "2 3 5",    "3",   2400,   400,
  "Fashion B",     "Fashion",      "3 5",      "3",   2200,   200,
  "Fashion C",     "Fashion",      "3 5",      "5",   1500,   150,
  "Fashion D",     "Fashion",      "2 3 4 5",  "5",    900,   230,
  "Fashion E",     "Fashion",      "2 5",      "2",   1200,    60,
  "Jeweller",      "Jewellery & accessories", "2 3 4 5", "3", 5200, 180,
  "Sunglasses",    "Jewellery & accessories", "2 3 5",   "2",  450, 150,
  "Pens",          "Jewellery & accessories", "3 5",     "5",  700,  25,
  "Travel goods",  "Jewellery & accessories", "2 5",     "5",  350,  18,
  "Handbags A",    "Bags & leather goods",    "2 3 5",   "3", 2400, 170,
  "Handbags B",    "Bags & leather goods",    "3 5",     "5", 1800, 110,
  "Leather goods", "Bags & leather goods",    "2 3 5",   "2", 2600, 240,
  "Luggage",       "Bags & leather goods",    "2 5",     "5",  900,  20,
  # a transfer of fragrance or beauty is usually a mixed case, not one bottle
  "Fragrance A",   "Fragrance & beauty",      "3 4 5",   "3", 1100, 420,
  "Fragrance B",   "Fragrance & beauty",      "2 3",     "3",  900, 300,
  "Beauty",        "Fragrance & beauty",      "3 5",     "3",  650, 220,
  "Skincare",      "Fragrance & beauty",      "3 4",     "3",  500,  60,
  "Electronics",   "Electronics",  "2 3 5",    "2",    850,   200,
  "Headphones",    "Electronics",  "2 3",      "2",    400,    45,
  "Phone cases",   "Electronics",  "3 4",      "3",     90,    10
)

categories <- c("Watches", "Fashion", "Jewellery & accessories", "Bags & leather goods",
                "Fragrance & beauty", "Electronics")

# Every shop draws customers a little differently from its terminal's
# average, which keeps the routes from looking too regular
taste <- brands |>
  mutate(t = strsplit(terminals, " ")) |>
  tidyr::unnest(t) |>
  mutate(taste = exp(rnorm(n(), 0, 0.8))) |>
  select(retailer, t, taste)

# Year 2: watch demand grows, and most of the growth is in Terminal 5, so
# watch stock has to be sent there; fashion needs ~45% fewer transfers and
# sells ~30% less; the other categories each drift their own way
category_drift <- c(`Jewellery & accessories` = 0.95, `Bags & leather goods` = 1.05,
                    `Fragrance & beauty` = 1.12, Electronics = 1.02)
drift <- exp(rnorm(nrow(brands), 0, 0.1)) *
  coalesce(category_drift[brands$category], 1)
brand_years <- bind_rows(
  mutate(brands, year = 1, t5_pull = 1),
  mutate(
    brands,
    year = 2,
    per_year = case_when(
      category == "Watches" ~ per_year * 1.6,
      category == "Fashion" ~ per_year * 0.55,
      TRUE ~ per_year * drift
    ),
    t5_pull = if_else(category == "Watches", 3.5, 1)
  )
)

simulate_transfers <- function(retailer, terminals, home, price, per_year, year, t5_pull, ...) {
  where <- strsplit(terminals, " ")[[1]]
  depth <- if_else(where == home, 5, 1)
  pull <- if_else(where == "5", t5_pull, 1)
  shop_taste <- taste$taste[taste$retailer == retailer][match(where, taste$t[taste$retailer == retailer])]
  n <- rpois(1, per_year)
  # Requests follow the passengers. A well-stocked shop rarely needs
  # anything brought in, and it is usually the one asked to send.
  to <- sample(where, n, replace = TRUE, prob = footfall[where] * shop_taste * pull / depth)
  from <- map_chr(to, \(dest) {
    options <- setdiff(where, dest)
    if (length(options) == 1) return(options)
    sample(options, 1, prob = depth[match(options, where)])
  })
  tibble(year, retailer, from, to, value = round(rlnorm(n, log(price), 0.6)))
}

transfers <- pmap(brand_years, simulate_transfers) |>
  list_rbind() |>
  left_join(select(brands, retailer, category), by = "retailer")

# Round trips. Some stock sent to Terminal 5 doesn't sell there and is sent
# straight back where it came from: the same goods cross the airport twice.
# Watches A over-supplies Terminal 5 in year 2 and sends a lot back;
# Watches B only sends what Terminal 5 has asked for, so nothing returns.
return_rate <- brands |>
  select(retailer, category) |>
  tidyr::crossing(year = c(1, 2)) |>
  mutate(rate = case_when(
    retailer == "Watches A" ~ if_else(year == 1, 0.10, 0.40),
    retailer == "Watches B" ~ if_else(year == 1, 0.04, 0),
    retailer == "Watches C" ~ if_else(year == 1, 0.08, 0.14),
    # unsold fashion gets sent back more as demand falls
    category == "Fashion" ~ if_else(year == 1, 0.08, 0.11),
    TRUE ~ runif(n(), 0.02, 0.06)
  )) |>
  select(retailer, year, rate)

returns <- transfers |>
  inner_join(return_rate, by = c("retailer", "year")) |>
  filter(to == "5", runif(n()) < rate) |>
  # swap the ends: the goods go back the way they came
  transmute(year, retailer, back_from = to, back_to = from, value, category, returned = TRUE) |>
  rename(from = back_from, to = back_to)

transfers <- bind_rows(mutate(transfers, returned = FALSE), returns)

# Retail space. Watch boutiques are small; fashion and beauty need room.
# The flagship shop of each brand is half as big again.
floor_space <- c(
  "Watches A" = 750, "Watches B" = 900, "Watches C" = 650,
  "Fashion A" = 2600, "Fashion B" = 2200, "Fashion C" = 1800, "Fashion D" = 1500, "Fashion E" = 1100,
  "Jeweller" = 800, "Sunglasses" = 400, "Pens" = 250, "Travel goods" = 600,
  "Handbags A" = 1100, "Handbags B" = 900, "Leather goods" = 1300, "Luggage" = 700,
  "Fragrance A" = 1500, "Fragrance B" = 1200, "Beauty" = 1800, "Skincare" = 500,
  "Electronics" = 1500, "Headphones" = 500, "Phone cases" = 200
)

# ---- Dynamism ---------------------------------------------------------------
# How actively a brand moves its stock around the airport, from 0 to 100.
# Half of it is intensity: the value of stock moved between terminals for
# every pound of sales (capped at 50p). Half is breadth: how many of the 12
# possible terminal-to-terminal routes the brand used.
dynamism_score <- function(moved, sales, routes) {
  100 * (0.5 * pmin(moved / sales / 0.5, 1) + 0.5 * routes / 12)
}

# Sales per square foot a year, in year 1. Watches B starts as the most
# productive watch boutique.
density <- c(
  "Watches A" = 3200, "Watches B" = 3600, "Watches C" = 2400,
  "Fashion A" = 1400, "Fashion B" = 1250, "Fashion C" = 1100, "Fashion D" = 950, "Fashion E" = 900,
  "Jeweller" = 2600, "Sunglasses" = 1300, "Pens" = 900, "Travel goods" = 700,
  "Handbags A" = 2300, "Handbags B" = 1900, "Leather goods" = 1500, "Luggage" = 800,
  "Fragrance A" = 2100, "Fragrance B" = 1700, "Beauty" = 1800, "Skincare" = 1400,
  "Electronics" = 1350, "Headphones" = 1100, "Phone cases" = 800
)

shop_base <- brands |>
  mutate(terminal = strsplit(terminals, " ")) |>
  tidyr::unnest(terminal) |>
  left_join(taste, by = c("retailer", "terminal" = "t")) |>
  mutate(
    sq_ft = floor_space[retailer] * if_else(terminal == home, 1.5, 1),
    base_sales = sq_ft * density[retailer] * (footfall[terminal] / 0.25)^0.5 * taste^0.3
  )

# The assumption the story rests on, built in here: brands that keep stock
# moving convert more of the shoppers who walk in undecided, so their sales
# grow faster, on top of whatever is happening to demand for the category.
category_trend <- c(Watches = 0.12, Fashion = -0.32, `Jewellery & accessories` = 0,
                    `Bags & leather goods` = 0.03, `Fragrance & beauty` = 0.05, Electronics = 0)

brand_dynamism <- transfers |>
  filter(year == 2) |>
  summarise(moved = sum(value), routes = n_distinct(paste(from, to)), .by = retailer) |>
  left_join(summarise(shop_base, base = sum(base_sales), .by = retailer), by = "retailer") |>
  mutate(score = dynamism_score(moved, base, routes))

growth <- brands |>
  left_join(brand_dynamism, by = "retailer") |>
  mutate(g = exp(category_trend[category] + 0.9 * (score / 100 - 0.25) + rnorm(n(), 0, 0.04))) |>
  select(retailer, g)

sales <- shop_base |>
  tidyr::crossing(year = c(1, 2)) |>
  left_join(growth, by = "retailer") |>
  mutate(sales = base_sales * if_else(year == 2, g, 1) * exp(rnorm(n(), 0, 0.06))) |>
  select(year, retailer, category, terminal, home, sales, sq_ft)

# ---- Shared helpers ----------------------------------------------------------

term_label <- function(x) paste0("T", x)
money <- function(x) ifelse(
  x >= 1e6,
  paste0("£", formatC(x / 1e6, format = "f", digits = 1), "m"),
  paste0("£", round(x / 1e3), "k")
)
# Negatives take an en dash: unlike the minus sign, every text face has one
pct <- function(x) ifelse(round(100 * x) == 0, "0%",
                          sub("-", "–", sprintf("%+.0f%%", 100 * x), fixed = TRUE))

rise <- "#1b6ca8"   # watches
fall <- "#d95f02"   # fashion
ink <- "#16191f"
grey <- "#5f656d"

# Faces, and one ground for every figure: the white of the panel it sits on
if (!exists("sans")) sans <- "Inter"
if (!exists("serif")) serif <- "Bitstream Charter"
ground <- "#ffffff"

# ---- PART 2. The ten figures -------------------------------------------------

# =============================================================================
# FIGURE 1. A first look - the terminal-to-terminal matrix, no story yet
# =============================================================================
# Every cell on the same sequential scale, totals sent down the side and
# totals received along the bottom. Nothing is highlighted: this is the
# chart for finding the story, not telling it.

draw_overview_plain <- function() {
  cells <- transfers |>
    filter(year == 2) |>
    summarise(value = sum(value), .by = c(from, to)) |>
    tidyr::complete(from = c("2", "3", "4", "5"), to = c("2", "3", "4", "5")) |>
    mutate(row = factor(from, c("Total", "5", "4", "3", "2")),
           col = factor(to, c("2", "3", "4", "5", "Total")))
  sent <- cells |> summarise(value = sum(value, na.rm = TRUE), .by = from) |>
    mutate(row = factor(from, levels(cells$row)), col = factor("Total", levels(cells$col)))
  received <- cells |> summarise(value = sum(value, na.rm = TRUE), .by = to) |>
    mutate(row = factor("Total", levels(cells$row)), col = factor(to, levels(cells$col)))
  grand <- tibble(value = sum(cells$value, na.rm = TRUE),
                  row = factor("Total", levels(cells$row)), col = factor("Total", levels(cells$col)))
  totals <- bind_rows(sent, received, grand)
  dark <- max(cells$value, na.rm = TRUE) * 0.55

  ggplot(mapping = aes(col, row)) +
    geom_tile(data = filter(cells, !is.na(value)), aes(fill = value), width = 0.95, height = 0.95) +
    geom_tile(data = filter(cells, is.na(value)), fill = "#f6f6f6", width = 0.95, height = 0.95) +
    geom_text(data = filter(cells, !is.na(value)), aes(label = money(value), colour = value > dark),
              family = sans, fontface = "bold", size = 3.6) +
    geom_tile(data = totals, fill = "#eceef0", width = 0.95, height = 0.95) +
    geom_text(data = totals, aes(label = money(value)), family = sans, fontface = "bold",
              size = 3.6, colour = ink) +
    scale_fill_distiller(palette = "Blues", direction = 1, labels = money, name = NULL,
                         guide = guide_colourbar(barwidth = unit(140, "pt"), barheight = unit(6, "pt"))) +
    scale_colour_manual(values = c(`TRUE` = "white", `FALSE` = ink), guide = "none") +
    scale_x_discrete(position = "top", limits = c("2", "3", "4", "5", "Total"),
                     labels = \(x) if_else(x == "Total", "Sent", paste0("To T", x))) +
    scale_y_discrete(limits = c("Total", "5", "4", "3", "2"),
                     labels = \(x) if_else(x == "Total", "Received", paste0("From T", x))) +
    coord_equal(expand = FALSE) +
    labs(
      title = "Stock transferred between terminals, year 2",
      subtitle = "Value of stock sent from each terminal (rows) to each other terminal (columns), with totals",
      x = NULL, y = NULL,
      caption = "Simulated data"
    ) +
    theme_minimal(base_family = sans, base_size = 10) +
    theme(
      plot.background = element_rect(fill = ground, colour = NA),
      panel.grid = element_blank(),
      plot.title = element_text(face = "bold", size = 13, colour = ink),
      plot.title.position = "plot",
      plot.subtitle = element_text(size = 8.8, colour = grey, margin = margin(t = 4, b = 10)),
      plot.caption = element_text(size = 7, colour = grey, hjust = 0),
      plot.caption.position = "plot",
      axis.text.x = element_text(colour = grey, size = 9, margin = margin(b = 6)),
      axis.text.y = element_text(colour = grey, size = 9, hjust = 1, margin = margin(r = 6)),
      legend.position = "bottom",
      legend.justification = "left",
      legend.text = element_text(size = 7, colour = grey),
      plot.margin = margin(16, 20, 10, 16)
    )
}

ragg::agg_png("fig-01-matrix-overview.png", width = 6.2, height = 6.6, units = "in", res = 220)
print(draw_overview_plain())
dev.off()


# =============================================================================
# FIGURE 2. The story picked out of figure 1 - Terminal 5 receives most
# =============================================================================
# Terminals run 2 to 5 on both axes. The "to Terminal 5" column carries the
# story, so it is the one in colour, with what each terminal received
# totalled underneath.

od <- transfers |>
  summarise(value = sum(value), .by = c(year, from, to)) |>
  tidyr::pivot_wider(names_from = year, values_from = value, names_prefix = "y",
                     values_fill = 0) |>
  tidyr::complete(from = c("2", "3", "4", "5"), to = c("2", "3", "4", "5")) |>
  mutate(
    change = y2 / y1 - 1,
    focus = to == "5",
    label = if_else(from == to, "", money(y2)),
    sub = if_else(from == to, "", pct(change)),
    row = factor(from, c("5", "4", "3", "2")),  # Terminal 2 at the top
    col = factor(to, c("2", "3", "4", "5"))
  )

received <- od |>
  summarise(y1 = sum(y1, na.rm = TRUE), y2 = sum(y2, na.rm = TRUE), .by = c(to, col)) |>
  mutate(
    share1 = y1 / sum(y1), share2 = y2 / sum(y2),
    label = money(y2),
    sub = paste0(round(100 * share2), "% of total"),
    focus = to == "5"
  )

t5 <- filter(received, to == "5")
accent <- "#0f4d80"

draw_overview <- function() {
  ramp <- scales::col_numeric(c("#9cbcd8", accent),
                              domain = range(filter(od, focus, from != to)$y2))
  ggplot(od, aes(col, row)) +
    geom_tile(data = filter(od, from != to, !focus), aes(fill = y2),
              width = 0.94, height = 0.94) +
    scale_fill_gradient(low = "#f1f2f4", high = "#9aa1a9", guide = "none") +
    geom_tile(data = filter(od, from != to, focus), fill = ramp(filter(od, from != to, focus)$y2),
              width = 0.94, height = 0.94) +
    geom_tile(data = filter(od, from == to), fill = NA, colour = "#e3e5e8",
              linewidth = 0.4, linetype = "22", width = 0.94, height = 0.94) +
    geom_text(aes(label = label, colour = focus), nudge_y = 0.1,
              family = sans, fontface = "bold", size = 3.8) +
    geom_text(aes(label = sub, colour = focus), nudge_y = -0.17,
              family = sans, size = 2.8) +
    # what each terminal received, under its column
    annotate("segment", x = 0.53, xend = 4.47, y = 0.43, yend = 0.43,
             colour = "#d5d8dc", linewidth = 0.4) +
    geom_text(data = received, aes(x = col, y = 0.22, label = label),
              colour = if_else(received$focus, accent, ink),
              family = sans, fontface = "bold", size = 3.5) +
    geom_text(data = received, aes(x = col, y = -0.02, label = sub),
              colour = if_else(received$focus, accent, grey),
              family = sans, size = 2.5) +
    annotate("text", x = 0.4, y = 0.1, label = "Received", hjust = 1,
             family = sans, fontface = "bold", size = 3, colour = grey) +
    scale_colour_manual(values = c(`TRUE` = "white", `FALSE` = ink), guide = "none") +
    scale_x_discrete(position = "top", labels = \(x) paste0("To T", x)) +
    scale_y_discrete(labels = \(x) paste0("From T", x)) +
    coord_equal(xlim = c(0.5, 4.5), ylim = c(0.5, 4.5), expand = FALSE, clip = "off") +
    labs(
      title = paste0("Terminal 5 now receives ", round(100 * t5$share2),
                     "% of all stock moved"),
      subtitle = paste0("Stock transferred between terminals in year 2, and the change on year 1"),
      x = NULL, y = NULL,
      caption = "Simulated data"
    ) +
    theme_minimal(base_family = sans, base_size = 10) +
    theme(
      plot.background = element_rect(fill = ground, colour = NA),
      panel.grid = element_blank(),
      plot.title = element_text(face = "bold", size = 13.5, colour = ink),
      plot.title.position = "plot",
      plot.subtitle = element_text(size = 9, colour = grey, margin = margin(t = 4, b = 10)),
      plot.caption = element_text(size = 7, colour = grey, hjust = 0, margin = margin(t = 52)),
      plot.caption.position = "plot",
      axis.text.x = element_text(colour = grey, size = 9, margin = margin(b = 6)),
      axis.text.y = element_text(colour = grey, size = 9, hjust = 1, margin = margin(r = 6)),
      plot.margin = margin(16, 24, 10, 16)
    )
}

ragg::agg_png("fig-02-matrix-story.png", width = 5.8, height = 5.9, units = "in", res = 220)
print(draw_overview())
dev.off()

# =============================================================================
# FIGURE 5. Who - every shop on one line
# =============================================================================
# A dot is one brand's shop in one terminal, sized by how many transfers it
# handled (sent plus received) in year 2. An arc is one route, as wide as
# the value of stock moved along it in year 2.
# Stock sent to a higher-numbered terminal arcs above the line; stock sent
# to a lower one dips below, kept flatter and fainter because the story is
# what goes up into Terminal 5. Watch brands are the only colour.

gap <- 2.5  # empty slots between terminals

shops <- sales |>
  filter(year == 2) |>
  mutate(cat_rank = match(category, categories)) |>
  arrange(terminal, cat_rank, desc(sales)) |>
  mutate(
    x = row_number() + (as.integer(terminal) - 2) * gap,
    story = if_else(category == "Watches", "watches", "other")
  ) |>
  left_join(
    transfers |>
      filter(year == 2) |>
      (\(d) bind_rows(transmute(d, retailer, terminal = from), transmute(d, retailer, terminal = to)))() |>
      count(retailer, terminal, name = "handled"),
    by = c("retailer", "terminal")
  ) |>
  mutate(handled = coalesce(handled, 0L))

routes <- transfers |>
  filter(year == 2) |>
  summarise(n = sum(value), .by = c(retailer, category, from, to)) |>
  mutate(
    x_from = shops$x[match(paste(from, retailer), paste(shops$terminal, shops$retailer))],
    x_to = shops$x[match(paste(to, retailer), paste(shops$terminal, shops$retailer))],
    up = x_to > x_from,
    story = if_else(category == "Watches", "watches", "other"),
    id = row_number()
  )

k_up <- 0.55    # arc height per unit of half-span, above the line
k_down <- 0.22  # and below it

arcs <- routes |>
  pmap(\(id, x_from, x_to, up, ...) {
    theta <- seq(0, pi, length.out = 90)
    r <- abs(x_to - x_from) / 2
    side <- if_else(up, 1, -1)
    tibble(id, x = (x_from + x_to) / 2 - side * r * cos(theta),
           y = side * r * sin(theta) * if_else(up, k_up, k_down))
  }) |>
  list_rbind() |>
  left_join(select(routes, id, n, up, story), by = "id") |>
  mutate(
    shade = paste(story, if_else(up, "up", "down")),
    layer = match(story, c("other", "watches"))
  ) |>
  arrange(layer, desc(n))

y_top <- max(arcs$y)
y_bot <- min(arcs$y)
label_y <- y_bot - 0.8

terminals <- shops |>
  summarise(x0 = min(x) - 0.9, x1 = max(x) + 0.9, mid = mean(range(x)), .by = terminal)

watch_to_t5 <- transfers |>
  filter(category == "Watches", to == "5") |>
  summarise(value = sum(value), .by = year) |>
  arrange(year) |>
  pull(value)

draw_explore <- function() {
  dividers <- tibble(x = (head(terminals$x1, -1) + tail(terminals$x0, -1)) / 2)

  ggplot() +
    geom_blank(data = tibble(x = 0, y = c(label_y - 5.5, y_top + 2.4)), aes(x, y)) +
    geom_segment(data = dividers, aes(x, xend = x, y = label_y - 5.2, yend = y_top + 2.4),
                 colour = "#c9cdd2", linewidth = 0.35, linetype = "22") +
    geom_text(data = terminals, aes(x0, y_top + 1.6, label = paste("TERMINAL", terminal)),
              hjust = 0, family = sans, fontface = "bold", size = 3, colour = "#4a5058") +
    geom_segment(data = terminals, aes(x0, xend = x1, y = y_top + 0.9, yend = y_top + 0.9),
                 colour = "#4a5058", linewidth = 0.7) +
    geom_segment(data = terminals, aes(x0 + 0.5, xend = x1 - 0.5, y = 0, yend = 0),
                 colour = "#b8bdc3", linewidth = 0.3) +
    geom_path(data = arcs, aes(x, y, group = id, colour = story, alpha = shade, linewidth = n),
              lineend = "butt") +
    geom_point(data = arrange(shops, desc(handled)), aes(x, 0, size = handled, fill = story),
               shape = 21, colour = ground, stroke = 0.5) +
    geom_text(data = shops, aes(x, label_y, label = retailer, colour = story),
              angle = 90, hjust = 1, family = sans, size = 2.15) +
    annotate("text", x = min(shops$x) - 2.2, y = c(4, -2.2),
             label = c("sent to a higher\nterminal \u2192", "\u2190 sent to a\nlower terminal"),
             hjust = 1, family = sans, size = 2.3, lineheight = 0.95, colour = grey) +
    scale_colour_manual(values = c(watches = rise, other = "#9aa0a7"), guide = "none") +
    scale_alpha_manual(values = c(`watches up` = 0.62, `watches down` = 0.35,
                                  `other up` = 0.24, `other down` = 0.15), guide = "none") +
    scale_fill_manual(values = c(watches = rise, other = "#8a9097"), guide = "none") +
    scale_linewidth(range = c(0.12, 8), name = "Value moved on the route",
                    breaks = c(5e4, 5e5, 1.5e6), labels = money) +
    scale_size_area(max_size = 9, name = "Transfers handled by the shop",
                    breaks = c(25, 100, 400)) +
    scale_x_continuous(expand = expansion(add = c(6, 1.5))) +
    scale_y_continuous(expand = expansion(add = c(0.3, 0.3))) +
    coord_cartesian(clip = "off") +
    guides(
      size = guide_legend(order = 1, override.aes = list(fill = "#8a9097")),
      linewidth = guide_legend(order = 2, override.aes = list(colour = "#8a9097", alpha = 0.6))
    ) +
    labs(
      title = paste0("The value of watches sent to Terminal 5 more than doubled, to ",
                     money(watch_to_t5[2])),
      subtitle = paste0("Stock transfers in year 2 (", money(watch_to_t5[1]),
                        " of watches went to Terminal 5 in year 1). Watch brands in blue; every other brand in grey."),
      caption = "Simulated data"
    ) +
    theme_void(base_family = sans) +
    theme(
      plot.background = element_rect(fill = ground, colour = NA),
      plot.title = element_text(face = "bold", size = 13, colour = ink),
      plot.subtitle = element_text(size = 8.8, colour = grey, margin = margin(t = 4, b = 2)),
      plot.caption = element_text(size = 7, colour = grey, hjust = 0),
      plot.caption.position = "plot",
      legend.position = "top",
      legend.justification = "left",
      legend.title = element_text(size = 7.5, colour = grey),
      legend.text = element_text(size = 7, colour = grey),
      legend.margin = margin(4, 0, 0, 0),
      plot.margin = margin(16, 16, 10, 16)
    )
}

ragg::agg_png("fig-05-arcs.png", width = 11, height = 6.6, units = "in", res = 200)
print(draw_explore())
dev.off()

# =============================================================================
# FIGURES 6 TO 9. Brand by brand, in the style of Tufte's small multiples
# =============================================================================
# Rows: the three watch brands, then every other category rolled up. Arc
# columns are small arc diagrams on one shared scale: ink arcs are ordinary
# transfers, red arcs round trips (stock sent to Terminal 5 that went
# straight back). Each dot is a terminal, sized by how many transfers it
# handled; a ring drawn around a dot marks the shop holding the brand's main
# stock. Measure columns show year 1 as a hollow dot, year 2 solid. (The
# main-stock shop used to be a hollow dot too: one symbol, two meanings, so
# it became a ring.)

waste <- "#b8452f"
blocks <- c("Watches", "Everything else, by category")

row_of <- function(retailer, category) if_else(category == "Watches", retailer, category)
block_of <- function(category) if_else(category == "Watches", blocks[1], blocks[2])

tr <- transfers |> mutate(row = row_of(retailer, category), block = block_of(category))

# --- arcs and nodes ---
how_routes <- tr |>
  summarise(value = sum(value), .by = c(block, row, year, from, to, returned)) |>
  mutate(id = row_number())

how_arcs <- how_routes |>
  pmap(\(block, row, year, from, to, returned, value, id) {
    a <- as.integer(from) - 1
    b <- as.integer(to) - 1
    theta <- seq(0, pi, length.out = 60)
    side <- if_else(b > a, 1, -1)
    depth <- if_else(returned, 1.15, 0.85)
    tibble(id, block, row, returned, value, col = paste("Year", year),
           x = (a + b) / 2 - side * abs(b - a) / 2 * cos(theta),
           y = side * abs(b - a) / 2 * sin(theta) * depth)
  }) |>
  list_rbind()

handled <- bind_rows(transmute(tr, block, row, year, t = from), transmute(tr, block, row, year, t = to)) |>
  count(block, row, year, t, name = "n") |>
  mutate(col = paste("Year", year))

how_shops <- brands |>
  mutate(t = strsplit(terminals, " "), row = row_of(retailer, category), block = block_of(category)) |>
  tidyr::unnest(t) |>
  mutate(home = t == home & category == "Watches") |>
  summarise(home = any(home), .by = c(block, row, t)) |>
  mutate(x = as.integer(t) - 1) |>
  tidyr::crossing(col = c("Year 1", "Year 2")) |>
  left_join(select(handled, block, row, t, col, n), by = c("block", "row", "t", "col")) |>
  mutate(n = coalesce(n, 0L))

# --- measures ---
w_metric <- 2.2   # drawn length of each measure's scale
k_label <- function(x) paste0("\u00a3", formatC(x / 1000, format = "f", digits = 1), "k")

row_sales <- sales |>
  mutate(row = row_of(retailer, category), block = block_of(category)) |>
  summarise(sales = sum(sales), sq_ft = sum(sq_ft), .by = c(block, row, year)) |>
  mutate(psf = sales / sq_ft)

row_moved <- tr |> summarise(moved = sum(value), .by = c(block, row, year))

sent_back <- tr |>
  summarise(sent = sum(value[to == "5" & !returned]), back = sum(value[returned]),
            .by = c(block, row, year)) |>
  mutate(rate = if_else(sent >= 5e4, back / sent, NA_real_))

# Dynamism is scored brand by brand, then averaged (weighted by sales) for
# each category: pooling five brands would use nearly every route and
# overstate breadth
brand_scores <- transfers |>
  summarise(moved = sum(value), routes = n_distinct(paste(from, to)), .by = c(retailer, category, year)) |>
  left_join(summarise(sales, sales = sum(sales), .by = c(retailer, year)), by = c("retailer", "year")) |>
  mutate(score = dynamism_score(moved, sales, routes))

row_dynamism <- brand_scores |>
  mutate(row = row_of(retailer, category), block = block_of(category)) |>
  summarise(score = weighted.mean(score, sales), .by = c(block, row, year))

metric_rows <- function(d, value, max, colour, fmt, col, growth = FALSE) {
  d |>
    mutate(v = {{ value }}) |>
    select(block, row, year, v) |>
    tidyr::pivot_wider(names_from = year, values_from = v, names_prefix = "v") |>
    mutate(
      x1 = w_metric * pmin(v1, max) / max,
      x2 = w_metric * pmin(v2, max) / max,
      label = if_else(is.na(v2), "\u2013", paste0(fmt(v1), " \u2192 ", fmt(v2))),
      label = if (growth) paste0(label, "  ", pct(v2 / v1 - 1)) else label,
      colour = colour, col = col
    )
}

moved_max <- max(row_moved$moved)
m_moved <- metric_rows(row_moved, moved, moved_max, "#222222", money, "Stock moved", growth = TRUE)
m_back <- metric_rows(sent_back, rate, 0.45, waste,
                      \(x) if_else(is.na(x), "\u2013", paste0(round(100 * x), "%")), "Sent back from T5")
m_psf <- metric_rows(row_sales, psf, 6000, "#222222", k_label, "Sales per sq ft", growth = TRUE)
m_dyn <- metric_rows(row_dynamism, score, 100, rise, \(x) as.character(round(x)), "Dynamism")

scale_ends <- tribble(
  ~col,                ~lo,     ~hi,
  "Stock moved",       "\u00a30", money(moved_max),
  "Sent back from T5", "0%",     "45%",
  "Sales per sq ft",   "\u00a30", "\u00a36k",
  "Dynamism",          "0",      "100"
)
label_room <- c("Stock moved" = 2.7, "Sent back from T5" = 1.6, "Sales per sq ft" = 2.7, "Dynamism" = 1.4)

# Sales per square foot of each shop, for sizing dots in figure 8a
shop_psf <- sales |>
  mutate(row = row_of(retailer, category), block = block_of(category), col = paste("Year", year)) |>
  summarise(psf = sum(sales) / sum(sq_ft), .by = c(block, row, terminal, col)) |>
  rename(t = terminal)

# Growth in sales per square foot, drawn as a bar from zero
g_lo <- -0.4
g_hi <- 0.8
g_x <- \(g) w_metric * (pmin(pmax(g, g_lo), g_hi) - g_lo) / (g_hi - g_lo)
growth_rows <- row_sales |>
  select(block, row, year, psf) |>
  tidyr::pivot_wider(names_from = year, values_from = psf, names_prefix = "p") |>
  mutate(g = p2 / p1 - 1, x0 = g_x(0), xg = g_x(g), label = pct(g),
         fill = if_else(g >= 0, rise, "#b5b0a5"), col = "Sales per sq ft growth")

# Year 1 and year 2 sales per square foot as a pair of bars (figure 8c)
psf_bars <- row_sales |>
  mutate(xb = w_metric * psf / 6000, col = "Sales per sq ft",
         ymin = if_else(year == 1, 0.08, -0.42), ymax = if_else(year == 1, 0.42, -0.08),
         fill = if_else(year == 1, "#c9c4b8", "#222222"),
         label = paste0(k_label(psf), if_else(year == 2, "", "")))
psf_bar_growth <- growth_rows |> mutate(col = "Sales per sq ft")

scale_ends <- bind_rows(scale_ends, tribble(
  ~col, ~lo, ~hi,
  "Sales per sq ft growth", "\u201340%", "+80%"
))
label_room <- c(label_room, "Sales per sq ft growth" = 1.1)

# --- one block of rows (watches, or everything else) ---
# arc_cols: which year panels to draw; metric_cols: measure columns.
# highlight: draw round trips in red (FALSE draws them in ink like the rest).
# dot_by: what sizes each terminal's dot - "n" transfers handled, or "psf".
# style: how the sales per sq ft column is drawn - "dots", "numbers" or "bars".
tufte_block <- function(b, arc_cols, metric_cols, metrics, rows, first = FALSE, last = FALSE,
                        highlight = TRUE, dot_by = "n", style = "dots", show_block_title = TRUE,
                        shade = FALSE, room = NULL, emphasise = FALSE) {
  cols <- c(arc_cols, metric_cols)
  rows_here <- intersect(rows, how_shops$row[how_shops$block == b])
  keep <- \(d) filter(d, block == b, col %in% cols, row %in% rows_here) |>
    mutate(row = factor(row, rows_here), col = factor(col, cols))
  frame <- tidyr::crossing(row = factor(rows_here, rows_here), col = factor(cols, cols)) |>
    mutate(xmin = if_else(col %in% arc_cols, 0.75, -0.1),
           xmax = if_else(col %in% arc_cols, 4.25, w_metric + label_room[as.character(col)]))
  if (!is.null(room)) frame <- mutate(frame, xmax = if_else(col %in% arc_cols, xmax, w_metric + room))
  m <- keep(metrics)
  shops <- keep(how_shops)
  if (dot_by == "psf") {
    shops <- shops |>
      mutate(row = as.character(row), col = as.character(col)) |>
      left_join(shop_psf, by = c("block", "row", "t", "col")) |>
      mutate(n = psf, row = factor(row, rows_here), col = factor(col, cols))
  }
  arcs <- keep(how_arcs)
  return_col <- if (highlight) waste else "#222222"

  p <- ggplot() +
    geom_blank(data = frame, aes(x = xmin, y = 0)) +
    geom_blank(data = frame, aes(x = xmax, y = 0)) +
    geom_path(data = filter(arcs, !returned), aes(x, y, group = id, linewidth = value),
              colour = "#222222", alpha = 0.75, lineend = "round") +
    geom_path(data = filter(arcs, returned), aes(x, y, group = id, linewidth = value),
              colour = return_col, alpha = if (highlight) 0.9 else 0.75, lineend = "round") +
    # every terminal a solid dot; the shop holding the brand's main stock gets a ring around it
    geom_point(data = shops, aes(x, 0, size = n), colour = "#222222", alpha = 0.85) +
    geom_point(data = filter(shops, home), aes(x, 0), shape = 21, fill = NA, size = 8.5,
               colour = "#222222", stroke = 0.5)

  # measures drawn as year 1 / year 2 dots
  dots <- filter(m, !(style %in% c("numbers", "bars") & col == "Sales per sq ft"))
  if (nrow(dots) > 0) {
    p <- p +
      geom_segment(data = dots, aes(x = 0, xend = w_metric, y = 0, yend = 0),
                   colour = "#d9d6cc", linewidth = 0.3) +
      geom_segment(data = filter(dots, !is.na(x2)), aes(x = x1, xend = x2, y = 0, yend = 0,
                                                          colour = if (emphasise) "#08306b" else colour),
                   linewidth = if (emphasise) 1.1 else 0.6, lineend = "butt") +
      geom_point(data = filter(dots, !is.na(x1)), aes(x1, 0, colour = if (emphasise) "#9a968c" else colour),
                 shape = 21, fill = ground, size = if (emphasise) 2.6 else 1.7, stroke = 0.6) +
      geom_point(data = filter(dots, !is.na(x2)), aes(x2, 0, colour = if (emphasise) "#08306b" else colour),
                 size = if (emphasise) 2.6 else 1.9) +
      geom_text(data = dots, aes(w_metric + 0.12, 0, label = label, colour = if (emphasise) "#555555" else colour),
                hjust = 0, family = serif, size = if (emphasise) 3.1 else 2.55)
  }
  # sales per sq ft as plain numbers
  if (style == "numbers" && "Sales per sq ft" %in% metric_cols) {
    nums <- keep(growth_rows |> mutate(col = "Sales per sq ft"))
    p <- p +
      geom_text(data = nums, aes(0, 0.35, label = paste0(k_label(p1), " \u2192 ", k_label(p2))),
                hjust = 0, family = serif, size = 3.2, colour = "#444444") +
      geom_text(data = nums, aes(0, -0.45, label = label), hjust = 0, family = serif,
                size = 6, fontface = "bold", colour = rise)
  }
  # sales per sq ft as a pair of bars
  if (style == "bars" && "Sales per sq ft" %in% metric_cols) {
    bars <- keep(psf_bars)
    gl <- keep(psf_bar_growth)
    p <- p +
      geom_rect(data = bars, aes(xmin = 0, xmax = xb, ymin = ymin, ymax = ymax, fill = fill)) +
      geom_text(data = bars, aes(xb + 0.06, (ymin + ymax) / 2, label = paste0(k_label(psf), "  year ", year)),
                hjust = 0, family = serif, size = 2.5, colour = "#555555") +
      geom_text(data = gl, aes(w_metric + 1.15, 0, label = label), hjust = 0, family = serif,
                size = 4.2, fontface = "bold", colour = rise)
  }
  # growth as a bar from zero; shade = TRUE deepens the blue as growth rises
  if ("Sales per sq ft growth" %in% metric_cols) {
    gr <- keep(growth_rows)
    if (shade) {
      ramp <- scales::col_numeric(c("#c6dbef", "#08306b"), domain = c(0, g_hi))
      gr <- gr |> mutate(fill = if_else(g >= 0, ramp(pmin(g, g_hi)), "#b5b0a5"),
                         label = paste0(k_label(p1), " \u2192 ", k_label(p2), "   ", pct(g)))
    }
    p <- p +
      geom_segment(data = gr, aes(x = 0, xend = w_metric, y = 0, yend = 0), colour = "#d9d6cc", linewidth = 0.3) +
      geom_rect(data = gr, aes(xmin = pmin(x0, xg), xmax = pmax(x0, xg), ymin = -0.28, ymax = 0.28, fill = fill)) +
      geom_segment(data = gr, aes(x = x0, xend = x0, y = -0.5, yend = 0.5), colour = "#888888", linewidth = 0.3) +
      geom_text(data = gr, aes(w_metric + 0.12, 0, label = label,
                               colour = if_else(g >= 0, if (shade) "#222222" else rise, "#777777")),
                hjust = 0, family = serif, size = 3.2, fontface = "bold")
  }

  size_scale <- if (dot_by == "psf") {
    scale_size_area(max_size = 6, limits = c(0, max(shop_psf$psf)), guide = "none")
  } else {
    scale_size_area(max_size = 5.5, limits = c(0, max(handled$n)), guide = "none")
  }

  p <- p +
    scale_colour_identity() +
    scale_fill_identity() +
    facet_grid(row ~ col, scales = "free_x", space = "free_x", switch = "y") +
    scale_linewidth(range = c(0.15, 4.2), limits = c(0, max(how_routes$value)), guide = "none") +
    size_scale +
    scale_x_continuous(expand = expansion(0)) +
    scale_y_continuous(limits = c(-1.85, 1.45), expand = expansion(0)) +
    # the terminal names under the last row hang below the panel
    coord_cartesian(clip = "off") +
    labs(title = if (show_block_title) b else NULL) +
    theme_void(base_family = serif, base_size = 10) +
    theme(
      plot.title = element_text(size = 10.5, face = "italic", colour = "#222222", margin = margin(b = 2)),
      plot.title.position = "plot",
      strip.text.y.left = element_text(angle = 0, hjust = 1, size = 8.5, margin = margin(r = 6)),
      strip.text.x = if (first) element_text(size = 8.8, margin = margin(b = 5)) else element_blank(),
      panel.spacing.x = unit(14, "pt"),
      panel.spacing.y = unit(0, "pt"),
      plot.margin = margin(3, 6, 5, 0)
    )

  if (last) {
    bottom <- factor(tail(rows_here, 1), rows_here)
    ticks_arc <- tidyr::expand_grid(col = factor(arc_cols, cols), x = 1:4) |>
      mutate(row = bottom, label = paste0("T", x + 1))
    tick_cols <- setdiff(metric_cols, if (style != "dots") "Sales per sq ft" else character())
    ticks_m <- scale_ends |>
      filter(col %in% tick_cols) |>
      tidyr::pivot_longer(c(lo, hi), names_to = "end", values_to = "label") |>
      mutate(x = if_else(end == "lo", 0, w_metric), col = factor(col, cols), row = bottom)
    p <- p +
      geom_text(data = ticks_arc, aes(x, -1.75, label = label), family = serif, size = 2.3, colour = "#999999")
    if (nrow(ticks_m) > 0) {
      p <- p + geom_text(data = ticks_m, aes(x, -0.75, label = label, hjust = if_else(x == 0, 0, 0.5)),
                         family = serif, size = 2.2, colour = "#999999")
    }
  }
  p
}

tufte_page <- function(arc_cols, metric_cols, metrics, rows, title, subtitle, caption,
                       which_blocks = blocks, ...) {
  n_rows <- sapply(which_blocks, \(b) length(intersect(rows, how_shops$row[how_shops$block == b])))
  parts <- lapply(seq_along(which_blocks), \(i) tufte_block(
    which_blocks[i], arc_cols, metric_cols, metrics, rows,
    first = i == 1, last = i == length(which_blocks), ...
  ))
  Reduce(`/`, parts) +
    plot_layout(heights = n_rows) +
    plot_annotation(
      title = title, subtitle = subtitle, caption = caption,
      theme = theme(
        plot.background = element_rect(fill = ground, colour = NA),
        plot.title = element_text(family = serif, size = 15, margin = margin(b = 5)),
        plot.subtitle = element_text(family = serif, size = 9, colour = "#555555",
                                     lineheight = 1.25, margin = margin(b = 10)),
        plot.caption = element_text(family = serif, size = 6.8, colour = "#888888", hjust = 0,
                                    lineheight = 1.25, margin = margin(t = 8)),
        plot.margin = margin(18, 16, 12, 16)
      )
    ) &
    theme(plot.background = element_rect(fill = ground, colour = NA))
}

# --- the story's numbers ---
pick <- \(d, r, y, v) d[[v]][d$row == r & d$year == y]
growth_of <- \(r) pick(row_sales, r, 2, "psf") / pick(row_sales, r, 1, "psf") - 1
moved_growth <- \(r) pick(row_moved, r, 2, "moved") / pick(row_moved, r, 1, "moved") - 1
back_of <- \(r) pick(sent_back, r, 2, "rate")

arc_note <- "Arcs: value of stock moved, on one scale for every panel; above the line to a higher-numbered terminal, below back.\n"
dot_note <- "Dots: each terminal, sized by the number of transfers it handled; a ring around a dot marks the shop holding the brand's main stock.\n"
round_trip_note <- "Red arcs are round trips: stock sent to Terminal 5 that went straight back to the shop it came from.\n"

rows_all <- c("Watches A", "Watches B", "Watches C",
              tr |> filter(category != "Watches") |> summarise(v = sum(value), .by = row) |>
                arrange(desc(v)) |> pull(row))

# ---- Figure 6: how much stock each brand moves ----
p_fig6 <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = "Stock moved", metrics = m_moved, rows = rows_all,
  highlight = FALSE,
  title = "Watch brands now move far more stock between terminals than anyone else",
  subtitle = paste0(
    "Value of stock moved between terminals, by watch brand and by category. Watches A moved ",
    round(100 * moved_growth("Watches A")), "% more than last year, Watches C ",
    round(100 * moved_growth("Watches C")), "% more;\nfashion moved ",
    round(-100 * moved_growth("Fashion")), "% less. Everything else changed little."
  ),
  caption = paste0(arc_note, dot_note, "Stock moved: value of all transfers, year 1 \u2192 year 2.\n",
                   "Simulated data")
)
ragg::agg_png("fig-06-tufte-stock-moved.png", width = 9.5, height = 9.5, units = "in", res = 200)
print(p_fig6)
dev.off()

# ---- Figure 7: how much of it comes straight back ----
p_fig7 <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = c("Stock moved", "Sent back from T5"),
  metrics = bind_rows(m_moved, m_back), rows = rows_all,
  title = "Much of what Watches A sends to Terminal 5 comes straight back",
  subtitle = paste0(
    "The same chart with round trips in red. Watches A sends Terminal 5 stock ahead of demand, and ",
    round(100 * back_of("Watches A")), "% of it is returned unsold.\n",
    "Watches B sends only what Terminal 5 has asked for: nothing comes back. Watches C and fashion return about ",
    "one in eight; the rest, a few per cent."
  ),
  caption = paste0(arc_note, round_trip_note, dot_note,
                   "Sent back from T5: share of the value sent to Terminal 5 that returned to the shop it came from ",
                   "(\u2013 where too little went to measure).\n",
                   "Simulated data")
)
ragg::agg_png("fig-07-tufte-sent-back.png", width = 11.5, height = 9.5, units = "in", res = 200)
print(p_fig7)
dev.off()

# ---- Figure 8: zoom in on the watch brands ----
# The main version is a dumbbell: year 1 hollow, year 2 solid, and the line
# between them the only blue on the chart. Three alternatives follow.
watch_rows <- c("Watches A", "Watches B", "Watches C")
fig8_title <- "Yet Watches A's sales per square foot grew fastest of the three"
fig8_sub <- paste0(
  "Sales per square foot grew ", pct(growth_of("Watches A")), " at Watches A, ",
  pct(growth_of("Watches C")), " at Watches C and ", pct(growth_of("Watches B")),
  " at Watches B, the brand that sends nothing back.\n",
  "The brand with the most wasted journeys is selling best: is stock that keeps moving part of the reason?"
)

p_fig8 <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = "Sales per sq ft", metrics = m_psf,
  rows = watch_rows, which_blocks = blocks[1], dot_by = "psf", show_block_title = FALSE,
  highlight = FALSE, emphasise = TRUE,
  title = fig8_title, subtitle = fig8_sub,
  caption = paste0(arc_note,
                   "Dots: each shop, sized by its sales per square foot; a ring around a dot marks the shop holding the brand's main stock.\n",
                   "Sales per sq ft: year 1 (hollow) to year 2 (solid), on one scale; the dark blue line is the growth.\n",
                   "Simulated data")
)
ragg::agg_png("fig-08-watches-sales.png", width = 9.8, height = 5.2, units = "in", res = 200)
print(p_fig8)
dev.off()

# ---- Alternatives tried for figure 8, kept for the write-up ----
p_fig8b <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = "Sales per sq ft", metrics = m_psf,
  rows = watch_rows, which_blocks = blocks[1], style = "numbers", show_block_title = FALSE,
  title = fig8_title, subtitle = fig8_sub,
  caption = paste0(arc_note, round_trip_note, dot_note,
                   "Sales per sq ft: a year's sales divided by retail space, all shops; year 1 \u2192 year 2 and the growth.\n",
                   "Simulated data")
)
ragg::agg_png("alt-08b-watches-numbers.png", width = 9, height = 5.2, units = "in", res = 200)
print(p_fig8b)
dev.off()

p_fig8c <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = "Sales per sq ft", metrics = m_psf,
  rows = watch_rows, which_blocks = blocks[1], style = "bars", show_block_title = FALSE,
  title = fig8_title, subtitle = fig8_sub,
  caption = paste0(arc_note, round_trip_note, dot_note,
                   "Bars: sales per square foot, year 1 (pale) and year 2 (dark), on one scale; growth on the right.\n",
                   "Simulated data")
)
ragg::agg_png("alt-08c-watches-bars.png", width = 9.5, height = 5.2, units = "in", res = 200)
print(p_fig8c)
dev.off()

# A solid growth bar, shaded darker as growth rises. Dropped because it
# loses the starting and end points, leaving only the change.
p_fig8d <- tufte_page(
  arc_cols = c("Year 1", "Year 2"), metric_cols = "Sales per sq ft growth", metrics = m_moved[0, ],
  rows = watch_rows, which_blocks = blocks[1], dot_by = "psf", show_block_title = FALSE,
  highlight = FALSE, shade = TRUE, room = 2.6,
  title = fig8_title, subtitle = fig8_sub,
  caption = paste0(arc_note,
                   "Dots: each shop, sized by its sales per square foot; a ring around a dot marks the shop holding the brand's main stock.\n",
                   "Bars: growth in sales per square foot, darker as growth rises; year 1 \u2192 year 2 alongside.\n",
                   "Simulated data")
)
ragg::agg_png("alt-08d-watches-shaded-bars.png", width = 10, height = 5.2, units = "in", res = 200)
print(p_fig8d)
dev.off()

# ---- Figure 9: year 2 movement against sales growth, every row ----
# Rows sorted by growth, so the eye can check whether the busier arc
# diagrams sit at the top. No score yet: figure 10 puts a number on it.
rows_9 <- growth_rows |> mutate(b = match(block, blocks)) |> arrange(b, desc(g)) |> pull(row)

p_fig9 <- tufte_page(
  arc_cols = "Year 2", metric_cols = "Sales per sq ft growth", metrics = m_moved[0, ], rows = rows_9,
  title = "Where stock moves most, sales per square foot grew fastest",
  subtitle = paste0(
    "Year 2 stock movement beside growth in sales per square foot, rows sorted by growth.\n",
    "The busiest, most widely spread arc diagrams sit near the top of each block.\n",
    "Fashion is the exception: it still moves plenty of stock, but demand for the whole category fell."
  ),
  caption = paste0(arc_note, round_trip_note, dot_note,
                   "Sales per sq ft growth: year 2 on year 1, a year's sales divided by retail space, all shops.\n",
                   "Simulated data")
)
ragg::agg_png("fig-09-tufte-growth.png", width = 7.5, height = 9.5, units = "in", res = 200)
print(p_fig9)
dev.off()

# =============================================================================
# FIGURE 10. Why - does moving stock go with faster growth?
# =============================================================================
# One dot per brand. Across: dynamism in year 2. Up: growth in sales per
# square foot, year 2 on year 1. Growth rather than the level, so a brand
# that is simply popular, or simply expensive, doesn't score well just for
# that. The line is an ordinary least-squares fit with its 95% band. A
# second fit adds each brand's category, so a category's rising or falling
# demand isn't credited to how the brand moves its stock.

why <- brand_scores |>
  filter(year == 2) |>
  select(retailer, category, score) |>
  left_join(
    sales |>
      summarise(psf = sum(sales) / sum(sq_ft), .by = c(retailer, year)) |>
      tidyr::pivot_wider(names_from = year, values_from = psf, names_prefix = "psf") |>
      mutate(growth = psf2 / psf1 - 1),
    by = "retailer"
  ) |>
  mutate(is_watch = category == "Watches")

fit_all <- lm(growth ~ score, data = why)
fit_cat <- lm(growth ~ score + category, data = why)
why$resid <- resid(fit_all)
per10 <- \(f) 10 * coef(f)[["score"]]
r2 <- summary(fit_all)$r.squared

p_why <- ggplot(why, aes(score, growth)) +
  geom_hline(yintercept = 0, colour = "#d9d6cc", linewidth = 0.4) +
  geom_smooth(method = "lm", formula = y ~ x, colour = "#222222", fill = "#e8e4d8",
              linewidth = 0.6, se = TRUE) +
  geom_point(data = filter(why, !is_watch), colour = "#8a8a8a", size = 2) +
  geom_point(data = filter(why, is_watch), colour = rise, size = 3.2) +
  geom_text(data = filter(why, is_watch), aes(label = retailer), colour = rise, family = serif,
            size = 3.3, hjust = -0.18, vjust = 0.4, fontface = "bold") +
  # name the other brands only where they stand out
  ggrepel::geom_text_repel(data = filter(why, !is_watch, abs(resid) > 0.12 | score > 40 | growth < -0.3),
                           aes(label = retailer), colour = "#777777", family = serif, size = 2.6,
                           nudge_x = 1.2, direction = "y", hjust = 0, segment.colour = "#cccccc",
                           segment.size = 0.25, min.segment.length = 0.3, seed = 1) +
  annotate("text", x = 40, y = -0.3, hjust = 0, family = serif, fontface = "italic", size = 2.7,
           colour = "#777777", label = "Fashion sits below the line:\nits whole category shrank") +
  annotate("text", x = 2, y = max(why$growth) * 0.98, hjust = 0, vjust = 1, family = serif,
           size = 3, colour = "#444444", lineheight = 1.2,
           label = paste0(
             "Every 10 points of dynamism goes with ", sprintf("%+.0f", 100 * per10(fit_all)),
             " points of growth\n(", sprintf("%.0f", 100 * r2), "% of the variation between brands).\n",
             "Comparing brands within the same category: ",
             sprintf("%+.0f", 100 * per10(fit_cat)), " points."
           )) +
  scale_x_continuous(limits = c(0, 70), breaks = seq(0, 70, 10), expand = expansion(0)) +
  scale_y_continuous(labels = pct, breaks = seq(-0.4, 0.8, 0.2)) +
  coord_cartesian(clip = "off") +
  labs(
    title = "Brands that keep their stock moving grew sales per square foot faster",
    subtitle = paste(
      "Each dot is a brand: dynamism in year 2 against growth in sales per square foot on year 1.",
      "Watch brands in blue. The line is a straight-line fit with its 95% confidence band.",
      sep = "\n"
    ),
    x = "Dynamism, year 2 (0–100)", y = "Sales per sq ft, year 2 on year 1",
    caption = paste0(
      "Dynamism: half the value of stock moved per £1 of sales (capped at 50p), half the share of the 12 routes used.\n",
      "Simulated data, in which dynamism was built in as a driver of growth. In real data, rising demand can drive both more stock\n",
      "movement and more sales, so a relationship like this would show association, not proof of cause."
    )
  ) +
  theme_minimal(base_family = serif, base_size = 10) +
  theme(
    plot.background = element_rect(fill = ground, colour = NA),
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(colour = "#ece8dc", linewidth = 0.3),
    axis.title = element_text(size = 8.5, colour = "#666666"),
    axis.title.x = element_text(margin = margin(t = 8)),
    axis.title.y = element_text(margin = margin(r = 8)),
    axis.text = element_text(colour = "#666666", size = 8),
    plot.title = element_text(size = 14.5, margin = margin(b = 5)),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 9, colour = "#555555", lineheight = 1.25, margin = margin(b = 12)),
    plot.caption = element_text(size = 6.8, colour = "#888888", hjust = 0, lineheight = 1.25,
                                margin = margin(t = 10)),
    plot.caption.position = "plot",
    plot.margin = margin(18, 30, 12, 16)
  )

ragg::agg_png("fig-10-regression.png", width = 8, height = 6.6, units = "in", res = 220)
print(p_why)
dev.off()
# ---- PART 3. Chord alternatives, and figures 3 and 4 --------------------------
# Four alternatives to side-by-side year 1 / year 2 chord diagrams. Each
# answers: how much more stock flowed into Terminal 5, and from where?
# Option A is figure 3 (the "fancy but messy" chord) and option C is
# figure 4 (the plain slopegraph); B and D are kept for the write-up.

accent <- "#0f4d80"
up_col <- "#1b6ca8"
down_col <- "#d95f02"
flat_col <- "#b9bec4"

routes_yoy <- transfers |>
  summarise(value = sum(value), .by = c(year, from, to)) |>
  tidyr::pivot_wider(names_from = year, values_from = value, names_prefix = "y", values_fill = 0) |>
  mutate(change = y2 / y1 - 1, delta = y2 - y1)

inflow <- routes_yoy |>
  summarise(y1 = sum(y1), y2 = sum(y2), .by = to) |>
  mutate(change = y2 / y1 - 1) |>
  arrange(to)

t5 <- filter(inflow, to == "5")
headline <- paste0("Stock flowing into Terminal 5 grew ", round(100 * t5$change), "% in a year")

chord_titles <- function(title, sub1, sub2 = NULL) {
  mtext(title, side = 3, outer = TRUE, line = 2.6, adj = 0, at = 0.02, font = 2, cex = 1.05, col = ink)
  mtext(sub1, side = 3, outer = TRUE, line = 1.3, adj = 0, at = 0.02, cex = 0.66, col = grey)
  if (!is.null(sub2)) mtext(sub2, side = 3, outer = TRUE, line = 0.3, adj = 0, at = 0.02, cex = 0.66, col = grey)
  mtext("Simulated data", side = 1, outer = TRUE, line = 0.3,
        adj = 0, at = 0.02, cex = 0.56, col = grey)
}

# ---- Option A: one chord, ribbons coloured by year-on-year change -----------
# Year 2 only. Ribbon width is the value moved; colour is how much that route
# grew or shrank on year 1. Each terminal carries its inflow and its change.

draw_option_a <- function() {
  sector <- paste("Terminal", 2:5)
  ramp <- scales::col_numeric(c(down_col, "#e6e1da", up_col), domain = c(-0.6, 0.6))
  r <- routes_yoy |>
    mutate(from = paste("Terminal", from), to = paste("Terminal", to),
           col = scales::alpha(ramp(pmax(pmin(change, 0.6), -0.6)), 0.85))

  par(oma = c(1.4, 0, 4, 0), mar = c(0.5, 0.5, 0.5, 9), family = sans, bg = ground)
  circlize::circos.par(gap.after = 5, start.degree = 90, clock.wise = TRUE)
  circlize::chordDiagram(
    transmute(r, from, to, value = y2), order = sector,
    grid.col = setNames(c("#c3c7cc", "#a9aeb4", "#d5d8dc", accent), sector),
    col = r$col, directional = 1, direction.type = c("diffHeight", "arrows"),
    diffHeight = circlize::mm_h(2), link.arr.type = "big.arrow", link.sort = TRUE,
    link.largest.ontop = TRUE, link.border = NA, annotationTrack = "grid",
    preAllocateTracks = list(track.height = circlize::mm_h(9)),
    annotationTrackHeight = circlize::mm_h(2)
  )
  circlize::circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
    s <- circlize::get.cell.meta.data("sector.index")
    t <- sub("Terminal ", "", s)
    i <- inflow[inflow$to == t, ]
    is5 <- t == "5"
    circlize::circos.text(circlize::CELL_META$xcenter, circlize::CELL_META$ylim[1] + 0.62, toupper(s),
                          facing = "bending.inside", niceFacing = TRUE, font = 2, cex = 0.66,
                          col = if (is5) accent else "#4a5058")
    circlize::circos.text(circlize::CELL_META$xcenter, circlize::CELL_META$ylim[1] + 0.12,
                          paste0("in ", money(i$y2), " (", pct(i$change), ")"),
                          facing = "bending.inside", niceFacing = TRUE, cex = 0.56,
                          col = if (is5) accent else grey)
  })
  circlize::circos.clear()

  # colour key, right margin
  par(xpd = NA)
  u <- par("usr")
  kx <- u[2] + 0.12 * diff(u[1:2])
  ky <- seq(u[3] + 0.3 * diff(u[3:4]), u[3] + 0.7 * diff(u[3:4]), length.out = 61)
  rect(kx, head(ky, -1), kx + 0.05 * diff(u[1:2]), tail(ky, -1),
       col = ramp(seq(-0.6, 0.6, length.out = 60)), border = NA)
  text(kx + 0.065 * diff(u[1:2]), ky[c(1, 31, 61)], c("–60% or less", "no change", "+60% or more"),
       adj = 0, cex = 0.58, col = grey)
  text(kx, ky[61] + 0.05 * diff(u[3:4]), "Route, year 2\non year 1", adj = c(0, 0), cex = 0.62,
       font = 2, col = ink)
  chord_titles(headline,
               "Value of stock moved in year 2. Each ribbon runs from the sending terminal to an arrow at the receiving one,",
               "coloured by how much that route changed on year 1.")
}

# ---- Option B: a chord of the change itself ---------------------------------
# Only the growth: each ribbon is how much MORE moved along a route this year.
# Routes that shrank are listed underneath instead of drawn.

draw_option_b <- function() {
  sector <- paste("Terminal", 2:5)
  grew <- routes_yoy |> filter(delta > 0) |>
    mutate(from = paste("Terminal", from), to = paste("Terminal", to),
           col = if_else(to == "Terminal 5", scales::alpha(accent, 0.78), scales::alpha("#9aa0a7", 0.4)))
  shrank <- routes_yoy |> filter(delta < 0) |> arrange(delta)
  extra5 <- sum(grew$delta[grew$to == "Terminal 5"])
  extra_all <- sum(grew$delta)

  par(oma = c(2.6, 0, 4, 0), mar = c(0.5, 0.5, 0.5, 0.5), family = sans, bg = ground)
  circlize::circos.par(gap.after = 5, start.degree = 90, clock.wise = TRUE)
  circlize::chordDiagram(
    transmute(grew, from, to, value = delta), order = sector,
    grid.col = setNames(c("#c3c7cc", "#a9aeb4", "#d5d8dc", accent), sector),
    col = grew$col, directional = 1, direction.type = c("diffHeight", "arrows"),
    diffHeight = circlize::mm_h(2), link.arr.type = "big.arrow", link.sort = TRUE,
    link.largest.ontop = TRUE, link.border = NA, annotationTrack = "grid",
    preAllocateTracks = list(track.height = circlize::mm_h(6)),
    annotationTrackHeight = circlize::mm_h(2)
  )
  circlize::circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
    s <- circlize::get.cell.meta.data("sector.index")
    circlize::circos.text(circlize::CELL_META$xcenter, circlize::CELL_META$ylim[1] + 0.35, toupper(s),
                          facing = "bending.inside", niceFacing = TRUE, font = 2, cex = 0.66,
                          col = if (s == "Terminal 5") accent else "#4a5058")
  })
  circlize::circos.clear()
  chord_titles(
    paste0(money(extra5), " of the ", money(extra_all), " extra stock moved this year went to Terminal 5"),
    "Growth in stock moved, year 2 on year 1, by route. Each ribbon is the increase only, from the sending terminal to an arrow",
    "at the receiving one. Routes into Terminal 5 in blue."
  )
  mtext(paste0("Not drawn, routes that shrank: ",
               paste0("T", shrank$from, "→T", shrank$to, " –", money(-shrank$delta), collapse = ",  ")),
        side = 1, outer = TRUE, line = -0.9, adj = 0, at = 0.02, cex = 0.6, col = grey)
}

# ---- Option C: slopegraph of what each terminal received --------------------
# Drops the network to answer just the headline: inflow, year 1 to year 2.

draw_option_c <- function() {
  d <- inflow |> mutate(t = paste("Terminal", to), is5 = to == "5")
  ggplot(d) +
    geom_segment(aes(x = 1, xend = 2, y = y1, yend = y2, colour = is5), linewidth = 1.1) +
    geom_point(aes(1, y1, colour = is5), size = 2.6) +
    geom_point(aes(2, y2, colour = is5), size = 2.6) +
    geom_text(aes(0.96, y1, label = paste0(t, "  ", money(y1)), colour = is5), hjust = 1,
              family = sans, size = 3.2) +
    geom_text(aes(2.04, y2, label = paste0(money(y2), "  ", pct(change)), colour = is5), hjust = 0,
              family = sans, size = 3.2, fontface = "bold") +
    annotate("text", x = c(1, 2), y = max(d$y2) * 1.1, label = c("Year 1", "Year 2"),
             family = sans, fontface = "bold", size = 3.2, colour = grey) +
    scale_colour_manual(values = c(`TRUE` = accent, `FALSE` = "#9aa0a7"), guide = "none") +
    scale_x_continuous(limits = c(0.45, 2.55)) +
    scale_y_continuous(limits = c(0, max(d$y2) * 1.12)) +
    labs(title = headline,
         subtitle = "Value of stock each terminal received from the others",
         caption = "Simulated data") +
    theme_void(base_family = sans) +
    theme(plot.background = element_rect(fill = ground, colour = NA),
          plot.title = element_text(face = "bold", size = 13, colour = ink),
          plot.subtitle = element_text(size = 9, colour = grey, margin = margin(t = 4, b = 12)),
          plot.caption = element_text(size = 7, colour = grey, hjust = 0),
          plot.caption.position = "plot",
          plot.margin = margin(16, 16, 10, 16))
}

# ---- Option D: what each terminal received, split by where it came from -----
# Paired bars, year 1 and year 2, stacked by sending terminal.

draw_option_d <- function() {
  # stacks are built by hand so each label sits on the block it describes:
  # the sending terminal nearest in number at the bottom
  d <- routes_yoy |>
    select(from, to, y1, y2) |>
    tidyr::pivot_longer(c(y1, y2), names_to = "year", values_to = "value") |>
    mutate(yr = if_else(year == "y1", 1, 2)) |>
    arrange(to, yr, from) |>
    mutate(top = cumsum(value), bottom = top - value, .by = c(to, yr)) |>
    mutate(
      x = (as.integer(to) - 2) * 3 + yr,
      is5 = to == "5",
      shade = case_when(
        !is5 ~ c("2" = "#d8dbdf", "3" = "#c4c8cd", "4" = "#e6e8eb", "5" = "#b0b5bb")[from],
        yr == 1 ~ c("2" = "#9fbad6", "3" = "#6f98c3", "4" = "#cfdbe8")[from],
        TRUE ~ c("2" = "#2f5f8f", "3" = "#0f4d80", "4" = "#5d82a8")[from]
      )
    )
  tot <- d |> summarise(value = sum(value), x = first(x), is5 = first(is5), .by = c(to, yr))
  lab5 <- filter(tot, to == "5") |> arrange(yr)
  segs <- filter(d, is5, value > 4e5)
  axis_x <- tibble(x = c(1, 2, 4, 5, 7, 8, 10, 11), label = rep(c("Year 1", "Year 2"), 4))
  groups <- tibble(x = c(1.5, 4.5, 7.5, 10.5), label = paste0("Into T", 2:5), is5 = c(F, F, F, T))

  ggplot(d) +
    geom_rect(aes(xmin = x - 0.4, xmax = x + 0.4, ymin = bottom / 1e6, ymax = top / 1e6, fill = shade),
              colour = ground, linewidth = 0.4) +
    geom_text(data = segs, aes(x, (bottom + top) / 2e6, label = paste0("from T", from, "\n", money(value))),
              family = sans, size = 2.5, lineheight = 0.9, colour = "white") +
    geom_text(data = tot, aes(x, value / 1e6, label = money(value), colour = is5),
              vjust = -0.5, family = sans, fontface = "bold", size = 3) +
    geom_text(data = axis_x, aes(x, -0.25, label = label), family = sans, size = 2.7, colour = grey) +
    geom_text(data = groups, aes(x, -0.7, label = label, colour = is5), family = sans,
              fontface = "bold", size = 3.3) +
    scale_fill_identity() +
    scale_colour_manual(values = c(`TRUE` = accent, `FALSE` = grey), guide = "none") +
    scale_y_continuous(labels = \(x) paste0("\u00a3", x, "m"), breaks = seq(0, 8, 2),
                       expand = expansion(c(0, 0.08))) +
    coord_cartesian(ylim = c(-0.8, max(tot$value) / 1e6 * 1.06), clip = "off") +
    labs(title = headline,
         subtitle = paste0("Value of stock each terminal received, year 1 and year 2, split by the terminal it came from. ",
                           "Terminal 5 took in ", money(lab5$value[2] - lab5$value[1]), " more."),
         x = NULL, y = NULL, caption = "Simulated data") +
    theme_minimal(base_family = sans, base_size = 10) +
    theme(plot.background = element_rect(fill = ground, colour = NA),
          panel.grid.major.x = element_blank(), panel.grid.minor = element_blank(),
          panel.grid.major.y = element_line(colour = "#eceef0"),
          axis.text.x = element_blank(),
          axis.text.y = element_text(colour = grey),
          plot.title = element_text(face = "bold", size = 13, colour = ink),
          plot.title.position = "plot",
          plot.subtitle = element_text(size = 8.6, colour = grey, margin = margin(t = 4, b = 12)),
          plot.caption = element_text(size = 7, colour = grey, hjust = 0),
          plot.caption.position = "plot",
          plot.margin = margin(16, 16, 10, 16))
}

colorspace_dark <- function(x) {
  m <- grDevices::col2rgb(x) / 255 * 0.72
  grDevices::rgb(m[1, ], m[2, ], m[3, ])
}

ragg::agg_png("fig-03-chord.png", width = 7.6, height = 6.6, units = "in", res = 200)
draw_option_a()
dev.off()

ragg::agg_png("chord-option-b-chord-of-the-change.png", width = 6.8, height = 7, units = "in", res = 200)
draw_option_b()
dev.off()

ragg::agg_png("fig-04-slopegraph.png", width = 6, height = 5, units = "in", res = 200)
print(draw_option_c())
dev.off()

ragg::agg_png("chord-option-d-stacked-bars.png", width = 8, height = 5.2, units = "in", res = 200)
print(draw_option_d())
dev.off()