Cluster of Six

R
clustering
correlation
Exploring parliamentary voting patterns with hierarchical clustering
Author

Carl Goodwin

Published

January 29, 2018

Modified

January 20, 2023

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.

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.

votes <-
  map(mps$ID, possibly(pull_votes, NULL)) |>
  compact() |>
  map(simplify, "tibbles") |>
  list_rbind() |> 
  rename("lobby" = "vote")

saveRDS(votes, file = "votes.rds")

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.

scaled_df |>
  select(-mp) |>
  get_clust_tendency(nrow(votes_df) - 1) |>
  pluck("hopkins_stat")
[1] 0.783357

A 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()

R Toolbox

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]

References

Odell, Evan. 2017. Hansard: Provides Easy Downloading Capabilities for the UK Parliament API.” https://doi.org/10.5281/zenodo.591264.