Podcast Stats
  • Overview
  • The Incomparable
    • The Motshership
    • The Network
  • Relay FM
  • ATP
  • Data

On this page

  • Overview
    • Shows by Age
    • Shows per Year
    • Shows per Week
      • Regularity (TBA)
    • Shows per Month
  • Runtimes
    • All Shows
      • Histogram
    • Average by Show
      • Boxplots
  • People
    • Host by hours per week of podcasting, says @lbutlr in the slack
    • Period of host activity

Relay FM — In Numbers

Author

Lukas Burk

Updated

May 4, 6:24 (UTC)

After doing The Incomparable, I had to go see what I could do with Relay FM’s data as well, naturally.
So this is the beginning of that. The source code is included in this repo, and, in case anyone asks:
Yes, you can use these graphs for whatever. Maybe link back to me, that would be cool.

Please note that there’s probably still stuff coming.

Overview

Code
lastyear <- relay_episodes |>
  filter(year == year(now()) - 1) |>
  nrow()
thisyear <- relay_episodes |>
  filter(year == year(now())) |>
  nrow()
progress <- round(thisyear / lastyear * 100, 1)

Relay FM spans 49 shows and a combined runtime of over 374 days spread across 8393 episodes since 2014.

In 2024, there were 555 episodes published, and we’re currently about 29.7% of the way there at 165 episodes this year.

Shows by Age

Code
relay_episodes |>
  #filter(year >= 2014) |>
  group_by(show) |>
  mutate(
    d_min = min(date),
    d_max = max(date)
  ) |>
  ggplot(aes(y = reorder(show, d_min), color = show_status)) +
  geom_errorbar(aes(xmin = d_min, xmax = d_max),
    width = .5, linewidth = 2, alpha = .75
  ) +
  geom_vline(xintercept = as.Date("2014-01-01"), linetype = "dashed") +
  scale_x_date(
    date_breaks = "2 years", date_labels = "%Y",
    date_minor_breaks = "1 year"
  ) +
  scale_y_discrete(position = "right") +
  scale_color_brewer(palette = "Dark2") +
  labs(
    y = NULL, x = "First to Last Episode Date",
    title = "Relay FM: Show Timelines", 
    #subtitle = "Since 2014",
    caption = caption, color = "Status"
  ) +
  theme(legend.position = "top")

Shows per Year

Code
relay_episodes |>
  filter(year >= 2014) |>
  group_by(show, year) |>
  tally() |>
  ggplot(aes(x = as.factor(year), weight = n, fill = show)) +
  geom_bar(show.legend = FALSE) +
  scale_y_continuous(
    breaks = seq(0, 1e6, 200),
    minor_breaks = seq(0, 1e6, 100)
  ) +
  scale_fill_viridis_d(guide = guide_legend(ncol = 2, keyheight = 1.5)) +
  labs(
    x = "Year", y = "# of Episodes", fill = "Show",
    title = "Relay FM: Episodes per Year",
    subtitle = "One color per show, but too many shows for a legible legend, sorry.",
    caption = caption
  )

Shows per Week

Code
relay_episodes |>
  mutate(
    week = week(date),
    year_num = year(date)
  ) |>
  filter(year_num >= 2014) |>
  group_by(year, week) |>
  tally() |>
  ggplot(aes(x = week, y = n)) +
    geom_point() +
    geom_smooth(method = lm, formula = y ~ x, se = FALSE, color = "red") +
    scale_y_continuous(
      breaks = seq(0, 100, 10),
      minor_breaks = seq(0, 100, 5)
    ) +
    scale_x_continuous(breaks = seq(0, 55, 16)) +
    facet_wrap(~year) +
    labs(
      title = "Relay FM: Weekly Episode Output",
      x = "Week of Year", y = "Episodes Published", caption = caption
    )

Regularity (TBA)

Code
relay_episodes |>
  mutate(
    week = isoweek(date),
    year_num = year(date)
  ) |>
  filter(year_num == current_year) |>
  group_by(show, year, week) |>
  tally() |>
  ggplot(aes(x = week, y = n)) +
  geom_col() +
  # scale_y_continuous(breaks = seq(0, 10, 1)) +
  # scale_x_continuous(breaks = seq(0, 60, 10)) +
  facet_wrap(~show, ncol = 3, scales = "free") +
  labs(
    title = "Relay FM", subtitle = "Episodes per Week in the current year",
    x = "Week of Year", y = "# fo Episodes", caption = caption
  ) +
  theme(axis.text.y = element_text(size = rel(.5)))

Shows per Month

Code
relay_episodes |>
  mutate(
    month = month(date),
    year_num = year(date)
  ) |>
  filter(year_num >= 2014) |>
  group_by(year, month) |>
  tally() |>
  ggplot(aes(x = month, y = n)) +
    geom_point() +
    geom_smooth(method = lm, formula = y ~ x, se = FALSE, color = "red") +
    scale_y_continuous(
      breaks = seq(0, 1e6, 10),
      minor_breaks = seq(0, 1e6, 5)
    ) +
    scale_x_continuous(
      breaks = seq(0, 13, 2),
      minor_breaks = seq(0, 13, 1)
    ) +
    facet_grid(. ~ year, space = "free_x", scales = "free_x") +
    labs(
      title = "Relay FM: Monthly Episode Output",
      x = "Month of Year", y = "Episodes Published", caption = caption
    ) +
    theme(axis.text.x = element_text(size = rel(.9)))

Runtimes

All Shows

Code
relay_episodes |>
  filter(year >= 2014, duration <= hms(hours = 4)) |>
  ggplot(aes(x = date, y = duration, color = show)) +
  geom_point(alpha = .5, show.legend = FALSE) +
  scale_x_date(
    date_breaks = "1 years",
    date_labels = "%Y",
    minor_breaks = NULL
  ) +
  scale_y_time(
    breaks = hms(hours = seq(0, 1e6, 1)),
    limits = c(0, NA)
  ) +
  scale_color_viridis_d(guide = guide_legend(ncol = 1, keyheight = .75, )) +
  labs(
    title = "Relay FM: Episode Durations of Every Episode Since 2014",
    subtitle = "No legend, but one color per show. Only for episodes < 4 hours",
    x = "Date Published", y = "Duration (HH:MM:SS)", color = "Show",
    caption = caption
  )

Code
relay_episodes |>
  filter(show != "B-Sides", year >= 2014) |>
  ggplot(aes(x = date, y = duration)) +
    geom_point() +
    expand_limits(y = 0) +
    scale_x_date(
      breaks = date_breaks("12 months"),
      minor_breaks = date_breaks("6 month"),
      date_labels = "%Y"
    ) +
    scale_y_time(
      breaks = hms(minutes = seq(0, 1e6, 60))
    ) +
    facet_wrap(~show, ncol = 5, scales = "free") +
    labs(
      title = "Relay FM", subtitle = "Episode Durations",
      x = "Date Published", y = "Duration (HH:MM:SS)", caption = caption
    ) +
    theme(axis.text.x = element_text(angle = 90, vjust = .5))

Histogram

Code
relay_episodes |>
  filter(duration <= hms(hours = 3)) |>
  ggplot(aes(x = duration)) +
  geom_histogram(binwidth = 120, fill = "gray", color = "white") +
  scale_x_time(
    breaks = hms(minutes = seq(0, 1e6, 30))
  ) +
  scale_y_continuous(breaks = seq(0, 600, 50)) +
  labs(
    title = "Relay FM: Episode Durations", 
    subtitle = "Limited to episodes under 3 hours",
    y = "Episode Count", x = "Duration (HH:MM:SS)", caption = caption
  )

Average by Show

Boxplots

Code
relay_episodes |>
  group_by(show) |>
  ggplot(aes(x = forcats::fct_reorder(show, duration, .fun = mean), y = duration)) +
    geom_boxplot() +
    stat_summary(
      fun = "mean", geom = "point", size = 2,
      color = "black", fill = "red", shape = 21
    ) +
    coord_flip() +
    scale_y_time(
      breaks = hms(minutes = seq(0, 1e6, 60))
    ) +
    labs(
      title = "Relay FM",
      subtitle = "Episode Duration — Boxplot + Mean (red)",
      x = "", y = "Duration (HH:MM:SS)", caption = caption
    )

People

Sadly I don’t have a lot of data about people besides the hosts of each show. I could try to pry out the guests of shows out of each show’s RSS feed, but sadly this information is not neatly presented in the feed, but rather would require an amount of regexing I am not prepared, and therefore not able to do.
Be that as it may, here’s a bit about the hosts.

Code
relay_episodes |>
  gather_people() |>
  count(person) |>
  ggplot(aes(x = reorder(person, n), y = n)) +
  geom_col() +
  coord_flip() +
  labs(
    title = "Relay FM: Person by Number of Episodes",
    x = "", y = "# of Episodes Hosted",
    caption = caption
  )

Host by hours per week of podcasting, says @lbutlr in the slack

Sooo okay! Filtered by episodes airing in 2014 or later though.

Code
relay_episodes |>
  filter(year >= 2014) |>
  gather_people() |>
  group_by(person) |>
  summarize(
    n = n(),
    duration = sum(duration, na.rm = TRUE),
    first_show = min(date, na.rm = TRUE),
    last_show = max(date), na.rm = TRUE,
    weeks_active = first_show %--% last_show / dweeks(1),
    duration_per_week = as_hms(duration / weeks_active),
    .groups = "drop"
  ) ->
  people_activity


ggplot(people_activity, aes(x = reorder(person, duration_per_week), y = duration_per_week)) +
  geom_col() +
  coord_flip() +
  scale_y_time(
    breaks = hms(minutes = seq(0, 1e6, 60)),
    labels = \(x) str_extract(as.character(x), "\\d{2}:\\d{2}")
  ) +
  labs(
    title = "Relay FM",
    subtitle = "Total duration per host divided by number of weeks active\n(First to latest appearance)",
    x = "", y = "Average Duration (HH:MM:SS)",
    caption = caption
  )

Period of host activity

Code
ggplot(people_activity) +
  geom_segment(aes(
    x = forcats::fct_reorder(person, first_show, .desc = TRUE), xend = person,
    y = first_show, yend = last_show
  ),
  linewidth = 2, alpha = .75
  ) +
  coord_flip() +
  labs(
    title = "Relay FM",
    subtitle = "Period of hosting activity (first to most recent show)\nOrdered by first appearance",
    x = "", y = "Date of show",
    caption = caption
  )

 
  • About