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

Relay.fm spans 43 shows and a combined runtime of over 191 days spread across 4467 episodes since 2014.

In 2019, there were 729 episodes published, and we’re currently about 6% of the way there at 44 episodes this year.

Shows by Age

readRDS("data/relay.rds") %>% group_by(podcast) %>% mutate(d_min = min(date), 
    d_max = max(date)) %>% ggplot(aes(x = reorder(podcast, d_min), color = show_status)) + 
    geom_errorbar(aes(ymin = d_min, ymax = d_max), width = 0.5, size = 2, alpha = 0.75) + 
    coord_flip() + scale_x_discrete(position = "top") + scale_color_brewer(palette = "Dark2") + 
    labs(x = "", y = "First to Last Episode Date", title = "Relay.fm", subtitle = "Show Timelines", 
        caption = caption, color = "Status") + theme(legend.position = "top")

Shows per Year

relay %>% group_by(podcast, year) %>% tally %>% ggplot(aes(x = as.factor(year), 
    weight = n, fill = podcast)) + geom_bar() + scale_y_continuous(breaks = seq(0, 
    1000, 100), minor_breaks = seq(0, 1000, 25)) + scale_fill_viridis(discrete = TRUE, 
    guide = guide_legend(ncol = 2, keyheight = 1.5)) + labs(x = "Year", y = "# of Episodes", 
    fill = "Show", title = "Relay.fm", subtitle = "Episodes per Year", caption = caption) + 
    theme_ipsum(grid = "y") + theme(legend.key.size = unit(0.2, "cm"))

Shows per Week

relay %>% mutate(week = week(date), year_num = year(date)) %>% filter(year_num >= 
    2014) %>% group_by(year, week) %>% tally %>% {
    ggplot(data = ., aes(x = week, y = n)) + geom_point() + geom_smooth(method = lm, 
        se = F, color = "red") + scale_y_continuous(breaks = seq(0, 100, 5), 
        minor_breaks = seq(0, 100, 1)) + scale_x_continuous(breaks = seq(0, 
        55, 16)) + facet_wrap(~year) + labs(title = "Relay.fm", subtitle = "Weekly Episode Output", 
        x = "Week of Year", y = "Episodes Published", caption = caption) + theme_ipsum(grid = "y")
}

Regularity

relay %>% mutate(week = isoweek(date), year_num = year(date)) %>% filter(year_num == 
    2017) %>% group_by(podcast, 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(~podcast, ncol = 3) + labs(title = "Relay.fm", subtitle = "Episodes per Week in 2017", 
    x = "Week of Year", y = "# fo Episodes", caption = caption) + theme_ipsum(grid = "y") + 
    theme(axis.text.y = element_text(size = rel(0.5)))

Shows per Month

relay %>% mutate(month = month(date), year_num = year(date)) %>% filter(year_num >= 
    2014) %>% group_by(year, month) %>% tally %>% {
    ggplot(data = ., aes(x = month, y = n)) + geom_point() + geom_smooth(method = lm, 
        se = F, color = "red") + scale_y_continuous(breaks = seq(0, 100, 15), 
        minor_breaks = seq(0, 100, 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", subtitle = "Monthly Episode Output", 
        x = "Month of Year", y = "Episodes Published", caption = caption) + 
        theme_ipsum() + theme(axis.text.x = element_text(size = rel(0.9)))
}

Runtimes

All Shows

relay %>% filter(year >= 2011) %>% ggplot(aes(x = date, y = duration, color = podcast)) + 
    geom_point(alpha = 0.5) + scale_x_date(date_breaks = "1 years", date_labels = "%Y", 
    date_minor_breaks = "1 month") + scale_y_continuous(breaks = seq(0, 300, 
    60), minor_breaks = seq(0, 300, 15), limits = c(0, NA)) + scale_color_viridis(discrete = TRUE, 
    guide = guide_legend(ncol = 1, keyheight = 0.75, )) + labs(title = "Relay.fm", 
    subtitle = "Episode Durations of Every Episode Since 2011", x = "Date Published", 
    y = "Duration (mins)", color = "Show", caption = caption)

relay %>% filter(podcast != "B-Sides") %>% {
    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_continuous(breaks = seq(0, 300, 30), 
        minor_breaks = seq(0, 300, 15)) + facet_wrap(~podcast, ncol = 5) + labs(title = "Relay.fm", 
        subtitle = "Episode Durations", x = "Date Published", y = "Duration (mins)", 
        caption = caption) + theme_ipsum(grid = "y") + theme(axis.text.x = element_text(angle = 90, 
        vjust = 0.5))
}

Histogram

relay %>% ggplot(aes(x = duration)) + geom_histogram(binwidth = 2.5) + geom_density(aes(y = ..count.., 
    group = 1), fill = "black", alpha = 0.3) + scale_x_continuous(breaks = seq(0, 
    600, 30), minor_breaks = seq(0, 600, 5)) + scale_y_continuous(breaks = seq(0, 
    600, 50)) + labs(title = "Relay.fm", subtitle = "Episode Durations", y = "Frequency", 
    x = "Duration (mins)", caption = caption) + theme_ipsum(grid = "YX")

Average by Show

Boxplots

relay %>% # filter(podcast != 'B-Sides') %>%
group_by(podcast) %>% mutate(dur_mean = mean(duration)) %>% {
    ggplot(., aes(x = forcats::fct_reorder(podcast, dur_mean), y = duration)) + 
        geom_boxplot() + stat_summary(fun.y = "mean", geom = "point", size = 2, 
        color = "black", fill = "red", shape = 21) + coord_flip() + scale_y_continuous(breaks = seq(0, 
        300, 30), minor_breaks = seq(0, 300, 15)) + labs(title = "Relay.fm", 
        subtitle = "Episode Duration — Boxplot + Mean (red)", x = "", y = "Duration (mins)", 
        caption = caption) + theme_ipsum()
}

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.

relay %>% separate_rows(people, sep = ",\\s+") %>% mutate(people = str_remove(people, 
    ",") %>% str_trim(side = "both")) %>% count(people) %>% ggplot(aes(x = reorder(people, 
    n), y = n)) + geom_col() + coord_flip() + labs(title = "Relay.fm", subtitle = "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!

people_activity <- relay %>% separate_rows(people, sep = ",\\s+") %>% mutate(people = str_remove(people, 
    ",") %>% str_trim(side = "both")) %>% group_by(people) %>% summarize(n = n(), 
    duration = sum(duration), first_show = min(date), last_show = max(date), 
    weeks_active = first_show %--% last_show/dweeks(1), duration_per_week = duration/weeks_active)


ggplot(people_activity, aes(x = reorder(people, duration_per_week), y = duration_per_week)) + 
    geom_col() + coord_flip() + labs(title = "Relay.fm", subtitle = "Total duration per host divided by number of weeks active\n(First to latest appearance)", 
    x = "", y = "Average Duration (mins)", caption = caption)

Period of host activity

ggplot(people_activity) + geom_segment(aes(x = forcats::fct_reorder(people, 
    first_show, .desc = TRUE), xend = people, y = first_show, yend = last_show), 
    size = 2, alpha = 0.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)