Show the code
pacman::p_load("tidyverse", "readr", "ggplot2", "lubridate", "purrr", "scales", "magrittr", "ggpubr", "forcats", "see", "stringr")Doctor Who: The Revival Era Analysis
Introduction
Broadcasted by the BBC, Doctor Who is a British Science-Fiction TV Series. To date, 319 stories have been broadcast: 155 from the Classic Era (1963-1989); 1 film (1996); and 163, since the Revival Era began in 2005.
This analysis focuses on the Revival Era, where there have been 7 Doctors, 15 Series, and 4 eras of Showrunner. It looks at why the show performed best with 13 episodes per series, and whether the Episode types - as well as the variety of Writers and Directors - positively or negatively impacted the amount of UK Viewers and/or the Appreciation Index.
Limitations: This analysis does not consider the following: the companion characters; episode themes; budgets; non-UK audiences; or the consumption habits of UK viewers (e.g. if they watch live or via iPlayer).
Data Preparation
Load Packages & Libraries
Load & Transform Data File
Show the code
dw <- read.csv("Data/DoctorWhoRevival.csv") |>
select(The_Doctor,
No_InSeries,
Series,
UK_viewers_millions,
Appreciation_Index,
Original_release_date,
Directed_by,
Written_by,
Showrunner,
StoryType) |>
mutate(Original_release_date = as.Date(Original_release_date, format = "%d/%m/%Y")) |>
mutate(Air_day = format(Original_release_date, format = "%A")) |>
mutate(EpisodeType = case_when(No_InSeries == "Special" ~ "Special",
TRUE ~ "Series")) |>
mutate(Era = case_when(Original_release_date >= "2005-03-26" & Original_release_date <= "2010-01-01" ~ "Russell T Davies (1)",
Original_release_date >= "2010-04-03" & Original_release_date <= "2017-12-25" ~ "Steven Moffat",
Original_release_date >= "2018-10-07" & Original_release_date <= "2022-10-23" ~ "Chris Chibnall",
TRUE ~ "Russell T Davies (2)")) |>
mutate(The_Doctor_Tenure = case_when(
Original_release_date >= "2005-03-26" & Original_release_date <= "2005-06-18" ~ "Ninth Doctor",
Original_release_date >= "2005-12-25" & Original_release_date <= "2010-01-01" ~ "Tenth Doctor",
Original_release_date >= "2010-04-03" & Original_release_date <= "2013-12-25" ~ "Eleventh Doctor",
Original_release_date >= "2014-08-23" & Original_release_date <= "2017-12-25" ~ "Twelfth Doctor",
Original_release_date >= "2018-10-07" & Original_release_date <= "2022-10-23" ~ "Thirteenth Doctor",
Original_release_date >= "2023-11-25" & Original_release_date <= "2023-12-09" ~ "Fourteenth Doctor",
TRUE~ "Fifteenth Doctor",
)) |>
mutate(WriterCat = case_when(grepl("*,", Written_by) ~ "Co-Written",
TRUE ~ "Solo Written")) |>
mutate(
ShowrunnerProp = case_when(
grepl("Russell T Davies, *", Written_by) ~ "Russell T Davies Co-Written",
grepl("*, Steven Moffat", Written_by) ~ "Steven Moffat Co-Written",
grepl("*, Chris Chibnall", Written_by) ~ "Chris Chibnall Co-Written",
Written_by == "Russell T Davies" ~ "Russell T Davies",
Written_by == "Steven Moffat" ~ "Steven Moffat",
Written_by == "Chris Chibnall" ~ "Chris Chibnall",
TRUE ~ "Non-Showrunner"))
# Reorder Series Number
dw$No_InSeries <- factor(dw$No_InSeries, levels = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, "Special"))
# Reorder Eras
dw$Era <- factor(dw$Era, levels = c("Russell T Davies (1)", "Steven Moffat", "Chris Chibnall", "Russell T Davies (2)"))
# Reorder The Doctor
dw$The_Doctor_Tenure <- factor(dw$The_Doctor_Tenure, levels = c("Ninth Doctor", "Tenth Doctor", "Eleventh Doctor", "Twelfth Doctor", "Thirteenth Doctor", "Fourteenth Doctor", "Fifteenth Doctor"))
# Reorder Series
dw$Series <- factor(dw$Series,
levels = c("One", "Two", "Three", "Four", "2008-2010 Specials", "Five", "Six", "Seven", "2013 Specials", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "2022 Specials", "2023 Specials", "Fourteen", "Fifteen"))
# Reorder Story Types
dw$StoryType <- factor(dw$StoryType, levels = c("Standalone", "Two-Parter", "Three-Parter", "Six-Parter"))
# Reorder ShowrunnerProp
dw$ShowrunnerProp <- factor(dw$ShowrunnerProp, levels = c("Russell T Davies", "Russell T Davies Co-Written", "Steven Moffat", "Steven Moffat Co-Written", "Chris Chibnall","Chris Chibnall Co-Written", "Non-Showrunner"))Each Doctor’s Tenure and Broadcast Dates
Show the code
Start_Date <- data.frame(dw |>
select(Era, The_Doctor_Tenure, Original_release_date) |>
group_by(Era, The_Doctor_Tenure) |>
slice(which.min(as.Date(Original_release_date))))
Start_Date <- Start_Date |>
rename_at("Original_release_date", ~"Start_Date")
End_Date <- data.frame(dw |>
select(Era, The_Doctor_Tenure, Original_release_date) |>
group_by(Era, The_Doctor_Tenure) |>
slice(which.max(as.Date(Original_release_date))))
End_Date <- End_Date |>
rename_at("Original_release_date", ~"End_Date")
SeriesOverview <- data.frame(dw |>
count(Era, The_Doctor_Tenure, name = "TenureLength") |>
group_by(Era))
(TenureDates <- cbind(SeriesOverview, Start_Date = Start_Date$Start_Date, End_Date = End_Date$End_Date)) Era The_Doctor_Tenure TenureLength Start_Date End_Date
1 Russell T Davies (1) Ninth Doctor 13 2005-03-26 2005-06-18
2 Russell T Davies (1) Tenth Doctor 47 2005-12-25 2010-01-01
3 Steven Moffat Eleventh Doctor 44 2010-04-03 2013-12-25
4 Steven Moffat Twelfth Doctor 40 2014-08-23 2017-12-25
5 Chris Chibnall Thirteenth Doctor 31 2018-10-07 2022-10-23
6 Russell T Davies (2) Fourteenth Doctor 3 2023-11-25 2023-12-09
7 Russell T Davies (2) Fifteenth Doctor 18 2023-12-25 2025-05-31Series lengths and Broadcast Dates
Show the code
Start_Date <- data.frame(dw |>
select(Era, Series, EpisodeType, Original_release_date) |>
group_by(Era, Series, EpisodeType) |>
slice(which.min(as.Date(Original_release_date))))
Start_Date <- Start_Date |>
rename_at("Original_release_date", ~"Start_Date")
End_Date <- data.frame(dw |>
select(Era, Series, EpisodeType, Original_release_date) |>
group_by(Era, Series, EpisodeType) |>
slice(which.max(as.Date(Original_release_date))))
End_Date <- End_Date |>
rename_at("Original_release_date", ~"End_Date")
SeriesOverview <- data.frame(dw |>
count(Era, Series, EpisodeType, name = "SeriesLength") |>
group_by(Era))
(SeriesDates <- cbind(SeriesOverview, Start_Date = Start_Date$Start_Date, End_Date = End_Date$End_Date)) Era Series EpisodeType SeriesLength Start_Date
1 Russell T Davies (1) One Series 13 2005-03-26
2 Russell T Davies (1) Two Series 13 2006-04-15
3 Russell T Davies (1) Two Special 1 2005-12-25
4 Russell T Davies (1) Three Series 13 2007-03-31
5 Russell T Davies (1) Three Special 1 2006-12-25
6 Russell T Davies (1) Four Series 13 2008-04-05
7 Russell T Davies (1) Four Special 1 2007-12-25
8 Russell T Davies (1) 2008-2010 Specials Special 5 2008-12-25
9 Steven Moffat Five Series 13 2010-04-03
10 Steven Moffat Six Series 13 2011-04-23
11 Steven Moffat Six Special 1 2010-12-25
12 Steven Moffat Seven Series 13 2012-09-01
13 Steven Moffat Seven Special 2 2011-12-25
14 Steven Moffat 2013 Specials Special 2 2013-11-23
15 Steven Moffat Eight Series 12 2014-08-23
16 Steven Moffat Nine Series 12 2015-09-19
17 Steven Moffat Nine Special 2 2014-12-25
18 Steven Moffat Ten Series 12 2017-04-15
19 Steven Moffat Ten Special 2 2016-12-25
20 Chris Chibnall Eleven Series 10 2018-10-07
21 Chris Chibnall Twelve Series 10 2020-01-01
22 Chris Chibnall Twelve Special 1 2019-01-01
23 Chris Chibnall Thirteen Series 6 2021-10-31
24 Chris Chibnall Thirteen Special 1 2021-01-01
25 Chris Chibnall 2022 Specials Special 3 2022-01-01
26 Russell T Davies (2) 2023 Specials Special 3 2023-11-25
27 Russell T Davies (2) Fourteen Series 8 2024-05-11
28 Russell T Davies (2) Fourteen Special 1 2023-12-25
29 Russell T Davies (2) Fifteen Series 8 2025-04-12
30 Russell T Davies (2) Fifteen Special 1 2024-12-25
End_Date
1 2005-06-18
2 2006-07-08
3 2005-12-25
4 2007-06-30
5 2006-12-25
6 2008-07-05
7 2007-12-25
8 2010-01-01
9 2010-06-26
10 2011-10-01
11 2010-12-25
12 2013-05-18
13 2012-12-25
14 2013-12-25
15 2014-11-08
16 2015-12-05
17 2015-12-25
18 2017-07-01
19 2017-12-25
20 2018-12-09
21 2020-03-01
22 2019-01-01
23 2021-12-05
24 2021-01-01
25 2022-10-23
26 2023-12-09
27 2024-06-22
28 2023-12-25
29 2025-05-31
30 2024-12-25Create new Data Frame, with Series Length Categorisation
Show the code
dw <- data.frame(dw |>
mutate(SeriesCat = case_when(Original_release_date >= "2005-03-26" & Original_release_date <= "2005-06-18" ~ "13 Episodes",
Original_release_date >= "2006-04-15" & Original_release_date <= "2006-07-08" ~ "13 Episodes",
Original_release_date >= "2007-03-31" & Original_release_date <= "2007-06-30" ~ "13 Episodes",
Original_release_date >= "2008-04-05" & Original_release_date <= "2008-07-05" ~ "13 Episodes",
Original_release_date >= "2010-04-03" & Original_release_date <= "2010-06-26" ~ "13 Episodes",
Original_release_date >= "2011-04-23" & Original_release_date <= "2011-10-01" ~ "13 Episodes",
Original_release_date >= "2012-09-01" & Original_release_date <= "2012-09-29" ~ "13 Episodes",
Original_release_date >= "2013-03-30" & Original_release_date <= "2013-05-18" ~ "13 Episodes",
Original_release_date >= "2014-08-23" & Original_release_date <= "2014-11-08" ~ "12 Episodes",
Original_release_date >= "2015-09-19" & Original_release_date <= "2015-12-05" ~ "12 Episodes",
Original_release_date >= "2017-04-15 " & Original_release_date <= "2017-07-01" ~ "12 Episodes",
Original_release_date >= "2018-10-07" & Original_release_date <= "2018-12-09" ~ "10 Episodes",
Original_release_date >= "2020-01-01" & Original_release_date <= "2020-03-01" ~ "10 Episodes",
Original_release_date >= "2021-10-31" & Original_release_date <= "2021-12-05" ~ "6-8 Episodes",
Original_release_date >= "2024-05-11" & Original_release_date <= "2024-06-22" ~ "6-8 Episodes",
Original_release_date >= "2025-04-12" & Original_release_date <= "2025-05-31" ~ "6-8 Episodes",
Original_release_date >= "2008-12-25" & Original_release_date <= "2010-01-01" ~ "Specials",
Original_release_date >= "2013-11-23 " & Original_release_date <= "2013-12-25" ~ "Specials",
Original_release_date >= "2022-01-01" & Original_release_date <= "2022-10-23" ~ "Specials",
Original_release_date >= "2023-11-25" & Original_release_date <= "2023-12-09" ~ "Specials",
TRUE ~ "Series Specials")
))
dw$SeriesCat <- factor(dw$SeriesCat, levels = c("13 Episodes", "12 Episodes", "10 Episodes", "6-8 Episodes", "Specials", "Series Specials"))Summary
Show the code
summary(dw) The_Doctor No_InSeries Series UK_viewers_millions
Length:196 Special:27 Seven : 15 Min. : 2.700
Class :character 1 :15 Two : 14 1st Qu.: 6.018
Mode :character 2 :15 Three : 14 Median : 7.135
3 :15 Four : 14 Mean : 7.064
4 :15 Six : 14 3rd Qu.: 8.020
5 :15 Nine : 14 Max. :13.310
(Other):94 (Other):111
Appreciation_Index Original_release_date Directed_by Written_by
Min. :75.00 Min. :2005-03-26 Length:196 Length:196
1st Qu.:82.00 1st Qu.:2008-05-27 Class :character Class :character
Median :84.00 Median :2013-04-23 Mode :character Mode :character
Mean :83.61 Mean :2013-12-10
3rd Qu.:86.00 3rd Qu.:2018-10-22
Max. :91.00 Max. :2025-05-31
NA's :8
Showrunner StoryType Air_day EpisodeType
Length:196 Standalone :135 Length:196 Length:196
Class :character Two-Parter : 52 Class :character Class :character
Mode :character Three-Parter: 3 Mode :character Mode :character
Six-Parter : 6
Era The_Doctor_Tenure WriterCat
Russell T Davies (1):60 Ninth Doctor :13 Length:196
Steven Moffat :84 Tenth Doctor :47 Class :character
Chris Chibnall :31 Eleventh Doctor :44 Mode :character
Russell T Davies (2):21 Twelfth Doctor :40
Thirteenth Doctor:31
Fourteenth Doctor: 3
Fifteenth Doctor :18
ShowrunnerProp SeriesCat
Russell T Davies :43 13 Episodes :91
Russell T Davies Co-Written: 3 12 Episodes :36
Steven Moffat :44 10 Episodes :20
Steven Moffat Co-Written : 6 6-8 Episodes :22
Chris Chibnall :23 Specials :13
Chris Chibnall Co-Written : 5 Series Specials:14
Non-Showrunner :72 Filter to Series and Special Episodes
Show the code
dwSer <- dw |> filter(EpisodeType == "Series")
dwSp <- dw |>
filter(EpisodeType == "Special") |>
mutate(No_InSeries = case_when(
Original_release_date == "2009-04-11" ~ "2",
Original_release_date == "2009-11-15" ~ "3",
Original_release_date == "2009-12-25" ~ "4",
Original_release_date == "2010-01-01" ~ "5",
Original_release_date == "2012-12-25" ~ "2",
Original_release_date == "2013-12-25" ~ "2",
Original_release_date == "2015-12-25" ~ "2",
Original_release_date == "2015-12-25" ~ "2",
Original_release_date == "2017-12-25" ~ "2",
Original_release_date == "2022-04-17" ~ "2",
Original_release_date == "2022-10-23" ~ "3",
Original_release_date == "2023-12-02" ~ "2",
Original_release_date == "2023-12-09" ~ "3",
TRUE ~ "1"))Palette and Themes
Palette
Show the code
dwPalette <- colorRampPalette(c("#FFE4B5","#F06060", "#F28963", "#00B9AE"))Themes
Main Theme
Show the code
dwThemeLeg <- function(){
theme(
legend.position = "bottom",
legend.background = element_rect(fill = "#003B6F"),
legend.text = element_text(colour = "#FFFFFF", size = 12),
legend.title = element_text(colour = "#FFFFFF", size = 12, hjust = .5),
legend.direction = "horizontal",
legend.box = "vertical",
guides(colour = guide_legend(nrow = 3, byrow = T)),
plot.subtitle = element_text(colour = "#FFFFFF", size = 14, hjust = 0.5, vjust = 0),
plot.title = element_text(size = 16, colour = "#FFFFFF", hjust = .5, vjust = 0.5),
plot.caption = element_text(colour = "#FFFFFF", size = 12, hjust = 0.5, vjust = .5),
axis.title.x = element_text(colour = "#FFFFFF"),
axis.title.y = element_text(colour = "#FFFFFF"),
axis.text = element_text(colour = "#FFFFFF", size = 12),
axis.text.x = element_text(hjust = 1),
axis.ticks = element_line(colour = "#708090"),
axis.line = element_line(colour = "#708090"),
panel.background = element_rect(fill = "#003B6F"),
panel.grid = element_line(colour = "#708090"),
plot.margin = margin(1,2,1,1),
strip.text = element_text(colour = "#FFFFFF", size = 10),
strip.background = element_rect(fill = "#003B6F", colour = "#EE8262", linewidth = 0.5, linetype = "solid"),
plot.background = element_rect(fill = "#003B6F"))
}Scatter Plot Theme
Show the code
Scatter <- function(xaes, yaes, hline = F) {
xaes <- enquo (xaes)
yaes <- enquo(yaes)
ggplot(dw, aes(!!xaes,!!yaes), na.rm = T) +
scale_size(range = c(.1, 10)) +
scale_colour_manual(values = dwPalette(19)) +
guides(colour = guide_legend(nrow = 4, byrow = T)) +
dwThemeLeg() +
labs(
x = "",
y = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}
ScatterSer <- function(xaes, yaes, hline = F) {
xaes <- enquo (xaes)
yaes <- enquo(yaes)
ggplot(dwSer, aes(!!xaes,!!yaes), na.rm = T) +
scale_size(range = c(.1, 10)) +
scale_colour_manual(values = dwPalette(16)) +
guides(colour = guide_legend(nrow = 4, byrow = T)) +
dwThemeLeg() +
labs(
x = "",
y = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}
ScatterSp <- function(xaes, yaes, hline = F) {
xaes <- enquo (xaes)
yaes <- enquo(yaes)
ggplot(dwSp, aes(!!xaes,!!yaes), na.rm = T) +
scale_size(range = c(.1, 10)) +
scale_colour_manual(values = dwPalette(15)) +
guides(colour = guide_legend(nrow = 4, byrow = T)) +
dwThemeLeg() +
theme(plot.margin = margin(6,0,0,0)) +
labs(
x = "",
y = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}Density-Histogram Plot Theme
Show the code
DensHist <- function(xaes) {
xaes <- enquo(xaes)
ggplot(dw, aes(!!xaes)) +
geom_histogram(aes(y = after_stat(density), fill = Series), linewidth = 1.5, alpha = 0.75, na.rm = T, binwidth = 1) +
stat_summary(
aes(xintercept = after_stat(x), y = 0),
fun = mean, geom = "vline", orientation = "y",
colour = "#FFFFFF", linetype = "dashed", linewidth = 1.5, alpha = 0.5, na.rm = T) +
stat_summary(
aes(xintercept = after_stat(x), y = 0),
fun = quantile, geom = "vline", orientation = "y",
colour = "#76EEC6", linetype = "dashed", linewidth = 1.5, alpha = 0.5, na.rm = T) +
scale_fill_manual(values = dwPalette(19)) +
dwThemeLeg() +
labs(x = "",
fill = "Series:",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}Column Chart
Show the code
WDSLST <- as.data.frame(dw |>
group_by(The_Doctor_Tenure, Series, SeriesCat) |>
summarise(
No_of_Directors = n_distinct(Directed_by),
No_of_Writers = n_distinct(Written_by),
WriterType = n_distinct(WriterCat),
No_of_Episodes = n_distinct(StoryType),
.groups = "keep"))
Column <- function(xaes, yaes) {
xaes <- enquo (xaes)
yaes <- enquo (yaes)
ggplot(WDSLST, aes(!!xaes, !!yaes, fill = The_Doctor_Tenure)) +
geom_col(alpha = 0.85, na.rm = T, position = position_stack(reverse = T)) +
scale_y_discrete(limits=rev) +
scale_fill_manual(values = dwPalette(7)) +
dwThemeLeg() +
labs(
x = "",
y = "",
fill = "The Doctor:",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}Bar Chart
Show the code
AvgAITtlV <- as.data.frame(dw |>
group_by(SeriesCat, Era, Series, The_Doctor_Tenure) |>
summarise(
TotalViews = sum(UK_viewers_millions),
Med_Views = round(median(UK_viewers_millions), 2),
Med_AI = round(median(Appreciation_Index, na.rm = T), 0),
.groups = "keep"))
Bar <- function(xaes, yaes) {
xaes <- enquo (xaes)
yaes <- enquo (yaes)
ggplot(AvgAITtlV, aes(!!xaes, !!yaes, fill = The_Doctor_Tenure)) +
geom_col(alpha = 0.85, na.rm = T, position = position_stack(reverse = T)) +
scale_fill_manual(values = dwPalette(19)) +
scale_y_discrete(limits=rev) +
dwThemeLeg() +
labs(
x = "",
y = "",
fill = "The Doctor:",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)")
}Data Visualisation
Show Overview
Number of Series and Special Episodes
Show the code
(SeriesOverviewVis <- ggplot(SeriesOverview, aes(SeriesLength, Series, fill = EpisodeType)) +
geom_col(alpha = 0.85, na.rm = T, position = position_stack(reverse = T)) +
geom_text(aes(label = SeriesLength), colour = "#151F30", size = 4, position = position_stack(vjust = 0.5, reverse = T), fontface = "bold") +
facet_wrap(~Era, scales = "free_y") +
scale_fill_manual(values = c("#F28963", "#00B9AE")) +
dwThemeLeg() +
scale_y_discrete(limits=rev) +
labs(
title = "Doctor Who: The Revival Era ~ Count of Series and Special Episodes",
x = "",
y = "",
fill = "Episode Type:",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"))
Appreciation Index
Distribution of Appreciation Index
Show the code
(dwSerAIfacet <- DensHist(Appreciation_Index) +
geom_density(colour = "#FFFFFF", linewidth = 1.5, alpha = 0.5, na.rm = T) +
facet_wrap(~SeriesCat) +
labs(
title = "Doctor Who: The Revival Era ~ Distribution of Appreciation Index",
subtitle = "Note: Series Fifteen's episodes do not have any Appreciation Indexes"))
UK Viewers (millions)
Total UK Viewers (millions)
Show the code
(TtlV <- Bar(TotalViews, Series) +
geom_text(aes(label = TotalViews), colour = "#003B6F", size = 4, position = position_stack(vjust = 0.5, reverse = T), fontface = "bold", na.rm = T) +
facet_wrap(~SeriesCat, scales = "free") +
labs(title = "Doctor Who: The Revival Era ~ Total UK Viewers (millions)",
x = "",
y = ""))
Distribution of UK Viewers (millions)
Show the code
(dwSerViewsfacet <- DensHist(UK_viewers_millions) +
geom_density(colour = "#FFFFFF", linewidth = 1.5, alpha = 0.75, na.rm = T) +
facet_wrap(~SeriesCat) +
labs(title = "Doctor Who: The Revival Era ~ Distribution of UK Viewers (millions)"))
Appreciation Index vs UK Viewers (millions)
Show the code
(AIViewsNo <- Scatter(UK_viewers_millions, Appreciation_Index) +
geom_point(aes(colour = Series), size = 5, shape = 15, alpha = 0.5, na.rm = T) +
geom_smooth(na.rm = T, colour = "#FFFFFF", method = "lm", formula = y ~ x) +
stat_cor(method = "spearman", label.y.npc = "top", na.rm = T, aes(label = after_stat(r.label)), colour = "#FFFFFF") +
facet_wrap(~SeriesCat) +
labs(title = "Doctor Who: The Revival Era ~ Ratings vs Views",
subtitle = "Note: Series Fifteen's episodes do not have any Appreciation Indexes",
x = "UK Viewers (millions)",
y = "Appreciation Index",
colour = "Series:"))
Observations:
- Despite the Appreciation Index being relatively stable for each series length, with each reduction in series length, the average Appreciation Index decreases (e.g. 86 for 13 episodes, compared to 78 for those with 6-8 episodes), indicating that audiences are more likely to view a longer series, with a greater variety of writers, more favourably.
- This is also reflected by the Median UK Viewers for each series length, with 13 Episodes per Series being 7.63 million, which is over double that of a series that has 8 Episodes (3.64) million.
- Furthermore, with each reduction in series length, the correlation between Appreciation Index and UK Viewers becomes stronger. Additionally, the ranges for each also become lower, highlighting the benefit of longer series for both views and ratings.
Episode
Views & Ratings by Story Type
Show the code
(EpType <- Scatter(UK_viewers_millions, StoryType) +
geom_jitter(aes(colour = Series), size = 5, alpha = 0.35, shape = 15, na.rm = T) +
geom_point(aes(colour = Series), shape = 15) +
stat_boxplot(geom = "errorbar", colour = "#FFFFFF", linewidth = 2, alpha = 0.35, na.rm = T) +
geom_violin(draw_quantiles = c(0.25,0.5,0.75), colour = "#FFFFFF", alpha = 0.25, linewidth = 1, na.rm = T) +
facet_wrap(~SeriesCat, scales = "free") +
scale_y_discrete(limits=rev) +
labs(title = "Doctor Who: The Revival Era ~ Spread of Views by Story Type",
subtitle = "Note: Series Fifteen's episodes do not have any Appreciation Indexes",
colour = "Series:",
x = "UK Viewers (millions)")
)
Types of Story
Series
Show the code
(SerEpStryTyp <- ggplot(dwSer, aes(No_InSeries, Series), na.rm = T) +
geom_point(aes(colour = StoryType), size = 6, shape = 15, na.rm = T) +
facet_wrap(~SeriesCat, scales = "free") +
scale_colour_manual(values = dwPalette(4)) +
scale_y_discrete(limits=rev) +
dwThemeLeg() +
labs(
title = "Doctor Who: The Revival Era ~ Story Type for Series Episodes",
colour = "Story Type:",
x = "",
y = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"))
Special Episodes
Show the code
(SpEpStryTyp <- ggplot(dwSp, aes(No_InSeries, Series), na.rm = T) +
geom_point(aes(colour = StoryType), size = 6, shape = 15, na.rm = T) +
facet_wrap(~SeriesCat, scales = "free") +
scale_colour_manual(values = dwPalette(2)) +
scale_y_discrete(limits=rev) +
dwThemeLeg() +
labs(
title = "Doctor Who: The Revival Era ~ Story Types for Special Episodes",
colour = "Story Type:",
x = "",
y = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"))
Views & Appreciation Index for each Episode
Series
Show the code
(AIViewsEpSer <- ScatterSer(No_InSeries, UK_viewers_millions) +
geom_point(aes(colour = as.factor(Appreciation_Index)), size = 6, shape = 15, na.rm = T) +
geom_segment(aes(x = No_InSeries, xend = No_InSeries, y = 0, yend = UK_viewers_millions, colour = as.factor(Appreciation_Index))) +
guides(colour = guide_legend(nrow = 2, byrow=T)) +
facet_wrap(~Series, scales = "free_x") +
labs(title = "UK Viewers and Appreciation Index for each Episode in a Series",
subtitle = "Note: Series Fifteen's episodes do not have any Appreciation Indexes",
colour = "Appreciation Index:",
x = "",
size = "UK Viewers (millions):",
y = ""))
Special Episodes
Show the code
(AIViewsEpSp <- ScatterSp(No_InSeries, UK_viewers_millions) +
geom_point(aes(colour = as.factor(Appreciation_Index)), size = 4, shape = 15, na.rm = T) +
geom_segment(aes(x = No_InSeries, xend = No_InSeries, y = 0, yend = UK_viewers_millions, colour = as.factor(Appreciation_Index))) +
facet_wrap(~Series, scales = "free_x") +
guides(colour = guide_legend(nrow = 2, byrow = T)) +
labs(title = "UK Viewers and Appreciation Index for each Special Episode",
colour = "Appreciation Index:",
x = "",
y = ""))
Observations:
- Series One to Five benefited from essentially the same episode story types, broadcast pattern, and a 13-episode series length. This allowed for viewer habits and expectations to develop, until both views and ratings peaked with Series Four.
- Thereafter, starting with Series Six, changes to the story type pattern started to cause a negative trend for both views and ratings. Interestingly, once the series length began to decrease, the highest Appreciation Index achieved for 12 Episodes was 85 - which decreased to 83 for 10 episodes, and 80, when the series length had 6-8 episodes. Conversely, for 13 episodes, the Appreciation Index reached 91.
- For Special Episodes, there was a similar pattern: when the regular series length was 13 episodes, the Appreciation Index reached a maximum of 89 - which decreased to 82 for 12 episodes, and 80 for 10 episodes. The 2023 Specials, on the other hand, bucked the trend, by reaching a high of 85, and having views that were of similar levels to those of a special for a series with 12 episodes.
Director
Count of Directors
Show the code
(Directors <- n_distinct(dw$Directed_by))[1] 66Show the code
(DirCount <- Column(No_of_Directors, Series) +
geom_text(aes(label = No_of_Directors), colour = "#151F30", size = 4, position = position_stack(vjust = 0.5, reverse = T), fontface = "bold") +
facet_wrap(~SeriesCat, scales = "free_y") +
theme(axis.text.x=element_blank()) +
labs(
title = "Doctor Who: The Revival Era ~ Count of Directors by each Series"
))
Views & Ratings by Director
Show the code
(AIVerDir <- Scatter(UK_viewers_millions, Directed_by) +
geom_point(aes(colour = Series), shape = 15, na.rm = T) +
geom_jitter(aes(colour = Series, size = Appreciation_Index), alpha = 0.35, width = 0.05, shape = 15, na.rm = T) +
facet_wrap(~SeriesCat, scales = "free_y") +
guides(colour = guide_legend(nrow = 3, byrow=T)) +
labs(title = "Doctor Who: The Revival Era ~ Views & Ratings by Director",
subtitle = "Note: Series Fifteen does not have any Appreciation Indexes",
size = "Appreciation Index",
x = "UK Viewers (millions):",
colour = "Series:"))
Observations:
- With regards to the Directors, any correlation between the decline in views and ratings are hard to determine, due to to only 5 (Hettie MacDonald, Douglas Mackinnon, Peter Hoar, Charles Palmer, and Jamie Magnus Stone) of the 66 directors directing episodes from differing series lengths.
Writer
Count of Writers
Show the code
(Writers <- dw |>
group_by(Era, The_Doctor_Tenure, Series, EpisodeType) |>
count(WriterCat, name = "Count"))# A tibble: 40 × 6
# Groups: Era, The_Doctor_Tenure, Series, EpisodeType [30]
Era The_Doctor_Tenure Series EpisodeType WriterCat Count
<fct> <fct> <fct> <chr> <chr> <int>
1 Russell T Davies (1) Ninth Doctor One Series Solo Wri… 13
2 Russell T Davies (1) Tenth Doctor Two Series Solo Wri… 13
3 Russell T Davies (1) Tenth Doctor Two Special Solo Wri… 1
4 Russell T Davies (1) Tenth Doctor Three Series Solo Wri… 13
5 Russell T Davies (1) Tenth Doctor Three Special Solo Wri… 1
6 Russell T Davies (1) Tenth Doctor Four Series Solo Wri… 13
7 Russell T Davies (1) Tenth Doctor Four Special Solo Wri… 1
8 Russell T Davies (1) Tenth Doctor 2008-2010… Special Co-Writt… 2
9 Russell T Davies (1) Tenth Doctor 2008-2010… Special Solo Wri… 3
10 Steven Moffat Eleventh Doctor Five Series Solo Wri… 13
# ℹ 30 more rowsShow the code
(Writ <- Column(No_of_Writers, Series) +
facet_wrap(~SeriesCat, scales = "free_y") +
geom_text(aes(label = No_of_Writers), colour = "#151F30", size = 4, position = position_stack(vjust = 0.5, reverse = T), fontface = "bold") +
theme(axis.text.x = element_blank()) +
labs(
title = "Doctor Who: The Revival Era ~ Count of Writers by each Showrunner",
subtitle = "Note: Does not differentiate between Writers & Co-Writers"
))
Views & Ratings by Writer
Show the code
(WritAiV <- Scatter(UK_viewers_millions, Written_by) +
geom_point(aes(colour = Series), shape = 15, na.rm = T) +
geom_jitter(aes(colour = Series, size = Appreciation_Index), alpha = 0.35, width = 0.05, shape = 15, na.rm = T) +
facet_wrap(~SeriesCat, scales = "free_y") +
labs(title = "Doctor Who: The Revival Era ~ Views & Ratings by Writer",
subtitle = "Note: Series Fifteen's episodes do not have any Appreciation Indexes, except for the Series Special",
size = "Appreciation Index:",
x = "UK Viewers (millions)",
colour = "Series:"))
Proportion of Showrunner (co-)written Series
Show the code
# Labels
Writprcnt <- dw |> group_by(Series, SeriesCat) |> count(ShowrunnerProp) |>
mutate(ratio=scales::percent(n/sum(n)))
(srprop <- ggplot(dw, aes(Series, fill = ShowrunnerProp)) +
geom_bar(position = "fill", alpha = .75, linewidth = 1, na.rm = T) +
geom_text(data = Writprcnt, aes(y = n,label = ratio),
position = position_fill(vjust = 0.5), colour = "#151F30") +
dwThemeLeg() +
scale_fill_manual(values = dwPalette(7)) +
scale_x_discrete(labels = function(x) str_wrap(x, width = 10), limits = rev) +
facet_wrap(~SeriesCat, scales = "free_y") +
theme(axis.text.x = element_blank()) +
coord_flip() +
labs(
title = "Doctor Who: The Revival Era ~ Proportion where a Showrunner wrote for Series",
y = "",
x = "",
fill = "Writer:",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"
))
Showrunner (Co-)Written Episodes per Series
Show the code
(BroadcastSRWrit <- ggplot(dwSer, aes(Original_release_date, UK_viewers_millions), na.rm = T) +
geom_line(na.rm = T, aes(colour = ShowrunnerProp, group = Series)) +
geom_point(aes(colour = ShowrunnerProp), size = 4, shape = 15, na.rm = T, alpha = 0.75) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_x_date(date_breaks = "2 month", date_labels = "%m/%Y") +
facet_wrap(~Series, scales = "free_x", ncol = 5) +
scale_colour_manual(values = dwPalette(7)) +
dwThemeLeg() +
labs(title = "Doctor Who: The Revival Era ~ Timeline of Showrunner-written Episodes for each Series",
y = "UK Viewers (millions)",
colour = "(Co-)Writer:",
x = "",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"))
Show the code
(SpEp <- ScatterSp(Original_release_date, UK_viewers_millions) +
geom_line(aes(colour = ShowrunnerProp, group = EpisodeType), linewidth = 1) +
geom_point(aes(colour = ShowrunnerProp), shape = 15) +
geom_jitter(aes(colour = ShowrunnerProp), size = 5, alpha = 0.5, shape = 15, width = 0.15) +
facet_wrap(~SeriesCat, scales = "free_x") +
scale_x_date(date_breaks = "2 year", date_labels = "%Y") +
labs(
title = "Doctor Who: The Revival Era ~ Timeline of Showrunner-written Special Episodes",
x = "",
colour = "Series:",
y = "UK Viewers (millions)",
caption = "Source: https://en.wikipedia.org/wiki/List_of_Doctor_Who_episodes_(2005–present)"))
Observations:
- Disruptions (e.g. the 2008-10 Specials occurring between the finale for Series Four and the start of Series Five, or midway series breaks during Series Six and Seven), as well as changes (e.g. reduced series length, and varied broadcasting date starts), to the series pattern all contributed to the decline in both views and ratings - hence why views skew negatively, with each reduction in series length.
- The only that pattern that remained across each series, regardless of Showrunner, was that the Showrunner will write the first and last episode in a series/block of episodes in a series. However, with reduced number of episodes per series, the number of Showrunner written episodes dwarves the number of non-showrunner written episodes.
- For example, with Series One, Russell T Davies wrote 8 of the 13 episodes (61.5%), dropping to 5 of the 13 episodes (38-38.5%) for the rest of his initial tenure (Series Two to Four). However, when he returned as Showrunner, for Series Fourteen, he wrote 5 of the 8 (75%) episodes, meaning that only 12% (1 episode) of the series was not written by either the current or a past Showrunner. Interestingly, Series Fifteen had an inverse to Series Two to Four, where 38% (3 of the 8 episodes) of the series was not written or co-written by the Showrunner. The consequence of this indicates the reduced ability to develop talent to showrun a new era after Russell T Davies leaves, as well as the show overly relying on the showrunner for writing.
- Lastly, the return of previous showrunners to write for the show negatively impacted both the Appreciation Index and UK Viewers. However, whether this is due to certain factors, such as writing styles being outdated or a reduced series length negatively impacting the writing process, is beyond the scope of this analysis.
- The Special Episodes followed a similar pattern to series with particular lengths; for instance, the views for the Series Fifteen special episode resulted in 5.91 million UK viewers, which was 60.1% of the views for the special episode in Series Two (9.84 million). This reinforces the notion that a longer series has a positive knock-on effect for any special episode, and that this declines with each reduction in series length.
- In terms of Appreciation Index, however, the median Appreciation Index for a Series Special episode either performed at a similar level or better than the regular series episodes. For the Specials, however, the median Appreciation Index remained at a similar level to their corresponding Doctor’s series medians. This indicates the importance of the writing for each incarnation of The Doctor, as a character that resonates well with its audience will perform better than one that does not.
Conclusion
Variety is the spice of life, but for a show like “Doctor Who” to thrive, it needs to develop a framework that compliments the restrictions of a reduced series length, rather than attempt to replicate the format of a series with 13 episodes. Moreover, for the show to flourish, it needs time for viewer habits to develop to changes in format, but it also needs an increased variety of writers - partly so that the Showrunner can focus on managing the show, but also to develop talent that benefits the future.