But how well were topics assigned to each document?

For each document, every topic is given a “gamma” value. This represents the probability that this topic describes this document. So in our case, each speech has four gamma values associated with it, one for each topic. What does the distribution of these probabilities look like?

Figure 6: Distribution of probabilities assigning each topic to each speech.

What does this histogram mean? The vast majority of topic assignments had a probability close to 1, meaning that most documents could be classified solidly as one of our topics. But what about those that weren’t?

sketchy_speeches <- speeches_gamma %>% 
  group_by(speech_id) %>%
  filter(gamma == max(gamma)) %>%
  filter(gamma < 0.95) %>%
  ungroup() %>%
  mutate(speech_id = as.numeric(speech_id))

speeches_gamma %>%
  filter(speech_id %in% sketchy_speeches$speech_id) %>%
  left_join(topictib, by = "topic") %>%
  ggplot(aes(topic, gamma)) + geom_col(aes(fill = as.factor(topic_name))) + facet_wrap(~speech_id) +
  theme_bw()

Figure 7: Speeches where no single topic was assigned with a high (>0.95) probability.

Just from eyeballing this, we can see something pretty cool- none of our sketchy speeches seem to be shared the topics for “Euratom” and “rights”. How often were the other topics hard to classify and “confused” with other topics?

I’ve counted up how often two topics are “difficult to assign” below:

## # A tibble: 5 x 3
##   topic_a  topic_b      n
##   <chr>    <chr>    <int>
## 1 citizens euratom      7
## 2 citizens rights       6
## 3 citizens devolved     5
## 4 euratom  devolved     5
## 5 rights   devolved     5

Our topic on devolved administrations is often confused with every other topic, and the same is true for the topic on citizens rights.

# Make the above table long format
confused_topics_l <- tibble(topic = c(confused_topics$topic_a, confused_topics$topic_b), n= rep(confused_topics$n, 2))

# and count each topic
confused_topics_l %>% 
  group_by(topic) %>%
  summarise(total_n = sum(n)) %>%
  arrange(desc(total_n))

## # A tibble: 4 x 2
##   topic    total_n
##   <chr>      <int>
## 1 citizens      18
## 2 devolved      15
## 3 euratom       12
## 4 rights        11

Taken in total, we commonly see speeches that are identified as being about both citizens rights and devolved administrations quite commonly. Both these topics seem to crossover with all the other topics, including one another. This could potentially mean the issues being discussed are related in some way. Or, if we remember that topics can share words (but the words have topic-specific probabilities assigned to them) it may simply be that the kind of language and words used to describe these topics is more general, so more of their defining words are “shared” and we see more overlapping topic assignments.

Which topics were most important to each party?

Figure 8: The proportion of speeches assigned to each topic from each of the big four political groups/parties in the House of Lords.

Considered as a proportion of all of their speeches, the Conservatives and Liberal Democrats noticably speak more on the topic of citizens rights and British nationals, whereas Labour Lords speak more on the topic of Euratom than other topics. Topic 3, in which the top three words are “Women”, “rights” and “workers”, is touched on least in all four groups.

The “Topic Timeline”

How do the topics of discussion change over the course of the Hansard? We’ve already looked at this superficially with top-scoring TF-IDF words in the previous blog post, but now we can try with our topic model. Remember, each speech is associated with four probabilities (adding to 1), one for each topic. This means we can plot how these probabilities change within speeches over the course of the debate. I have plotted smoothed curves which try and provide the “best fit” for the data, to give an easier interpretation of what’s going on.

The subplot was previously a stacked column chart, which I used to show exactly how the proportion of topics in each speech changes discretely over time. But because they were so thin the columns were hard to interpret. Geom_area gives this funky piece of abstract art, which speaks to me as a biology student because it reminds me of the selective sweeps of evolving E. coli in this experiment by microbiologists at Harvard, so I decided to keep it (I know, it’s a terrible reason to keep a plot, but this is my blog). The point is that although the smoothed curves show these nice transitions between topics, the reality is a jerky mess of topic changes that does however follow a general trend.

Part-of-speech tagging

Part of speech tagging is just a fancy way of saying we’re going to label every word in a text as an “adjective” or a “noun” or a “verb” etc… Some people who are much smarter than I am have spent a good while training machines to do this and were kind enough to make it all open source. I’m not an expert, but from what I understand the OpenNLP tools are pretty good at accurately identifying the POS of each word, so that’s what we’re going to use.

pacman::p_load(NLP, openNLP, openNLPmodels.en)

# Function to annotate a specific text

sent_token_annotator <- Maxent_Sent_Token_Annotator()
word_token_annotator <- Maxent_Word_Token_Annotator()
pos_tag_annotator <- Maxent_POS_Tag_Annotator()
pos_tag_abbrs <- readRDS("../eu_hansard/data/pos_tag_abbrs.RDAT")

anno <- function(text, pattern = "NN") {
  # Note: pattern = .* will return tags for all words in text
  
  # Tokenizes the text into sentences and words
  text <- as.String(text)
  a2 <- annotate(text, list(sent_token_annotator, word_token_annotator))
  
  a3 <- annotate(text, pos_tag_annotator, a2)
  
  # Take the words from the text, pull the POS features
  a3w <- subset(a3, type == "word")
  tags <- sapply(a3w$features, `[[`, "POS")
  
  #tags_f <- tags[str_detect(text[a3w], "[A-Za-z]")]
  
  # Make a tibble of the words and tags, filter for the desired part-of-speech (pattern)
  text_tib <- tibble(word = text[a3w], tags)
  text_tib %>%
    filter(str_detect(tags, pattern)) %>% left_join(pos_tag_abbrs, by = c("tags" = "abbreviation"))
} 

I’ve shown this bit of code to illustrate that beauty is in the eye of the beholder. The anno() function is something I wrote, which was heftily borrowed from the openNLP documentation (in R). It takes some text and returns a data table with each word and the associated ‘POS tag’ (e.g. “go” and “verb”).

There’s quite a bit of cool stuff you can do with this data, and one thing people are fond of is counting the number of nouns, adjectives etc… and seeing what the most common ones are. We’re going to skip all of that and ask a different question. Can we identify different groups of speakers based on the proportion of adjectives, nouns, and verbs they use? That’s right, rather than pay attention to which words are being used, we’re going to just count them (again).

prep_speeches <- appearances_tib %>% #annotated_speeches
  anti_join(small_speeches, by="speech_id") %>%
  mutate(speeches = map(speeches, ~anno(., ".+")))

First off we remove small speeches and annotate the words in each using the function speech.

ling_profiles <- prep_speeches %>%
  unnest() %>%
  group_by(name) %>%
  summarise(n_words = n(), # Total number of words used
         n_verbs = sum(str_detect(tags, "^V.+")), # Count all the tags which correspond to verbs
         n_adjs = sum(str_detect(tags, "^J.+")), # To adjectives
         n_nouns = sum(str_detect(tags, "^N.+")), # To Nouns
         p_verbs = n_verbs/n_words, # Divide number of verbs by total number of words
         p_adjs = n_adjs/n_words,
         p_nouns = n_nouns/n_words)

Then we make what I’ve called the “linguistic profile” of each speaker, by counting up the POS tags from all the words they use, and calculating those values as a proportion of the total number of words they use.

distmat <- ling_profiles %>%
  select(p_verbs, p_adjs, p_nouns) %>%
  dist()

attr(distmat, "Labels") <- ling_profiles$name # add peers names as labels to matrix

clust <- distmat %>%
  hclust()

Now for the nasty part. We take the data for the proportions of each tag, and we calculate the Euclidian distance between each speakers profile. What on earth does that mean?

We have collcted three pieces of data for each speaker: the proportion of verbs, adjectives and nouns. This data can be arranged in 3-dimensional space like so (the x, y and z axis are the proportion of each.

Then, the Euclidian distance is a simple way of saying “calculate the distance between each of these points”. (Nb. In some cases, it is necessary to “normalise” your variables before calculating the Euclidian distance. If for example one variable is measured on a higher order of magnitude, you could end up with that one variable contributing to all the difference in distance, which makes other variables irrelevant.)

So we end up with a big table where we record the distance of each point from every other point. Here’s a little snippet of it:

##        1     2     3     4     5     6     7     8     9    10
## 1  0.000 0.044 0.011 0.074 0.053 0.025 0.024 0.056 0.023 0.039
## 2  0.044 0.000 0.051 0.102 0.028 0.037 0.060 0.017 0.041 0.025
## 3  0.011 0.051 0.000 0.079 0.057 0.034 0.029 0.063 0.033 0.049
## 4  0.074 0.102 0.079 0.000 0.115 0.068 0.053 0.106 0.062 0.080
## 5  0.053 0.028 0.057 0.115 0.000 0.056 0.074 0.042 0.055 0.043
## 6  0.025 0.037 0.034 0.068 0.056 0.000 0.026 0.042 0.012 0.022
## 7  0.024 0.060 0.029 0.053 0.074 0.026 0.000 0.067 0.024 0.046
## 8  0.056 0.017 0.063 0.106 0.042 0.042 0.067 0.000 0.048 0.029
## 9  0.023 0.041 0.033 0.062 0.055 0.012 0.024 0.048 0.000 0.023
## 10 0.039 0.025 0.049 0.080 0.043 0.022 0.046 0.029 0.023 0.000

This is what the “distance matrix” would look like for ten speakers. Speaker 1 is more similar to Speaker 3 than Speaker 2 (the distance between 1 and 3 is less).

Then we use a heirarchical clustering algorithm to try and find out how the points are organised into groups (or clusters) based on the distances between each point. There’s a bit more to it than this, but a heirarchical clustering algorithm (e.g. hclust() in R) looks through the distance matrix for the smallest number- indicating the two points that are closest together in 3D space in our image like so:

That might be these two points in our toy example. The algorithm then puts these two points into the same cluster, and repeats this process until all the points are sorted into one big cluster. You could imagine this making something like a tree, where pairs of points are added to clusters until you reach the root, where all the points are in one cluster:

plot(clust)

Our job is now to decide what an appropriate number of clusters is. If that sounds arbitrary and vague that’s because it is. Knowing what the “right” number of clusters is depends on the context. We can look at the tree made by the algorithm above, and see that two clusters of Lords are joined together quite far up the tree- implying that these two clusters are far apart in the 3D graph. These two clusters then each split into another pair, after which the distance between clusters is much smaller in successive joins. So we’ll tell the algorithm to return 4 clusters.

members <- cutree(clust, k = 4) # Cut our tree into four separate clusters.
members <- tibble(name=names(members), cluster=members) # Make a data frame from the results.

You can imagine that each peer has now been assigned to one of four clusters based on their linguistic profile.

One thing you can do to get an idea of what is driving the differences between your clusters is to plot the parallel coordinates of each of your variables:

parcoord <- ling_profiles %>%
  select(name, p_verbs, p_adjs, p_nouns) %>%
  left_join(members) %>%
  select(-name) %>%
  mutate(ID = as.character(1:n()), cluster=as.factor(cluster)) %>%             # Add ID for each row
  mutate_if(is.numeric, scale) %>%   # Scale numeric columns
  gather(key, value, c(1:3))    # Reshape to "long" format

ggplot(parcoord,     # Reshape to "long" format
       aes(key, value, group=ID, colour=cluster)) +
  geom_line() +
  geom_point(size=2, shape=21, colour="grey50") +
  scale_fill_manual(values=c("black","white")) + 
  ggpubr::theme_pubr()

I find a more helpful way is simply to plot the distribution of values for each thing we based our clustering on (proportion of verbs, adjectives and nouns used) for the peers within each cluster.

group_characteristics <- ling_profiles %>%
  left_join(members) %>%
  group_by(cluster) %>%
  summarise(verb_median = median(p_verbs), adj_median = median(p_adjs), noun_median = median(p_nouns), sd_verb=sd(p_verbs), sd_adj=sd(p_adjs), sd_noun=sd(p_nouns)) 

group_characteristics %<>% mutate_if(is.numeric, ~round(., 3))

ling_profiles %>%
  select(name, p_adjs, p_verbs, p_nouns) %>%
  gather(feature, value, c("p_adjs","p_verbs", "p_nouns")) %>%
  left_join(members, by= "name") %>%
  ggplot(aes(feature, value)) + 
  geom_boxplot(aes(group=feature, colour=feature),show.legend = F) + 
  geom_point(aes(colour=feature), alpha=0.5) +
  facet_wrap(~cluster, ncol = 4) +
  theme_bw()

DT::datatable(group_characteristics)

Now this is cool. The first two groups of peers use pretty similar proportions of each grammatical feature, but one group uses marginally less nouns and marginally more verbs. The next two clusters, each containing 6 and 5 peers respectively, have markedly different distributions. Cluster 3 use a much higher proportion of nouns than verbs. They use on average 66%-88% of the verbs other clusters do, while using 26-53% more nouns. Cluster 4 is even weirder, these peers generally use more verbs than nouns but also on average were using only 63%-76% as many adjectives as other groups of peers.

##           1         2         3        4
## 1 1.0000000 1.1290323 0.9333333 1.489362
## 2 0.8857143 1.0000000 0.8266667 1.319149
## 3 1.0714286 1.2096774 1.0000000 1.595745
## 4 0.6714286 0.7580645 0.6266667 1.000000

We can use matrices to calculate the average differences between all the clusters, this one is the difference in proportion of adjectives (notice the row for cluster 4).

You can peruse this table showing which Lords were allocated to which cluster at your own leisure, but will point you to two examples:

Lord Bilimoria of Cluster 3: speech Lord Deben of Cluster 4: speech

Although it’s not amazingly clear, you might notice how Bilimoria references many organisations during his speech, leading to the inflated number of nouns and presumably also contributing to the lower proportion of verbs. Lord Deben on the other hand likes his doing words, and I think the inflated proportion of verbs is noticeable in the way he speaks so demandingly, but I might be suffering from bias.

Further thoughts (if you’re interested)

There’s something to be said here for the general role of exploratory data analysis in political and social discourse and decision making. Sometimes, analyses can give the impression that a researcher didn’t think to themselves “just because we can, doesn’t mean that we should”. Every tool is only as useful as the practitioner is skillful. A more abstract method used in the wrong situation only obscures. Obviously here, I have been trying to showcase how different tools might be used in the context of exploring a parliamentary debate. We have looked at it through the lens of a data analysis problem without being too concerned about the results. But I hope I have also communicated to some extent the challenges inherent in this process- particularly at the ends of meaningful implementation and interpretation.

Such tools should one day form a core part of a political transparency and accountability- but they are only as powerful as our ability to communicate the findings transparently ourselves. The House of Commons library publishes research by independent experts who also provide impartial briefings to MPs on issues. This is really great. Earlier in the article I also linked to the House of Lords Research Briefings. But this is only one part of transparency I’d like to see in a democracy. There is no substitute for giving people the power to dig into the data themselves. You cannot get closer to the reality of parliamentary opinion than the Hansards themselves. Often in such curated analysis the end product is nice but the analytical process is obscured. I recently read this really interesting YouGov piece, but I found it hard to understand how they got their results. Let people see the guts and grime, and make the data available in an accessible format so the analysis can be reproduced. Open source tools like those built in R are beginning to change how people interact with politics, but there is still room for improvement at all levels: data providers (the govt.), data analysts and communicators (researchers and journalists) and consumers (the general public).

Here is a link to the github page for this project if you’d like to look at the code. Please send feedback to mchaib[dot]blog[at]gmail[dot]com.