Before each vote, the Speaker of the House yells “Division! Clear the Lobby”. I’d like to find which cluster of MPs (Members of Parliament) may be exiting the lobby and going their own way.
Hansard reports what’s said in the UK Parliament, sets out details of divisions, and records decisions taken during a sitting. The R package hansard package (Odell 2017) provides access to the data.
library(conflicted)
library(tidyverse)
conflict_prefer_all("dplyr")
library(clock)
library(wesanderson)
library(hansard)
library(dendextend)
library(corrplot)
library(broom)
library(factoextra)
library(glue)
library(ggrepel)
library(usedthese)
conflict_scout()2 conflicts:
* `filter`: [dplyr]
* `lag` : [dplyr]theme_set(theme_bw())
(cols <- wes_palette(name = "Moonrise2"))
I’ll start by building a list of all Labour Party MPs.
url_prefix <- "http://data.parliament.uk/members/"
mps <- commons_members() |>
filter(party_value == "Labour" | about == str_c(url_prefix, "478")) |>
mutate(ID = str_replace(about, url_prefix, ""))
saveRDS(mps, file = "mps.rds")Creating a function will enable me to iterate through the MP list to extract their voting records.
start_date <- "2017-06-08"
end_date <- "2018-01-28"
pull_votes <- \(x) {
mp_vote_record(x,
start_date = start_date,
end_date = end_date,
verbose = FALSE
) |>
mutate(mp = x)
}I’ll use it to extract the “aye” and “no” votes. Use of possibly prevents the code from stopping when it encounters former MPs for whom no data is returned.
Voting the opposite way to the majority of the party, as well as non-votes, will both be of interest when assessing which MPs are “most distant” from the wider party.
votes_df <- votes |>
left_join(mps, by = join_by(mp == ID)) |>
select(about = about.x, title, date_value,
lobby, mp, name = full_name_value) |>
transmute(
vote = if_else(lobby == "aye", 1, -1),
mp = str_c(name, " (", mp, ")"),
about = str_replace(about, "http://data.parliament.uk/resources/", ""),
title = str_c(title, " (", about, ")")
) |>
select(-about) |>
pivot_wider(names_from = title, values_from = vote, values_fill = 0)The data are standardised (i.e. scaled) to ensure comparability. This is verified by ensuring the mean and standard deviation are close to zero and one respectively.
scaled_df <-
votes_df |>
mutate(across(-mp, scale))
scaled_df |>
summarise(
across(-mp, list(mean = mean, sd = sd)),
sd_min = min(c_across(ends_with("_sd"))),
sd_max = max(c_across(ends_with("_sd"))),
mean_min = min(c_across(ends_with("_mean"))),
mean_max = max(c_across(ends_with("_mean")))
)| Nuclear Safeguards Bill: Report Stage New Clause 1 (828384)_mean | Nuclear Safeguards Bill: Report Stage New Clause 1 (828384)_sd | Nuclear Safeguards Bill: Report Stage Amdt 5 (828386)_mean | Nuclear Safeguards Bill: Report Stage Amdt 5 (828386)_sd | European Union (Withdrawal) Bill: Report Stage New Clause 1 (824363)_mean | European Union (Withdrawal) Bill: Report Stage New Clause 1 (824363)_sd | European Union Withdrawal Bill: Report Stage New Clause 6 (824364)_mean | European Union Withdrawal Bill: Report Stage New Clause 6 (824364)_sd | European Union (Withdrawal) Bill: Report Stage: New Clause 11 (824365)_mean | European Union (Withdrawal) Bill: Report Stage: New Clause 11 (824365)_sd | European Union (Withdrawal) Bill: Report Stage: New Clause 12 (824368)_mean | European Union (Withdrawal) Bill: Report Stage: New Clause 12 (824368)_sd | European Union (Withdrawal) Bill: Report Stage: New Clause 17 (824369)_mean | European Union (Withdrawal) Bill: Report Stage: New Clause 17 (824369)_sd | European Union (Withdrawal) Bill: Report Stage: Amendment 2 (824372)_mean | European Union (Withdrawal) Bill: Report Stage: Amendment 2 (824372)_sd | European Union (Withdrawal) Bill: Report Stage: Amdt 1 (824373)_mean | European Union (Withdrawal) Bill: Report Stage: Amdt 1 (824373)_sd | European Union (Withdrawal) Bill: Third Reading: Mr Blackford’s amendment (824378)_mean | European Union (Withdrawal) Bill: Third Reading: Mr Blackford’s amendment (824378)_sd | European Union (Withdrawal) Bill: Report Stage: Amendment 57 (823320)_mean | European Union (Withdrawal) Bill: Report Stage: Amendment 57 (823320)_sd | European Union (Withdrawal) Bill: Report Stage: New Clause 7 (823321)_mean | European Union (Withdrawal) Bill: Report Stage: New Clause 7 (823321)_sd | European Union (Withdrawal) Bill: Report Stage: Amdt 4 (823322)_mean | European Union (Withdrawal) Bill: Report Stage: Amdt 4 (823322)_sd | EU (Withdrawal) Bill: Report Stage Amdt 3 (823332)_mean | EU (Withdrawal) Bill: Report Stage Amdt 3 (823332)_sd | Trade Bill: Second Reading: Mr Corbyn’s amendment (818946)_mean | Trade Bill: Second Reading: Mr Corbyn’s amendment (818946)_sd | Taxation (Cross-Border Trade) Bill Second Reading: Jeremy Corbyn’s amendment (818647)_mean | Taxation (Cross-Border Trade) Bill Second Reading: Jeremy Corbyn’s amendment (818647)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 349 (809990)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 349 (809990)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 54 (810045)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 54 (810045)_sd | Finance (No 2) Bill: Committee of the whole House: New Clause 6 (809139)_mean | Finance (No 2) Bill: Committee of the whole House: New Clause 6 (809139)_sd | Finance (No 2) Bill Committee of the whole House New Clause 8 (809145)_mean | Finance (No 2) Bill Committee of the whole House New Clause 8 (809145)_sd | Finance (No. 2) Bill: Committee of the whole House New Clause 1 (808733)_mean | Finance (No. 2) Bill: Committee of the whole House New Clause 1 (808733)_sd | Finance (No. 2) Bill: Committee of the whole House New Clause 4 (808776)_mean | Finance (No. 2) Bill: Committee of the whole House New Clause 4 (808776)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 7 (805525)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 7 (805525)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 30 (805526)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 30 (805526)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 241 (805550)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 241 (805550)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 1 (805551)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 1 (805551)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 22 (806101)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 22 (806101)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 26 (806103)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 26 (806103)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 63 (805092)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 63 (805092)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amendment 49 (805093)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amendment 49 (805093)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amendment 25 (805096)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amendment 25 (805096)_sd | Finance (No.2) Bill Second Reading: Jeremy Corbyn’s amendment (804247)_mean | Finance (No.2) Bill Second Reading: Jeremy Corbyn’s amendment (804247)_sd | European Union (Withdrawal) Bill Committee of the whole House Amendment 167 (801697)_mean | European Union (Withdrawal) Bill Committee of the whole House Amendment 167 (801697)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 17 (801727)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 17 (801727)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 80 (801729)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 80 (801729)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 339 (801730)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 339 (801730)_sd | European Union (Withdrawal) Bill Committee of the whole House New Clause 64 (800480)_mean | European Union (Withdrawal) Bill Committee of the whole House New Clause 64 (800480)_sd | European Union (Withdrawal) Bill Committee of the whole House Amendment 42 (800481)_mean | European Union (Withdrawal) Bill Committee of the whole House Amendment 42 (800481)_sd | European Union (Withdrawal) Bill Committee of the whole House Amendment 72 (800482)_mean | European Union (Withdrawal) Bill Committee of the whole House Amendment 72 (800482)_sd | Closure Motion: Parliamentary Constituencies (Amendment Bill) (798552)_mean | Closure Motion: Parliamentary Constituencies (Amendment Bill) (798552)_sd | Opposition Motion: Women affected by state pension age increases (796706)_mean | Opposition Motion: Women affected by state pension age increases (796706)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 79 (792888)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 79 (792888)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 46 (792889)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 46 (792889)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 336 (792890)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 336 (792890)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 139 (792945)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 139 (792945)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 25 (789396)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 25 (789396)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 58 (789397)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 58 (789397)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 30 (789922)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 30 (789922)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 67 (789923)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 67 (789923)_sd | EU (Withdrawal) Bill: Committee of the whole House New Clause 14 (788941)_mean | EU (Withdrawal) Bill: Committee of the whole House New Clause 14 (788941)_sd | EU (Withdrawal) Bill: Committee of the whole House Amdt 137 (788942)_mean | EU (Withdrawal) Bill: Committee of the whole House Amdt 137 (788942)_sd | EU (Withdrawal) Bill: Committee of the whole House Amdt 278 (788943)_mean | EU (Withdrawal) Bill: Committee of the whole House Amdt 278 (788943)_sd | Finance Bill: Report Stage New Clause 1 (780710)_mean | Finance Bill: Report Stage New Clause 1 (780710)_sd | Finance Bill: Report Stage Amdt 1 (780713)_mean | Finance Bill: Report Stage Amdt 1 (780713)_sd | Finance Bill: Report Stage Amdt 11 (780714)_mean | Finance Bill: Report Stage Amdt 11 (780714)_sd | Finance Bill: Report New Clause 2 (780715)_mean | Finance Bill: Report New Clause 2 (780715)_sd | Opposition Motion: Pause of Universal Credit full service roll-out (772511)_mean | Opposition Motion: Pause of Universal Credit full service roll-out (772511)_sd | Finance Bill: Committee of the whole House Amdt 1 (768283)_mean | Finance Bill: Committee of the whole House Amdt 1 (768283)_sd | Finance Bill: Committee of the whole House Amdt 2 (768285)_mean | Finance Bill: Committee of the whole House Amdt 2 (768285)_sd | Finance Bill: Committee of the whole House Amdt 4 (768286)_mean | Finance Bill: Committee of the whole House Amdt 4 (768286)_sd | Finance Bill: Committee of the whole House New Clause 1 (768287)_mean | Finance Bill: Committee of the whole House New Clause 1 (768287)_sd | Finance Bill: Committee of the whole House New Clause 2 (768324)_mean | Finance Bill: Committee of the whole House New Clause 2 (768324)_sd | Nomination of Members to Committees: Mr Carmichael’s amendment (759599)_mean | Nomination of Members to Committees: Mr Carmichael’s amendment (759599)_sd | EU (Withdrawal) Bill Second Reading: Mr Corbyn’s amendment (759160)_mean | EU (Withdrawal) Bill Second Reading: Mr Corbyn’s amendment (759160)_sd | Business of the House (Private Members’ Bills): Amendment (a) (752310)_mean | Business of the House (Private Members’ Bills): Amendment (a) (752310)_sd | Business of the House (Private Members’ Bills): Amendment (b) (752311)_mean | Business of the House (Private Members’ Bills): Amendment (b) (752311)_sd | Air Travel Organisers’ Licensing Bill: Committee of the whole House Amdt 2 (750424)_mean | Air Travel Organisers’ Licensing Bill: Committee of the whole House Amdt 2 (750424)_sd | Air Travel Organisers’ Bill: Committee of the whole House Amdt 3 (750425)_mean | Air Travel Organisers’ Bill: Committee of the whole House Amdt 3 (750425)_sd | Air Travel Organisers’ Licensing Bill: Committee of the whole House New Clause 1 (750435)_mean | Air Travel Organisers’ Licensing Bill: Committee of the whole House New Clause 1 (750435)_sd | Queen’s Speech: Economy and Jobs Amdt (l) (746517)_mean | Queen’s Speech: Economy and Jobs Amdt (l) (746517)_sd | Queen’s Speech: Health, Social Care and Security Amendment (i) (746031)_mean | Queen’s Speech: Health, Social Care and Security Amendment (i) (746031)_sd | European Union (Withdrawal) Bill: Third Reading (824379)_mean | European Union (Withdrawal) Bill: Third Reading (824379)_sd | European (Withdrawal) Bill: Report Stage Amdts 21-29 (823331)_mean | European (Withdrawal) Bill: Report Stage Amdts 21-29 (823331)_sd | Trade Bill: Second Reading (818948)_mean | Trade Bill: Second Reading (818948)_sd | Taxation (Cross-Border Trade): Second Reading (818649)_mean | Taxation (Cross-Border Trade): Second Reading (818649)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdts 381 and 399 (809989)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdts 381 and 399 (809989)_sd | Finance (No. 2) Bill: Committee of the whole House Schedule 9 (808574)_mean | Finance (No. 2) Bill: Committee of the whole House Schedule 9 (808574)_sd | Finance (No 2) Bill: Second Reading (804248)_mean | Finance (No 2) Bill: Second Reading (804248)_sd | European Union (Withdrawal) Bill Committee of the whole House Clause 11 and Schedule 3 stand part (800483)_mean | European Union (Withdrawal) Bill Committee of the whole House Clause 11 and Schedule 3 stand part (800483)_sd | Budget resolutions motion 28: Bank levy (795657)_mean | Budget resolutions motion 28: Bank levy (795657)_sd | European Union (Withdrawal) Bill: Committee of the whole House Schedule 1 (792946)_mean | European Union (Withdrawal) Bill: Committee of the whole House Schedule 1 (792946)_sd | Motion to sit in private (783133)_mean | Motion to sit in private (783133)_sd | Finance Bill: Third Reading (780719)_mean | Finance Bill: Third Reading (780719)_sd | Smart Meters Bill (Programme) (776386)_mean | Smart Meters Bill (Programme) (776386)_sd | Automated and Electric Vehicles Bill (Programme motion) (776007)_mean | Automated and Electric Vehicles Bill (Programme motion) (776007)_sd | Finance Bill: Second Reading (759531)_mean | Finance Bill: Second Reading (759531)_sd | Nomination of Members to Committees (759600)_mean | Nomination of Members to Committees (759600)_sd | EU (Withdrawal) Bill: Second Reading (759161)_mean | EU (Withdrawal) Bill: Second Reading (759161)_sd | EU (Withdrawal) Bill: Programme Motion (759162)_mean | EU (Withdrawal) Bill: Programme Motion (759162)_sd | Ways and Means motion 13: Business investment relief (757972)_mean | Ways and Means motion 13: Business investment relief (757972)_sd | Ways and Means Motion 4: Termination payments etc. (757973)_mean | Ways and Means Motion 4: Termination payments etc. (757973)_sd | Ways and Means motion 22: Trading profits taxable at the Northern Ireland rate (757974)_mean | Ways and Means motion 22: Trading profits taxable at the Northern Ireland rate (757974)_sd | Queen’s Speech: Main Question (746519)_mean | Queen’s Speech: Main Question (746519)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 44 (810044)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 44 (810044)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amendment 158 (805095)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amendment 158 (805095)_sd | Electoral Commission (828389)_mean | Electoral Commission (828389)_sd | European Union (Withdrawal) Bill: Report Stage: Amdt 59 (824370)_mean | European Union (Withdrawal) Bill: Report Stage: Amdt 59 (824370)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amendment 124 (805094)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amendment 124 (805094)_sd | Cross-Border Trade Resolution: Amendment (e) (792581)_mean | Cross-Border Trade Resolution: Amendment (e) (792581)_sd | Draft Local Authorities (Mayoral Elections) (England and Wales) (Amendment) Regulations 2017 (809953)_mean | Draft Local Authorities (Mayoral Elections) (England and Wales) (Amendment) Regulations 2017 (809953)_sd | Draft Combined Authorities (Mayoral Elections) (Amendment) Order 2017 (809954)_mean | Draft Combined Authorities (Mayoral Elections) (Amendment) Order 2017 (809954)_sd | European Union (Withdrawal) Bill: Committee of the whole House New Clause 13 (809988)_mean | European Union (Withdrawal) Bill: Committee of the whole House New Clause 13 (809988)_sd | Queen’s Speech: Economy and Jobs Amdt (g) (746518)_mean | Queen’s Speech: Economy and Jobs Amdt (g) (746518)_sd | EU (Withdrawal) Bill: Committee of the whole House Clause 1 (788773)_mean | EU (Withdrawal) Bill: Committee of the whole House Clause 1 (788773)_sd | Motion to sit in private (798541)_mean | Motion to sit in private (798541)_sd | European Union (Withdrawal) Bill: Committee of the whole House Amdt 120 (810046)_mean | European Union (Withdrawal) Bill: Committee of the whole House Amdt 120 (810046)_sd | EU (Withdrawal) Bill: Committee of the whole House Amdt 79 (788772)_mean | EU (Withdrawal) Bill: Committee of the whole House Amdt 79 (788772)_sd | sd_min | sd_max | mean_min | mean_max |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 0 | 0 |
I’d like to assess whether the data contain meaningful clusters rather than random noise. This is achieved quantitatively by calculating the Hopkins statistic, and visually by inspection.
If the Hopkins statistic is closer to 1 than 0, then we have data which may be clustered.
[1] 0.783357A visual assessment of clustering tendency reveals distance data exhibiting a visible structure.
scaled_df |>
select(-mp) |>
dist() |>
fviz_dist(
show_labels = FALSE,
gradient = list(
low = cols[1],
mid = cols[3],
high = cols[4]
)
)
There are eight methods I could use for hierarchical clustering, and I’ll need to determine which will yield results that best fit the data.
The correlation plot below shows that the median and ward methods have a weaker correlation with the other five methods.
orig_dist <- scaled_df |>
select(-mp) |>
dist()
dend_meths <-
c(
"complete",
"average",
"single",
"ward.D",
"ward.D2",
"mcquitty",
"median",
"centroid"
)
dend_list <-
map(dend_meths, \(x) {
orig_dist |>
hclust(x) |>
as.dendrogram()
})
dend_list |>
reduce(dendlist) |>
set_names(dend_meths) |>
cor.dendlist() |>
corrplot(
"pie",
"lower",
col = cols[1],
mar = c(1, 0.5, 4, 0.5),
order = "AOE",
tl.cex = 0.8,
tl.col = "black",
cl.cex = 0.7
)
The above plot does not tell us which method is optimal. For that, I’ll take each of the cluster agglomeration methods and calculate their cophenetic distances. I can then correlate these with the original distance to see which offers the best fit.
methods <- list(
"complete",
"average",
"single",
"ward.D",
"ward.D2",
"mcquitty",
"median",
"centroid"
)
best_method <- map(methods, \(x) {
co_comp <-
orig_dist |>
hclust(x) |>
cophenetic()
tibble(
correlation = cor(orig_dist, co_comp),
method = x
)
}) |>
list_rbind()The plot below confirms the ward and median methods having a weaker fit. Average produces the strongest correlation coefficient of 0.98.
best_method |>
ggplot(aes(reorder(method, correlation), correlation)) +
geom_col(fill = cols[1], width = 0.8) +
geom_text(aes(label = str_c(method, " ", round(correlation, 2))),
hjust = 1.3, colour = "white"
) +
coord_flip() +
labs(
x = "Method", y = "Correlation",
title = "Cluster Method Correlation Coefficients",
caption = "Source: Hansard"
)
I can now plot the full Labour Party dendrogram using the average method. This shows a “cluster of six” MPs which is the last to merge with the rest of the party based on their voting pattern.
dend_avg <- orig_dist |>
hclust("average") |>
as.dendrogram()
labels(dend_avg) <- scaled_df$mp[order.dendrogram(dend_avg)]
dend <- dend_avg |>
color_branches(k = 2, col = cols[4]) |>
set("labels_cex", 0.4)
start_formatted <- date_parse(start_date, format = "%Y-%m-%d") |>
date_format(format = "%b %d, %Y")
end_formatted <- date_parse(end_date, format = "%Y-%m-%d") |>
date_format(format = "%b %d, %Y")
ggplot(rev(dend), horiz = TRUE, offset_labels = -0.2) +
labs(
y = "\nDistance", title = "Hierarchical Clustering of Labour MPs",
subtitle = "Based on House of Commons Divisions Since the 2017 Election",
caption = glue(
"Source: Hansard ({start_formatted} to {end_formatted})")
) +
theme(panel.border = element_blank())
I’ll zoom in on the “cluster of six”.
dend_cuts <- dend |>
assign_values_to_leaves_nodePar(19, "pch") |>
assign_values_to_leaves_nodePar(5, "cex") |>
assign_values_to_leaves_nodePar(cols[1], "col") |>
set("labels_cex", 0.4) |>
set("branches_lwd", 2.5) |>
color_branches(k = 2, col = cols[1]) |>
cut(h = 50)
ggplot(rev(dend_cuts$lower[[1]]),
horiz = TRUE,
nodePar = nodePar,
offset_labels = -0.5
) +
labs(
title = "Cluster of Six",
subtitle = "MPs who Branch off First in the Dendrogram"
) +
theme_void() +
theme(plot.margin = unit(c(1, 1, 1, 1), "cm"))
Summarising and sorting the total votes by MP tells me that the “cluster of six” MPs are among the eight MPs voting the fewest times. And I can, for example, verify the record for Emma Reynolds directly via Hansard.
fewest_votes <- votes |>
left_join(mps, by = join_by(mp == ID)) |>
summarise(n_lobby = n(), .by = c(full_name_value, lobby)) |>
rename(mp = full_name_value) |>
pivot_wider(names_from = "lobby", values_from = "n_lobby") |>
mutate(total = aye + no,
mp = fct_reorder(mp, total)) |>
slice_min(n = 10, order_by = total) |>
pivot_longer(cols = -mp) |>
filter(name != "total")
fewest_votes |>
ggplot(aes(mp, value, fill = name)) +
geom_col() +
geom_label(aes(label = value), position = position_stack()) +
scale_fill_manual(values = cols[c(1, 3)]) +
coord_flip() +
labs(title = "Labour MPs Voting Fewest Times",
y = "Votes", x = NULL, fill = NULL)
Non-voting will not be the only influencing factor. The “distant cluster” will be particularly influenced by a small minority of MPs voting in the opposite direction to the overwhelming majority.
Cook’s Distance visualises these influential outliers. This shows the voting of three MPs, all on the European Union Withdrawal Bill readings, to be particular outliers. All three MPs are in the “cluster of six”.
tidy_df <- votes_df |>
pivot_longer(cols = -mp, names_to = "title", values_to = "vote")
mod <- lm(vote ~ ., data = tidy_df)
mod_df <- mod |>
augment() |>
as_tibble()
ggplot(mod_df, aes(title, .cooksd, colour = mp)) +
geom_jitter() +
geom_label_repel(aes(label = if_else(.cooksd > 0.002, mp, NA)), size = 4) +
scale_colour_manual(values = wes_palette(220, name = "Moonrise2", type = "continuous")) +
labs(title = "Cook's Distance") +
coord_flip() +
theme(
panel.border = element_blank(),
axis.text = element_text(size = 6),
legend.position = "none"
)
mod_df |>
filter(str_detect(title, "759161|824379|809989")) |>
mutate(title = str_wrap(title, 30)) |>
ggplot(aes(title, .cooksd, colour = mp)) +
geom_point(size = 4) +
geom_label_repel(aes(label = if_else(.cooksd > 0.0015, mp, NA)), size = 4) +
ggtitle("Cook's Distance") +
theme(
axis.line.x = element_line(color = "grey60"),
axis.text = element_text(size = 8),
legend.position = "none",
axis.title = element_blank()
) +
scale_colour_manual(values = wes_palette(
210, name = "Moonrise2", type = "continuous")) +
coord_flip()
Summarising below the packages and functions used in this post enables me to separately create a toolbox visualisation summarising the usage of packages and functions across all posts.
| Package | Function |
|---|---|
| base | c[5], cut[1], labels[1], library[12], list[3], max[2], min[2], nrow[1], readRDS[2], rev[2], round[1], saveRDS[2] |
| clock | date_format[2], date_parse[2] |
| conflicted | conflict_prefer_all[1], conflict_scout[1] |
| corrplot | corrplot[1] |
| dendextend | assign_values_to_leaves_nodePar[3], color_branches[2], cor.dendlist[1], set[3] |
| dplyr | across[2], c_across[4], filter[3], if_else[3], join_by[2], left_join[2], mutate[5], n[1], rename[2], select[5], slice_min[1], summarise[2], transmute[1] |
| factoextra | fviz_dist[1], get_clust_tendency[1] |
| forcats | fct_reorder[1] |
| generics | augment[1] |
| ggplot2 | aes[8], coord_flip[4], element_blank[3], element_line[1], element_text[2], geom_col[2], geom_jitter[1], geom_label[1], geom_point[1], geom_text[1], ggplot[6], ggtitle[1], labs[5], position_stack[1], scale_colour_manual[2], scale_fill_manual[1], theme[4], theme_bw[1], theme_set[1], theme_void[1], unit[1] |
| ggrepel | geom_label_repel[2] |
| glue | glue[1] |
| hansard | commons_members[1], mp_vote_record[1] |
| purrr | compact[1], list_rbind[2], map[4], pluck[1], possibly[1], reduce[1] |
| rlang | set_names[1] |
| stats | as.dendrogram[2], cophenetic[1], cor[1], dist[2], hclust[3], lm[1], order.dendrogram[1], reorder[1] |
| stringr | str_c[4], str_detect[1], str_replace[2], str_wrap[1] |
| tibble | as_tibble[1], tibble[1] |
| tidyr | pivot_longer[2], pivot_wider[2] |
| tidyselect | ends_with[4] |
| usedthese | used_here[1] |
| wesanderson | wes_palette[3] |