#> #!/usr/bin/env Rscript
#> # ============================================================================
#> # "A Year in 22,197 Plays" — data pipeline
#> #
#> # Reads data-raw/spotify/StreamingHistory{0,1,2}.json (Spotify export, UTC)
#> # Writes content/post/spotify/data/stats.json numbers quoted in prose
#> # content/post/spotify/data/calendar.json per-day + day×hour
#> # content/post/spotify/data/clocks.json hour-of-day profiles
#> # content/post/spotify/data/plays.json full play log (explorer)
#> # content/post/spotify/figs/*.svg static figures
#> # content/post/spotify/featured.png post banner image
#> #
#> # Run from the repository root: Rscript analysis/spotify/pipeline.R
#> # ============================================================================
#>
#> suppressWarnings(Sys.setlocale("LC_CTYPE", "C.UTF-8")) # keep glyphs intact in SVG output
#>
#> suppressPackageStartupMessages({
#> library(jsonlite); library(dplyr); library(tidyr); library(purrr)
#> library(lubridate); library(stringr); library(ggplot2); library(scales)
#> library(svglite); library(systemfonts); library(forcats); library(tibble)
#> })
#>
#> # ---- configuration ---------------------------------------------------------
#>
#> RAW_DIR <- "data-raw/spotify"
#> OUT_DATA <- "content/post/spotify/data"
#> OUT_FIGS <- "content/post/spotify/figs"
#> OUT_PAGE <- "content/post/spotify"
#>
#> TZ_SURABAYA <- "Asia/Jakarta" # WIB, UTC+7 — Dec 2021 through Aug 2022
#> TZ_POLAND <- "Europe/Warsaw" # CEST/CET — Sep 2022 onward (DST handled by tz db)
#>
#> # Edo: "before September I was in Surabaya, then moved to Poland."
#> # The export does not record location; the exact travel date is unknown, so the
#> # era boundary is set to the start of September. If the flight was later in the
#> # month, change this one constant and re-run — everything downstream recomputes.
#> MOVE_UTC <- ymd_hms("2022-09-01 00:00:00", tz = "UTC")
#>
#> SKIP_SECONDS <- 30 # conventional "skip" threshold
#> PODCAST_SHOWS <- c("The Science of Everything Podcast",
#> "Ologies with Alie Ward",
#> "Math & Physics Podcast")
#>
#> # Privacy switch: FALSE ships only aggregates to the browser (no track-level log).
#> INCLUDE_FULL_PLAY_LOG <- TRUE
#>
#> dir.create(OUT_DATA, recursive = TRUE, showWarnings = FALSE)
#> dir.create(OUT_FIGS, recursive = TRUE, showWarnings = FALSE)
#>
#> # ---- visual identity -------------------------------------------------------
#> # Stable meanings across the whole story:
#> # INK structure & volume EMBER repetition & comfort
#> # TEAL discovery & the new MUTE context
#> PAPER <- "#FAF6EF"; PANEL <- "#F1EAE0"
#> INK <- "#26201A"; INK2 <- "#6E655B"; MUTE <- "#B9AE9F"
#> EMBER <- "#A8401F"; TEAL <- "#0E6876"
#> RAMP_LO <- "#EDE5D6"
#>
#> FONT <- "sans"
#> for (d in c("static/fonts", "fonts")) {
#> f <- file.path(d, "Satoshi-Variable.ttf")
#> fi <- file.path(d, "Satoshi-VariableItalic.ttf")
#> if (file.exists(f)) {
#> systemfonts::register_font("Satoshi", plain = f, bold = f,
#> italic = if (file.exists(fi)) fi else f)
#> FONT <- "Satoshi"; break
#> }
#> }
#>
#> theme_story <- function(base = 11.5) {
#> theme_minimal(base_family = FONT, base_size = base) +
#> theme(
#> plot.background = element_rect(fill = PAPER, colour = NA),
#> panel.background = element_rect(fill = PAPER, colour = NA),
#> panel.grid.major = element_line(colour = "#E4DCCD", linewidth = .35),
#> panel.grid.minor = element_blank(),
#> text = element_text(colour = INK),
#> axis.text = element_text(colour = INK2, size = rel(.82)),
#> axis.title = element_text(colour = INK2, size = rel(.85)),
#> plot.title = element_text(face = "bold", size = rel(1.15), colour = INK),
#> plot.subtitle = element_text(colour = INK2, size = rel(.92)),
#> plot.caption = element_text(colour = MUTE, size = rel(.75), hjust = 0),
#> plot.margin = margin(10, 14, 10, 14),
#> strip.text = element_text(colour = INK2, face = "bold", size = rel(.85))
#> )
#> }
#>
#> save_svg <- function(p, name, w, h) {
#> svglite(file.path(OUT_FIGS, name), width = w, height = h,
#> bg = PAPER, fix_text_size = FALSE)
#> print(p); invisible(dev.off())
#> message("wrote figs/", name)
#> }
#>
#> # ---- 1 · import ------------------------------------------------------------
#>
#> files <- sort(list.files(RAW_DIR, "^StreamingHistory\\d+\\.json$", full.names = TRUE))
#> stopifnot(length(files) > 0)
#>
#> raw <- map_dfr(files, \(f) as_tibble(fromJSON(f)))
#>
#> plays <- raw |>
#> mutate(
#> end_utc = ymd_hm(endTime, tz = "UTC"),
#> sec = msPlayed / 1000,
#> mins = msPlayed / 60000,
#> era = if_else(end_utc < MOVE_UTC, "Surabaya", "Poland"),
#> l_sub = with_tz(end_utc, TZ_SURABAYA),
#> l_pol = with_tz(end_utc, TZ_POLAND),
#> local_date = as_date(if_else(era == "Surabaya", as_date(l_sub), as_date(l_pol))),
#> local_hour = if_else(era == "Surabaya", hour(l_sub), hour(l_pol)),
#> local_min = if_else(era == "Surabaya", minute(l_sub), minute(l_pol)),
#> wk = floor_date(local_date, "week", week_start = 1),
#> mon = floor_date(local_date, "month"),
#> dow = wday(local_date, week_start = 1), # 1 = Mon … 7 = Sun
#> weekend = dow >= 6,
#> is_skip = sec < SKIP_SECONDS,
#> is_podcast = artistName %in% PODCAST_SHOWS,
#> track_id = paste(artistName, trackName, sep = "\u001f")
#> ) |>
#> select(-l_sub, -l_pol) |>
#> arrange(end_utc)
#>
#> music <- plays |> filter(!is_podcast)
#>
#> # ---- 2 · daily calendar ----------------------------------------------------
#>
#> span <- tibble(local_date = seq(min(music$local_date), max(music$local_date), by = "day"))
#>
#> daily <- music |>
#> group_by(local_date) |>
#> summarise(hours = sum(mins) / 60, n = n(),
#> uniq = n_distinct(track_id), .groups = "drop")
#>
#> top_day <- music |>
#> group_by(local_date, artistName, trackName) |>
#> summarise(m = sum(mins), .groups = "drop") |>
#> group_by(local_date) |>
#> slice_max(m, n = 1, with_ties = FALSE) |>
#> ungroup() |>
#> transmute(local_date, top = paste0(trackName, " — ", artistName))
#>
#> days <- span |>
#> left_join(daily, by = "local_date") |>
#> left_join(top_day, by = "local_date") |>
#> mutate(across(c(hours, n, uniq), \(x) replace_na(x, 0)),
#> top = replace_na(top, ""),
#> era = if_else(local_date < as_date("2022-09-01"), "Surabaya", "Poland"),
#> idx = row_number() - 1)
#>
#> hour_mat <- music |>
#> count(local_date, local_hour, wt = mins, name = "m") |>
#> complete(local_date = span$local_date, local_hour = 0:23, fill = list(m = 0)) |>
#> arrange(local_date, local_hour)
#>
#> # streaks & silences
#> r <- rle(days$hours > 0)
#> ends <- cumsum(r$lengths); starts <- ends - r$lengths + 1
#> streak_i <- which(r$values)[which.max(r$lengths[r$values])]
#> silent_runs <- tibble(start = days$local_date[starts[!r$values]],
#> len = r$lengths[!r$values]) |> arrange(desc(len))
#> streak <- list(len = r$lengths[streak_i],
#> start = days$local_date[starts[streak_i]],
#> end = days$local_date[ends[streak_i]])
#> silent_days <- days |> filter(hours == 0) |> pull(local_date)
#>
#> # ---- 3 · sessions (UTC gaps > 30 min start a new one) ----------------------
#>
#> sess_df <- plays |>
#> mutate(start_est = end_utc - seconds(sec),
#> gap = as.numeric(difftime(start_est, lag(end_utc), units = "mins")),
#> new = is.na(gap) | gap > 30,
#> sess = cumsum(new))
#>
#> sessions <- sess_df |>
#> group_by(sess) |>
#> summarise(start = min(start_est), end = max(end_utc),
#> plays = n(), minutes = sum(mins), .groups = "drop")
#>
#> marathon <- sessions |> slice_max(minutes, n = 1)
#> marathon_top <- sess_df |>
#> filter(sess == marathon$sess) |>
#> count(artistName, trackName, sort = TRUE) |> slice(1)
#> mar_tz <- if (marathon$start < MOVE_UTC) TZ_SURABAYA else TZ_POLAND
#>
#> # ---- 4 · artists -----------------------------------------------------------
#>
#> artists <- music |>
#> group_by(artistName) |>
#> summarise(hours = sum(mins) / 60, plays = n(),
#> first = min(local_date), last = max(local_date), .groups = "drop") |>
#> arrange(desc(hours))
#>
#> tot_h <- sum(music$mins) / 60
#> cum <- cumsum(artists$hours) / tot_h
#> conc <- list(n25 = sum(cum <= .25) + 1, n50 = sum(cum <= .50) + 1,
#> n75 = sum(cum <= .75) + 1,
#> once = sum(artists$plays == 1),
#> top1_share = artists$hours[1] / tot_h,
#> top10_share = sum(artists$hours[1:10]) / tot_h)
#>
#> monthly <- music |>
#> group_by(mon) |>
#> summarise(hours = sum(mins) / 60, plays = n(),
#> uniq_tracks = n_distinct(track_id), .groups = "drop")
#>
#> month_top <- music |>
#> group_by(mon, artistName) |>
#> summarise(h = sum(mins) / 60, .groups = "drop") |>
#> group_by(mon) |> slice_max(h, n = 1, with_ties = FALSE) |>
#> left_join(monthly |> select(mon, hours), by = "mon") |>
#> mutate(share = h / hours)
#>
#> first_seen <- music |>
#> group_by(artistName) |> summarise(debut = min(local_date), .groups = "drop")
#> new_by_month <- first_seen |> count(mon = floor_date(debut, "month"), name = "new_artists")
#>
#> eff_artists <- music |>
#> group_by(mon, artistName) |> summarise(m = sum(mins), .groups = "drop") |>
#> group_by(mon) |>
#> summarise(eff = { p <- m / sum(m); exp(-sum(p * log(p))) }, .groups = "drop")
#>
#> seen <- character(0)
#> new_track_share <- music |>
#> group_by(mon) |>
#> group_map(\(g, k) {
#> ids <- unique(g$track_id)
#> out <- tibble(mon = k$mon, share_new = length(setdiff(ids, seen)) / length(ids))
#> seen <<- union(seen, ids); out
#> }) |> list_rbind()
#>
#> comebacks <- music |>
#> group_by(artistName) |> filter(n() >= 20) |>
#> arrange(local_date, .by_group = TRUE) |>
#> reframe(d = local_date) |>
#> group_by(artistName) |>
#> summarise(gap = max(as.numeric(diff(d)), 0),
#> away = d[which.max(diff(d))],
#> back = d[which.max(diff(d)) + 1], .groups = "drop") |>
#> arrange(desc(gap))
#>
#> vansire <- comebacks |> filter(artistName == "Vansire")
#> vansire_burst <- music |>
#> filter(artistName == "Vansire",
#> local_date %in% as_date(c("2022-11-22", "2022-11-23"))) |> nrow()
#> vansire_track <- music |>
#> filter(artistName == "Vansire", local_date >= vansire$back) |>
#> count(trackName, sort = TRUE) |> slice(1)
#>
#> # ---- 5 · repetition --------------------------------------------------------
#>
#> tracks <- music |>
#> group_by(artistName, trackName) |>
#> summarise(plays = n(), hours = sum(mins) / 60,
#> first = min(local_date), last = max(local_date), .groups = "drop") |>
#> arrange(desc(plays))
#>
#> day_loops <- music |>
#> count(local_date, artistName, trackName, sort = TRUE, name = "plays")
#>
#> runs_tbl <- music |>
#> mutate(run = cumsum(track_id != lag(track_id, default = ""))) |>
#> group_by(run) |>
#> summarise(n = n(), trackName = first(trackName),
#> artistName = first(artistName), on = first(local_date), .groups = "drop") |>
#> arrange(desc(n))
#>
#> dec14 <- music |> filter(local_date == as_date("2021-12-14"))
#> dec14_one <- n_distinct(dec14$track_id) == 1
#>
#> habang <- tracks |> filter(trackName == "Habang Buhay", artistName == "Zack Tabudlo")
#> sjd <- tracks |> filter(str_starts(trackName, "Sampai Jadi Debu")) |>
#> slice_max(plays, n = 1)
#>
#> # ---- 6 · clocks ------------------------------------------------------------
#>
#> clock_share <- function(d) {
#> d |> count(local_hour, wt = mins, name = "m") |>
#> complete(local_hour = 0:23, fill = list(m = 0)) |>
#> mutate(share = m / sum(m)) |> arrange(local_hour)
#> }
#> ck_all <- clock_share(music)
#> ck_weekday <- clock_share(music |> filter(!weekend))
#> ck_weekend <- clock_share(music |> filter(weekend))
#> ck_sub <- clock_share(music |> filter(era == "Surabaya"))
#> ck_pol <- clock_share(music |> filter(era == "Poland"))
#> ck_month <- music |> group_by(mon) |> group_map(\(g, k)
#> clock_share(g) |> mutate(mon = k$mon)) |> list_rbind()
#>
#> night_share <- function(d) sum(d$mins[d$local_hour <= 4]) / sum(d$mins)
#> peak_hours <- function(ck) ck |> arrange(desc(share)) |> slice(1:3) |> pull(local_hour) |> sort()
#>
#> per_day <- days |>
#> mutate(dw = wday(local_date, week_start = 1), wknd = dw >= 6) |>
#> group_by(wknd) |> summarise(avg = sum(hours) / n(), .groups = "drop")
#>
#> # ---- 7 · stats.json --------------------------------------------------------
#>
#> fmtd <- function(d) format(as_date(d), "%b %e, %Y") |> str_squish()
#>
#> stats <- list(
#> period = list(start = fmtd(min(days$local_date)), end = fmtd(max(days$local_date)),
#> start_iso = as.character(min(days$local_date)),
#> end_iso = as.character(max(days$local_date)),
#> days = nrow(days)),
#> totals = list(plays_all = nrow(plays), plays_music = nrow(music),
#> hours = round(tot_h, 1),
#> artists = nrow(artists), tracks = nrow(tracks),
#> skip_share = round(mean(music$is_skip), 3),
#> podcast_plays = sum(plays$is_podcast),
#> podcast_hours = round(sum(plays$mins[plays$is_podcast]) / 60, 1),
#> podcast_shows = length(PODCAST_SHOWS)),
#> days = list(active = sum(days$hours > 0), silent = sum(days$hours == 0),
#> silent_dates = fmtd(silent_days),
#> mean_h = round(mean(days$hours), 1), median_h = round(median(days$hours), 2),
#> best = list(date = fmtd(days$local_date[which.max(days$hours)]),
#> hours = round(max(days$hours), 1))),
#> streak = list(len = streak$len, start = fmtd(streak$start), end = fmtd(streak$end)),
#> pause = list(start = fmtd(silent_runs$start[1]), len = silent_runs$len[1]),
#> move = list(boundary = "September 1, 2022",
#> note = "exact travel date not recorded; boundary set per Edo"),
#> monthly = monthly |> transmute(mon = format(mon, "%Y-%m"), hours = round(hours, 1), plays),
#> surge = list(before = round(mean(monthly$hours[monthly$mon >= as_date("2022-01-01") &
#> monthly$mon <= as_date("2022-05-01")]), 1),
#> jun = round(monthly$hours[monthly$mon == as_date("2022-06-01")], 1),
#> jul = round(monthly$hours[monthly$mon == as_date("2022-07-01")], 1)),
#> clock = list(peak_sub = peak_hours(ck_sub), peak_pol = peak_hours(ck_pol),
#> night_sub = round(night_share(music |> filter(era == "Surabaya")), 3),
#> night_pol = round(night_share(music |> filter(era == "Poland")), 3),
#> weekday_perday = round(per_day$avg[!per_day$wknd], 2),
#> weekend_perday = round(per_day$avg[per_day$wknd], 2)),
#> artists_top = artists |> slice(1:15) |>
#> transmute(artist = artistName, hours = round(hours, 1), plays,
#> first = fmtd(first), last = fmtd(last)),
#> month_top = month_top |>
#> transmute(mon = format(mon, "%Y-%m"), artist = artistName,
#> hours = round(h, 1), share = round(share, 2)),
#> concentration = list(n25 = conc$n25, n50 = conc$n50, n75 = conc$n75,
#> once = conc$once,
#> once_share = round(conc$once / nrow(artists), 2),
#> top1 = round(conc$top1_share, 3),
#> top10 = round(conc$top10_share, 3)),
#> discovery = list(by_month = new_by_month |>
#> transmute(mon = format(mon, "%Y-%m"), new_artists),
#> eff = eff_artists |>
#> transmute(mon = format(mon, "%Y-%m"), eff = round(eff, 1)),
#> new_tracks = new_track_share |>
#> transmute(mon = format(mon, "%Y-%m"),
#> share = round(share_new, 2))),
#> loops = list(top_tracks = tracks |> slice(1:8) |>
#> transmute(track = trackName, artist = artistName, plays,
#> hours = round(hours, 1),
#> first = fmtd(first), last = fmtd(last)),
#> day_max = day_loops |> slice(1) |>
#> transmute(date = fmtd(local_date), track = trackName,
#> artist = artistName, plays),
#> run_max = runs_tbl |> slice(1) |>
#> transmute(n, track = trackName, artist = artistName, on = fmtd(on)),
#> dec14 = list(date = fmtd(as_date("2021-12-14")),
#> plays = nrow(dec14), one_song = dec14_one,
#> track = dec14$trackName[1], artist = dec14$artistName[1])),
#> habang = list(plays = habang$plays, first = fmtd(habang$first), last = fmtd(habang$last),
#> span_days = as.numeric(habang$last - habang$first) + 1,
#> hours = round(habang$hours, 1)),
#> sjd = list(track = sjd$trackName, plays = sjd$plays, hours = round(sjd$hours, 1),
#> first = fmtd(sjd$first), last = fmtd(sjd$last)),
#> sessions = list(n = nrow(sessions),
#> median_min = round(median(sessions$minutes), 0),
#> median_plays = median(sessions$plays),
#> marathon = list(
#> start = format(with_tz(marathon$start, mar_tz), "%b %e, %H:%M"),
#> end = format(with_tz(marathon$end, mar_tz), "%b %e, %H:%M"),
#> plays = marathon$plays,
#> hours = round(marathon$minutes / 60, 1),
#> top_track = marathon_top$trackName,
#> top_artist = marathon_top$artistName,
#> top_n = marathon_top$n)),
#> vansire = list(gap = vansire$gap, away = fmtd(vansire$away), back = fmtd(vansire$back),
#> burst = vansire_burst, track = vansire_track$trackName,
#> track_n = vansire_track$n)
#> )
#>
#> write_json(stats, file.path(OUT_DATA, "stats.json"),
#> auto_unbox = TRUE, pretty = TRUE, digits = NA)
#> message("wrote data/stats.json")
#>
#> # ---- 8 · browser data ------------------------------------------------------
#>
#> calendar <- list(
#> dates = as.character(days$local_date),
#> hours = round(days$hours, 2), plays = days$n, uniq = days$uniq,
#> top = days$top, era = as.integer(days$era == "Poland"),
#> hourmat = hour_mat |> mutate(m = round(m)) |>
#> pivot_wider(names_from = local_hour, values_from = m) |>
#> select(-local_date) |> as.matrix() |> unname(),
#> move_index = min(which(days$era == "Poland")) - 1
#> )
#> write_json(calendar, file.path(OUT_DATA, "calendar.json"), auto_unbox = TRUE, digits = NA)
#> message("wrote data/calendar.json")
#>
#> top8 <- artists$artistName[1:8]
#> clocks <- list(
#> weekday = round(ck_weekday$share, 4), weekend = round(ck_weekend$share, 4),
#> surabaya = round(ck_sub$share, 4), poland = round(ck_pol$share, 4),
#> months = ck_month |> mutate(mon = format(mon, "%Y-%m"), share = round(share, 4)) |>
#> select(mon, local_hour, share) |>
#> pivot_wider(names_from = local_hour, values_from = share) |>
#> { \(d) setNames(map(seq_len(nrow(d)), \(i) unlist(d[i, -1], use.names = FALSE)),
#> d$mon) }(),
#> artists = setNames(map(top8, \(a)
#> round(clock_share(music |> filter(artistName == a))$share, 4)), top8)
#> )
#> write_json(clocks, file.path(OUT_DATA, "clocks.json"), auto_unbox = TRUE, digits = NA)
#> message("wrote data/clocks.json")
#>
#> if (INCLUDE_FULL_PLAY_LOG) {
#> a_lvl <- unique(music$artistName)
#> t_key <- music |> distinct(artistName, trackName)
#> t_lvl <- t_key |> mutate(tid = row_number() - 1)
#> m2 <- music |>
#> left_join(t_lvl, by = c("artistName", "trackName")) |>
#> mutate(aid = match(artistName, a_lvl) - 1,
#> didx = as.integer(local_date - min(days$local_date)))
#> playlog <- list(
#> artists = a_lvl,
#> tracks = map2(t_lvl$trackName, match(t_lvl$artistName, a_lvl) - 1, \(t, a) list(t, a)),
#> plays = pmap(list(m2$didx, m2$local_hour, m2$tid, round(m2$sec)),
#> \(d, h, t, s) list(d, h, t, s)),
#> meta = list(start = as.character(min(days$local_date)),
#> n_days = nrow(days), move_index = calendar$move_index)
#> )
#> write_json(playlog, file.path(OUT_DATA, "plays.json"), auto_unbox = TRUE, digits = NA)
#> message("wrote data/plays.json (full play log — see privacy note in README)")
#> }
#>
#> # ============================================================================
#> # FIGURES
#> # ============================================================================
#>
#> wk_max <- max(days$hours)
#> month_starts <- days |> filter(day(local_date) == 1 | idx == 0)
#>
#> # ---- fig 1 · the year as four bars ----------------------------------------
#>
#> fourbars_df <- days |>
#> mutate(row = pmin(idx %/% 92, 3), col = idx - row * 92,
#> y0 = (3 - row) * 1.5,
#> yh = hours / wk_max)
#>
#> fb_months <- fourbars_df |>
#> filter(day(local_date) == 1 | idx == 0) |>
#> mutate(lab = if_else(month(local_date) %in% c(1, 12),
#> format(local_date, "%b \u2019%y"), format(local_date, "%b")))
#>
#> streak_seg <- fourbars_df |>
#> filter(local_date >= streak$start, local_date <= streak$end) |>
#> group_by(row, y0) |> summarise(x0 = min(col), x1 = max(col), .groups = "drop")
#>
#> move_pt <- fourbars_df |> filter(local_date == as_date("2022-09-01"))
#> best_pt <- fourbars_df |> filter(hours == max(hours))
#> silent_pts <- fourbars_df |> filter(hours == 0)
#>
#> p1 <- ggplot(fourbars_df) +
#> geom_segment(aes(x = col, xend = col, y = y0, yend = y0 + yh),
#> linewidth = .55, colour = INK, lineend = "round") +
#> geom_segment(data = streak_seg, aes(x = x0, xend = x1, y = y0 - .13, yend = y0 - .13),
#> colour = EMBER, linewidth = 1.1) +
#> geom_point(data = silent_pts, aes(x = col, y = y0 - .13),
#> shape = 21, fill = PAPER, colour = INK2, size = 1.7, stroke = .6) +
#> geom_segment(data = move_pt, aes(x = col, xend = col, y = y0 - .32, yend = y0 + 1.08),
#> colour = TEAL, linewidth = .6, linetype = "22") +
#> geom_text(data = move_pt, aes(x = col + 1.5, y = y0 + 1.12),
#> label = "Surabaya → Poland", colour = TEAL, family = FONT,
#> fontface = "bold", size = 3.1, hjust = 0) +
#> geom_text(data = best_pt, aes(x = col, y = y0 + yh + .16),
#> label = paste0("biggest day · ", round(best_pt$hours, 1), " h"),
#> colour = INK, family = FONT, size = 3, hjust = .5) +
#> geom_text(data = fb_months, aes(x = col, y = y0 - .36, label = lab),
#> colour = INK2, family = FONT, size = 2.9, hjust = 0) +
#> annotate("text", x = streak_seg$x0[1] + 1, y = streak_seg$y0[1] - .55,
#> label = paste0(streak$len, "-day streak"), colour = EMBER,
#> family = FONT, fontface = "bold", size = 3, hjust = 0) +
#> scale_x_continuous(expand = expansion(add = c(1, 1))) +
#> scale_y_continuous(expand = expansion(add = c(.35, .30))) +
#> theme_void(base_family = FONT) +
#> theme(plot.background = element_rect(fill = PAPER, colour = NA),
#> plot.margin = margin(6, 10, 2, 10))
#>
#> save_svg(p1, "fig1-fourbars.svg", 8.4, 4.9)
#>
#> # ---- fig 2 · weekly timeline, annotated -----------------------------------
#>
#> weekly <- music |> group_by(wk) |> summarise(h = sum(mins) / 60, .groups = "drop")
#> thesis <- as_date(c("2022-05-01", "2022-09-30"))
#>
#> ann <- tibble(
#> x = as_date(c("2022-06-20", "2022-09-29", "2022-02-01")),
#> y = c(max(weekly$h) * 1.14, max(weekly$h) * .40, max(weekly$h) * .78),
#> lab = c("June: listening more than doubles",
#> "the only 2-day silence\nof the year",
#> "steady spring —\n15–19 h a week"),
#> hj = c(.5, 0, 0)
#> )
#>
#> p2 <- ggplot(weekly, aes(wk, h)) +
#> annotate("rect", xmin = thesis[1], xmax = thesis[2], ymin = -Inf, ymax = Inf,
#> fill = PANEL, alpha = .8) +
#> annotate("text", x = thesis[1] + 2, y = max(weekly$h) * 1.02,
#> label = "thesis months", colour = INK2, family = FONT,
#> size = 3.1, hjust = 0, fontface = "italic") +
#> geom_col(fill = INK, width = 5.4) +
#> annotate("segment", x = streak$start, xend = streak$end, y = -1.6, yend = -1.6,
#> colour = EMBER, linewidth = 1.2) +
#> annotate("text", x = streak$start, y = -3.9,
#> label = paste0("played every single day for ", streak$len, " days"),
#> colour = EMBER, family = FONT, fontface = "bold", size = 3, hjust = 0) +
#> geom_vline(xintercept = as.numeric(as_date("2022-09-01")),
#> colour = TEAL, linetype = "22", linewidth = .55) +
#> annotate("text", x = as_date("2022-09-03"), y = max(weekly$h) * .93,
#> label = "the move", colour = TEAL, family = FONT,
#> fontface = "bold", size = 3.1, hjust = 0) +
#> geom_text(data = ann, aes(x, y, label = lab, hjust = hj),
#> colour = INK2, family = FONT, size = 3, lineheight = .95) +
#> annotate("point", x = as_date("2022-09-26"), y = max(weekly$h) * .33,
#> shape = 21, fill = PAPER, colour = INK2, size = 2.4, stroke = .7) +
#> scale_x_date(date_breaks = "2 months", date_labels = "%b ’%y",
#> expand = expansion(add = c(4, 4))) +
#> scale_y_continuous(breaks = seq(0, 60, 15), limits = c(-4.5, NA)) +
#> labs(x = NULL, y = "hours of music per week") +
#> theme_story() +
#> theme(panel.grid.major.x = element_blank())
#>
#> save_svg(p2, "fig2-weekly.svg", 8.4, 3.9)
#>
#> # ---- fig 3 · static calendar (no-JS fallback) ------------------------------
#>
#> cal <- days |>
#> mutate(mlab = fct_inorder(format(local_date, "%b ’%y")),
#> wrow = (isoweek(local_date) - isoweek(floor_date(local_date, "month"))) %% 6,
#> wrow = { # week-of-month, Monday-start, robust across years
#> first_dow <- wday(floor_date(local_date, "month"), week_start = 1)
#> (mday(local_date) + first_dow - 2) %/% 7
#> },
#> dcol = wday(local_date, week_start = 1))
#>
#> p3 <- ggplot(cal, aes(dcol, -wrow, fill = hours)) +
#> geom_tile(colour = PAPER, linewidth = .8) +
#> geom_point(data = cal |> filter(hours == 0), colour = INK2,
#> size = .5, show.legend = FALSE) +
#> facet_wrap(~mlab, ncol = 5) +
#> scale_fill_gradient(low = RAMP_LO, high = INK, name = "hours",
#> breaks = c(0, 4, 8, 12)) +
#> coord_fixed() +
#> theme_story() +
#> theme(axis.text = element_blank(), panel.grid = element_blank(),
#> legend.position = "bottom",
#> legend.key.height = unit(.32, "cm"), legend.key.width = unit(1.1, "cm"),
#> legend.title = element_text(size = rel(.8), colour = INK2),
#> legend.text = element_text(size = rel(.7), colour = INK2)) +
#> labs(x = NULL, y = NULL)
#>
#> save_svg(p3, "fig3-calendar.svg", 8.4, 6.6)
#>
#> # ---- fig 4 · the clock: weekday/weekend + the two cities -------------------
#>
#> ck_a <- bind_rows(ck_weekday |> mutate(g = "weekdays"),
#> ck_weekend |> mutate(g = "weekends"))
#> ck_b <- bind_rows(ck_sub |> mutate(g = "Surabaya months"),
#> ck_pol |> mutate(g = "Poland months"))
#>
#> clock_panel <- function(d, cols, title) {
#> labs_d <- d |> group_by(g) |> slice_max(share, n = 1, with_ties = FALSE)
#> ggplot(d, aes(local_hour, share * 100, colour = g)) +
#> geom_line(linewidth = .9) +
#> geom_text(data = labs_d, aes(label = g), hjust = .35, nudge_y = .55,
#> family = FONT, fontface = "bold", size = 3) +
#> scale_colour_manual(values = cols, guide = "none") +
#> scale_x_continuous(breaks = c(0, 6, 12, 18, 23),
#> labels = c("00", "06", "12", "18", "23"),
#> expand = expansion(add = c(.4, 1.2))) +
#> expand_limits(y = max(d$share) * 100 + 1.1) +
#> labs(x = "local hour", y = "% of listening", subtitle = title) +
#> theme_story()
#> }
#>
#> p4a <- clock_panel(ck_a, c(weekdays = INK, weekends = INK2), "weekdays vs weekends")
#> p4b <- clock_panel(ck_b, c(`Surabaya months` = INK, `Poland months` = TEAL),
#> "before and after the move")
#> save_svg(p4a, "fig4a-clock-week.svg", 4.6, 3.3)
#> save_svg(p4b, "fig4b-clock-move.svg", 4.6, 3.3)
#>
#> # ---- fig 5 · thirteen months of clock strips -------------------------------
#>
#> p5 <- ck_month |>
#> mutate(mlab = fct_rev(fct_inorder(format(mon, "%b ’%y")))) |>
#> ggplot(aes(local_hour, mlab, fill = share)) +
#> geom_tile(colour = PAPER, linewidth = .5, height = .8) +
#> scale_fill_gradient(low = RAMP_LO, high = INK, guide = "none") +
#> scale_x_continuous(breaks = c(0, 6, 12, 18, 23),
#> labels = c("00", "06", "12", "18", "23"),
#> expand = expansion(add = .3)) +
#> annotate("segment", x = -.9, xend = 23.9,
#> y = 4.5, yend = 4.5, colour = TEAL, linetype = "22", linewidth = .5) +
#> annotate("text", x = 23.9, y = 4.82, label = "the move", colour = TEAL,
#> family = FONT, size = 2.9, fontface = "bold", hjust = 1) +
#> labs(x = "local hour", y = NULL,
#> subtitle = "each row: how one month’s listening spread across the day") +
#> theme_story() +
#> theme(panel.grid = element_blank())
#>
#> save_svg(p5, "fig5-months-clock.svg", 8.4, 4.6)
#>
#> # ---- fig 6 · artists as chapters ------------------------------------------
#>
#> top30 <- artists |> slice(1:30) |>
#> left_join(first_seen, by = "artistName") |>
#> arrange(debut, desc(hours)) |>
#> mutate(yr = row_number(),
#> censored = debut <= as_date("2021-12-12"),
#> lab = if_else(censored, paste0(artistName, " *"), artistName))
#>
#> wk_art <- music |>
#> filter(artistName %in% top30$artistName) |>
#> group_by(artistName, wk) |>
#> summarise(h = sum(mins) / 60, .groups = "drop") |>
#> left_join(top30 |> select(artistName, yr), by = "artistName") |>
#> group_by(artistName) |>
#> mutate(peak = h == max(h)) |> ungroup() |>
#> mutate(hh = sqrt(h / max(h)) * .86)
#>
#> deb_pts <- top30 |> filter(!censored) |>
#> mutate(wkd = floor_date(debut, "week", week_start = 1))
#> last_pts <- artists |> filter(artistName %in% top30$artistName,
#> last <= max(days$local_date) - 56) |>
#> left_join(top30 |> select(artistName, yr), by = "artistName") |>
#> mutate(wkd = floor_date(last, "week", week_start = 1))
#>
#> p6 <- ggplot(wk_art) +
#> geom_segment(aes(x = wk, xend = wk, y = yr - hh / 2, yend = yr + hh / 2,
#> colour = peak), linewidth = 1.55, lineend = "butt") +
#> scale_colour_manual(values = c(`FALSE` = INK, `TRUE` = EMBER), guide = "none") +
#> geom_point(data = deb_pts, aes(wkd, yr), shape = 23, fill = TEAL,
#> colour = PAPER, size = 1.9, stroke = .4) +
#> geom_point(data = last_pts, aes(wkd, yr), shape = 21, fill = PAPER,
#> colour = INK2, size = 1.9, stroke = .6) +
#> geom_vline(xintercept = as.numeric(as_date("2022-09-01")),
#> colour = TEAL, linetype = "22", linewidth = .45) +
#> scale_y_reverse(breaks = top30$yr, labels = top30$lab,
#> expand = expansion(add = .8),
#> sec.axis = sec_axis(~., breaks = top30$yr,
#> labels = paste0(round(top30$hours), " h"))) +
#> scale_x_date(date_breaks = "2 months", date_labels = "%b ’%y",
#> expand = expansion(add = 5)) +
#> labs(x = NULL, y = NULL,
#> subtitle = "the 30 biggest artists of the year, ordered by when they first appear ◆ first play ○ last play (early exits only) ▮ peak week") +
#> theme_story(10.8) +
#> theme(panel.grid.major.y = element_blank(),
#> axis.text.y = element_text(colour = INK, size = rel(.88)),
#> axis.text.y.right = element_text(colour = MUTE, size = rel(.78)),
#> plot.subtitle = element_text(size = rel(.82)))
#>
#> save_svg(p6, "fig6-chapters.svg", 8.4, 8.2)
#>
#> # ---- fig 7 · grooves: the most-repeated songs ------------------------------
#>
#> RING <- 75 # one ring per 75 plays
#> groove_df <- tracks |> slice(1:8) |>
#> mutate(gx = (row_number() - 1) %% 4, gy = -((row_number() - 1) %/% 4) * 1.25)
#>
#> arcs <- pmap(list(groove_df$plays, groove_df$gx, groove_df$gy, seq_len(8)),
#> \(n, gx, gy, id) {
#> rings <- n / RING
#> map_dfr(seq_len(ceiling(rings)), \(k) {
#> frac <- min(1, rings - (k - 1))
#> th <- seq(-pi / 2, -pi / 2 + 2 * pi * frac * .92, length.out = 90)
#> r <- .12 + k * .06
#> tibble(x = gx + r * cos(th), y = gy + r * sin(th),
#> grp = paste(id, k))
#> })
#> }) |> list_rbind()
#>
#> p7 <- ggplot() +
#> geom_path(data = arcs, aes(x, y, group = grp), colour = INK,
#> linewidth = .8, lineend = "round") +
#> geom_text(data = groove_df, aes(gx, gy, label = plays), colour = EMBER,
#> family = FONT, fontface = "bold", size = 3.6) +
#> geom_text(data = groove_df, aes(gx, gy - .60, label = str_trunc(trackName, 26)),
#> colour = INK, family = FONT, fontface = "bold", size = 2.9) +
#> geom_text(data = groove_df,
#> aes(gx, gy - .76, label = paste0(str_trunc(artistName, 24), " · ",
#> format(first, "%b"), "–", format(last, "%b"))),
#> colour = INK2, family = FONT, size = 2.6) +
#> coord_fixed(clip = "off") +
#> scale_x_continuous(expand = expansion(add = .55)) +
#> scale_y_continuous(expand = expansion(add = c(.6, .45))) +
#> labs(subtitle = paste0("the eight most-repeated songs — one ring per ",
#> RING, " plays; the number is total plays")) +
#> theme_void(base_family = FONT) +
#> theme(plot.background = element_rect(fill = PAPER, colour = NA),
#> plot.subtitle = element_text(colour = INK2, size = 9.5,
#> margin = margin(4, 0, 6, 0)),
#> plot.margin = margin(8, 12, 8, 12))
#>
#> save_svg(p7, "fig7-grooves.svg", 8.4, 5.2)
#>
#> # ---- fig 8 · variety: exploring vs retreating ------------------------------
#>
#> var_df <- eff_artists |>
#> left_join(new_track_share, by = "mon") |>
#> mutate(mlab = fct_inorder(format(mon, "%b ’%y")))
#>
#> p8a <- ggplot(var_df, aes(mon, eff)) +
#> geom_line(colour = TEAL, linewidth = .9) +
#> geom_point(colour = TEAL, size = 1.8) +
#> expand_limits(y = max(var_df$eff) + 16) +
#> annotate("text", x = as_date("2022-04-01"), y = max(var_df$eff) + 11,
#> label = "April: the most exploratory month", colour = TEAL,
#> family = FONT, fontface = "bold", size = 3, hjust = .5) +
#> annotate("text", x = as_date("2022-07-01"), y = min(var_df$eff) + 6,
#> label = "deep-thesis July:\nretreat to the familiar", colour = INK2,
#> family = FONT, size = 2.9, hjust = .5, lineheight = .95, vjust = 0) +
#> scale_x_date(date_breaks = "2 months", date_labels = "%b ’%y") +
#> labs(x = NULL, y = "effective number of artists",
#> subtitle = "how many artists a month *really* spread across") +
#> theme_story()
#>
#> p8b <- ggplot(var_df, aes(mon, share_new * 100)) +
#> geom_col(fill = INK2, width = 16) +
#> scale_x_date(date_breaks = "2 months", date_labels = "%b ’%y") +
#> labs(x = NULL, y = "% tracks heard for the first time",
#> subtitle = "share of each month’s tracks that were brand new to the year") +
#> theme_story() + theme(panel.grid.major.x = element_blank())
#>
#> save_svg(p8a, "fig8a-variety.svg", 8.4, 3.1)
#> save_svg(p8b, "fig8b-newtracks.svg", 8.4, 2.7)
#>
#> # ---- fig 9 · concentration -------------------------------------------------
#>
#> conc_df <- tibble(rank = seq_len(nrow(artists)),
#> cum = cumsum(artists$hours) / tot_h * 100)
#> marks <- tibble(rank = c(conc$n25, conc$n50, conc$n75), pct = c(25, 50, 75),
#> lab = paste0(c(conc$n25, conc$n50, conc$n75), " artists → ",
#> c(25, 50, 75), "%"))
#>
#> p9 <- ggplot(conc_df, aes(rank, cum)) +
#> geom_line(colour = INK, linewidth = .9) +
#> geom_segment(data = marks, aes(x = rank, xend = rank, y = 0, yend = pct),
#> colour = EMBER, linetype = "13", linewidth = .5) +
#> geom_point(data = marks, aes(rank, pct), colour = EMBER, size = 2) +
#> geom_text(data = marks, aes(rank, pct, label = lab), colour = EMBER,
#> family = FONT, fontface = "bold", size = 2.9,
#> hjust = 0, nudge_x = .06, vjust = 1.4) +
#> annotate("text", x = 300, y = 20,
#> label = paste0(conc$once, " artists — ",
#> round(conc$once / nrow(artists) * 100), "% of everyone\n",
#> "I heard all year — appear exactly once"),
#> colour = INK2, family = FONT, size = 3, hjust = 0, lineheight = .98) +
#> scale_x_log10(breaks = c(1, 10, 100, 1000),
#> labels = comma(c(1, 10, 100, 1000))) +
#> scale_y_continuous(labels = \(v) paste0(v, "%")) +
#> labs(x = "artists, ranked by hours (log scale)",
#> y = "cumulative share of all listening") +
#> theme_story()
#>
#> save_svg(p9, "fig9-concentration.svg", 8.4, 3.6)
#>
#> # ---- featured image --------------------------------------------------------
#>
#> feat <- ggplot(fourbars_df) +
#> geom_segment(aes(x = col, xend = col, y = y0, yend = y0 + yh),
#> linewidth = 1.05, colour = INK, lineend = "round") +
#> geom_segment(data = streak_seg, aes(x = x0, xend = x1, y = y0 - .16, yend = y0 - .16),
#> colour = EMBER, linewidth = 1.6) +
#> geom_segment(data = move_pt, aes(x = col, xend = col, y = y0 - .32, yend = y0 + 1.05),
#> colour = TEAL, linewidth = 1, linetype = "22") +
#> scale_y_continuous(expand = expansion(add = c(.35, .95))) +
#> annotate("text", x = 0, y = 5.9, label = "A Year in 22,197 Plays",
#> family = FONT, fontface = "bold", size = 12.5, colour = INK, hjust = 0) +
#> annotate("text", x = 0, y = 5.28,
#> label = "Dec 2021 – Dec 2022 · Surabaya → Poland",
#> family = FONT, size = 5.4, colour = INK2, hjust = 0) +
#> theme_void(base_family = FONT) +
#> theme(plot.background = element_rect(fill = PAPER, colour = NA),
#> plot.margin = margin(28, 34, 22, 34))
#>
#> if (requireNamespace("ragg", quietly = TRUE)) {
#> ragg::agg_png(file.path(OUT_PAGE, "featured.png"), width = 1600, height = 900,
#> res = 150, background = PAPER)
#> print(feat); invisible(dev.off())
#> message("wrote featured.png")
#> }
#>
#> message("\npipeline complete.")