America First 40s style: using NLP methods to analyse Lindberg Des Moines Speech

I recently read Plot Against America, a terrific alternate history novel written by Philip Roth. It charts the fate of a Jewish family in USA in which Charles Lindbergh runs for presidency in 1940 and defeats FDR on America First platform. Inspired by the book, and the fantastic cleanNLP package I learned about in useR 2017 conference in Brussels, I decided to run a small text analysis on Lindberghs Des Moines speech.

What makes cleanNLP such a great package is mainly how it tidies raw text data to nice data frames. It has backends to both CoreNLP package in Java and spaCy package in Python so in doing the tidying of data it harnesses state-of-the-art dependency parsers, POS taggers and entity recognizers built in aforementioned libraries. Thus, with a couple simple lines of code, you are presented with a data frame containing not only tokens but various useful objects you can take advantage of.

You can read (and listen to) the Des Moines speech here, For my purposes, I simply copied and pasted the speech to a simple txt-file but you could as well use rvest or other web scraping tools to get the speech right of the website.

library(cleanNLP)
library(readr)
library(wordcloud)
library(dplyr)
library(RColorBrewer)
library(syuzhet)
library(ggplot2)

init_spaCy()

desMoines <- read_file("C:/desMoines.txt")

anno <- run_annotators(desMoines, as_strings = TRUE)
df <- get_combine(anno)

Code above shows the steps taken to get the tokenised data frame from one wall of text. I chose the SpaCy backend which is initialized in a simple step. Then run_annotators tokenises the text using the spaCy library. Finally the various data frame objects created by the function are put together with the get_combine. Text is tidied and we are ready to start analysis!

I begin by looking at what countries and nationalities get mentioned in the speech. Mind you, the speech is held in 1941 when WW2 is in full speed and Pearl Harbor is not too far away. With a tidy data frame containing a column for recognized entities, it is simple to apply so-called tidyverse grammar from my favourite dplyr package to check this out.

df %>% filter(entity_type %in% c("GPE","NORP")) %>% select(entity) %>% group_by(entity) %>% summarise(N=n()) %>% arrange(desc(N))

              entity     N
               <chr> <int>
1           American    13
2            America    10
3            British     9
4             Jewish     9
5            England     8
6  the United States     7
7           European     6
8            Germany     5
9             France     3
10     Great Britain     2
11        Washington     2
12            Allies     1
13         Americans     1
14       Anglophiles     1
15              Axis     1
16              Iowa     1
17              ours     1

Up there with the obvious America are the would-be allies British are the time's trendy scapegoats the Jews. Germany, which was wrecking havoc across Europe was mentioned five times and already surrendered France 3 times. The Pacific front and the Japanese get no mention at all. From the list it can be seen that this was a speech concerned keeping USA out of war and war out of USA.

Another way to analyse the speech is look at dependencies, that is which words accompany others. Good thing we have that spaCy dependency parser at hand! Here I look at direct object dependencies.

df %>% filter(relation=="dobj") %>% mutate(wordPair = paste(word, "-->", word_source)) %>% select(wordPair) %>%  group_by(wordPair) %>% summarise(N=n() ) %>% arrange(desc(N)) %>% print(n=142)

Among the direct object dependencies are found the following telling word pairs: intervention --> oppose and Jewish --> attacking and the most frequent dependency appearing total of 4 times, us --> involve.

Ok, lets do something traditional next; the classic text miners servant the wordcloud. Using part-of-speech tags produced by spaCy to filter the data frame allows us to use a kind of enlarged version of stopword lists, focusing only on the interesting words that carry most information, that is nouns, proper nouns, verbs and adjectives but discounting pronouns.

cloudWords <- df %>% filter(upos %in% c("NOUN","PROPN", "VERB","ADJ") & pos != "PRP$") %>% select(lemma) %>% unlist()

wordcloud(cloudWords, max.words = 100, colors=brewer.pal(6,"Dark2"))

Finally, I will track the progression of the speech' sentiment. That is accomplished by aggregating the data frame from levels of tokens (individual words) to sentences and then applying a sentiment analysis algorithm from suyzhet package. Finally to inspect slightly larger chunks than individual sentences, the sentiment scores are aggregated to the levels of chunks of 5 sentences.

sents <- df %>% group_by(sid) %>% summarise(lause=paste(lemma, collapse=" "))

sentiments <- get_sentiment(sents$lause, method="nrc")
rk <- rep(1:26, each=5)

sentiDF <- data.frame(rk, sentiments) %>% group_by(rk) %>% summarise(MeanSent=mean(sentiments))

ggplot(data=sentiDF, aes(y=MeanSent, x=rk)) + geom_line()
 

As you can see as far as sentiment score in positive/negative scale goes, the speech does not follow a clear pattern but rather positive peaks are followed by negative slumps. The longest consistently positively classified part of the speech happens around the tenth chunk. This is the part of the speech where first talks about British attempts to draw America into war, followed by talk about the Jews and the most humane sentence of speech "No person with a sense of the dignity of mankind can condone the persecution of the Jewish race in Germany".

CleanNLP, enhanced by the powerful spaCy library, is a great and easy-to-use addition to the R text analysis universe. The great part about the package is that rather than work in abstact corpus objects like the traditional tm package, it crunches the text data to the data frame form we all R users are so familiar with. This allows one to conduct quite elaborate text analysis tasks without knowing much about text analytics per se.

The 80 percent rule: data wrangling in practise

One of the most oft-recited passages about the hyped up sport of data science is along the lines of 80 % of the work of data scientist consists of cleaning and preparing data. Data comes in many formats from many sources. Clean and ready-to-model data is often a pipe dream. In this blog post I decided to showcase my thus far most extreme example of this dictum.

Where did it all start? I had toyed around a bit with web scraping as I remembered an old blog post by one Finnish researcher from around the time of 2015 Finnish parliamentary elections about how pre-election poll ratings and actual election results have differed in the past. I decided to check out how it played out in the latest electoral showing and promptly went to the Wikipedia-page  (in Finnish) about the elections. There I found exactly the data I needed relatively nicely packaged in two tables. To make things more fun, I wanted to scrape the tables directly to R instead of resorting to any mechanical copy-paste work. Oh, not me! So I went and loaded up R and the rvest package for webscraping.

library(rvest)
html = html("https://fi.wikipedia.org/wiki/Eduskuntavaalit_2015")
polls = html_table(html_nodes(html, "table")[[14]],fill=TRUE)
result = html_table(html_nodes(html, "table")[[6]],fill=TRUE)

Looks easy enough. I save the url for the wikipedia page and then use scrape the specific "table" elements off the html code. But to have data in usable form, we are far from it! Let's see first the cleaning required for the poll data.

polls <- polls[,4:12]pollvars <- unlist(polls[1,])
colnames(polls) <- pollvarspolls <- polls[3:23,]

library(stringi)
commatodot <- function(x) {gsub(",",".",x) }
percentsoff <- function(x) {gsub("%","",x) }
slashtoNA <- function(x) {gsub("-",NA,x) }
trimming <- function(x) {substr(x,1,stri_length(x)-1) } 

polls[pollvars] <- sapply(polls[pollvars],commatodot)polls[pollvars] <- sapply(polls[pollvars],percentsoff)polls[pollvars] <- sapply(polls[pollvars],slashtoNA)polls[pollvars] <- sapply(polls[pollvars],trimming)polls[pollvars] <- sapply(polls[pollvars],as.numeric)

First I filtered out the columns I had no need for, leaving only the variables indicating the party in question. Next, receiving table with column names on first row rather than as proper column names i played around to get columns properly named. Finally I chose only the rows containing poll data I wanted.

Had my data come properly formatted, this would have been my end-point for manipulating this table. Instead, I got the data in character format, with commas instead of dots to designate decimal points, with percentage symbols and weird non-whitespace blanks. Thus a variety of functions had to be initialized to clean the data effectively until I finally was able to turn the data to numeric format.

result <- result[3:18,c(2,5)]
result <- t(as.matrix(result))

resultvars <- unlist(result[1,])
colnames(result) <- resultvars
result <- as.data.frame(result)
result <- result[2,]
result[resultvars] <- sapply(result[resultvars],commatodot)
result[resultvars] <- sapply(result[resultvars],as.numeric)
result$Muut <- sum(result[,9:16])

result <- result[,c(1:8,17)]

 The other wiki-table containing the actual election day results hardly came at any easier format. Resulting table had to be transposed, rows and columns filtered and and the cell values cleaned before there was anything of value. Unlike the table containign poll data, small parties were not lumped under "Muut" =("Others") so they had to be summed to one column so the two data frames could be lumped together.,

nams <- colnames(polls)
 

result <- result[c(3,4,2,1,6,5,7,8,9)]

colnames(result) <- nams

datum <- rbind(result, polls)
datum$index <- rep(1:22,1)
datum <- datum[order(-datum$index),1:9]

With two tables cleaned, the remaining challenge was to bind them together. Problem was that both the column names and their respective ordering differed between the tables. I picked the poll data format and renamed and reordered result data. After the two data sets were appended, I flipped the data upside down so as to have the oldest poll row at first row and the actual result at the final, 22nd row.

So, data was finally in usable order. What now? Well, I couldn't think of much. Calculate the difference between the final polling data and the actual election result and drawing a time series plot:

x <- unlist(datum[2,])
y <- unlist(datum[1,]) 

y-x

ts.plot(datum,col=1:ncol(datum))
legend("topleft", colnames(datum), col=1:ncol(datum), lty=1, cex=.65)

Kok.   SDP    PS Kesk.  Vas. Vihr.   RKP    KD  Muut 
  0.8   0.6   0.5  -2.0  -0.1   0.3  -0.9   0.4   0.4 

So of the top 4 parties, the eventual winners Centre Party underperformed in contrast to their very high polling levels, whereas the other 3 somewhat overperformed. 

Hardly exhilirating results and barely worth the effort! But such can be working with data.

Party poopers - Predicting political affiliations

A few weeks ago I made a post in the Finnish version of the blog utilising Finnish National Broadcasting Company's "voting aid application" data. It consists of a variety of questions on political issues candidates were asked to answer, mixed with background data. In the linked article, I employed various clustering methods to group the candidates to more "natural" political parties based on their ideologies as manifested by their answers to the questionnaire.

To borrow terminology from machine learning community, clustering is an example of so-called "unsupervised learning", a case where data is unlabeled and the result is purely based on patterns in data. In constrast, this post concerns itself with classification which is a prime example of "supervised learning" where we know the kind of problem we wish the algorithm to answer beforehand (ie., there is an output/dependent variable we are specially interested in and hope to explain using input/indepentent variables)

To be more exact, I will train a support vector machine (SVM) model and attempt to predict the party affiliation of a given respondent based on his/her policy statements in the questionnaire. Support vector machines are a staple and an age-old favourite of data science community and one of the most used algorithms for classification tasks. I will not delve into details of the algorithm, not least because my personal understanding is hardly crystal clear. But the bread and butter of the approach is to find planes in a vector space that best separate data points from each other. To try to illustrate it in more simple terms, we can imagine a classic 2-dimensional space to which we draw a line separating two groups of observations from each other. The line is drawn as such that the data points belonging to one label are optimally above the line while other group is below. This is then generalized to multidimensional spaces and hyperplanes. Here is a good article delving a bit deeper into the theory so I won't make too much of a fool of myself.

If we assume that one of the main criticisms leveled at modern party politics to be correct, namely that their ideological convergence makes them more or less indistinguishable from one another, predicting the correct party should not be too easy a task. If parties are ideologically alike then their candidates should show no greater between-groups than within-groups variance. And classifying the party of respondent correctly should be liable to many errors. Let's find out whether all parties are created equal!

For this post we will use library e1071 for the SVM algorithm and caret for a simple, straightforward method to partitioning data to test and train sets. And dplyr. Never leave home without dplyr! Dplyr's older brother plyr is also used to recode levels of factor variable.

First steps of any data analysis project are naturally loading up the data and making required data cleaning and transformation operations. The code below accomplishes some of the routine tasks: loading up the data stored in a csv-file, dealing with missing values, filtering out the rows with observations belonging to parties outside the parliament and picking only desired columns from the hundreds the dataset has to offer. Finally full party names are recoded to their abbreviations. (note, the data set does not exactly contain what the code here suggests, Finnish variable names and values have been translated to English for consistency in this example code.

df <- read.csv("C:/Users/User/Desktop/User/Data/electiondata.csv", header=TRUE,
                  stringsAsFactors=TRUE,sep = ";", na.strings = "",encoding="UTF-8")


x <- as.data.frame(table(df$party))
x <- arrange(x, desc(Freq))
x <- x[c(1:7,11),]
z <- as.character(x$Var1)
 
df <- filter(df, party %in%  z )
df <- df[c(1:64,40:259)] 
df <- df[, -grep("comment",colnames(df))]
df[is.na(df)] <- "pass the question"

 df$party <- revalue(df$party, c("Kansallinen Kokoomus"="KOK","Perussuomalaiset"="PS","Suomen Keskusta"="KESK","Suomen Kristillisdemokraatit (KD)"="KD",
                            "Suomen ruotsalainen kansanpuolue"="RKP","Suomen Sosialidemokraattinen Puolue"="SDP","Vasemmistoliitto"="VAS",
                            "Vihreä liitto"="VIHR"))

Next thing on the to-do list is to split the data to test and train sets. Models should always be tested for accuracy outside their natural habitat, ie. the data they are trained with. This is to ensure that the model can cope with previously unseen data, rather than just imitating the quirks and unique patterns of it's training data not encountered elsewhere. For this task, createDataPartition-function of caret package is a most useful aide. For svm-function of the e1071 package I prefer to split dependent variable from independent variables to a vector of it's own but this is not strictly necessary. Independent factor variables are transformed to numeric ones. Missing values caused by coercing factors to numeric (concerns questions with yes/no-answers) are dealt with.

theSplit <- createDataPartition(df$party,times=1, p=0.20, list=FALSE)
train <- df[-theSplit,]
test <- df[theSplit,]
trainlabels <- as.character(train$party)
traindata <- train[c(2:46)]
traindata <- as.data.frame(lapply(traindata, function(x) as.numeric(x)))
traindata[is.na(traindata)] <- 3

testlabels <- as.character(test$party)
testdata <- test[c(2:46)]
testdata <- as.data.frame(lapply(testdata, function(x) as.numeric(x)))
testdata[is.na(testdata)] <- 3

With data cleaned and modified and test and training sets ready to fire, it's time to do the cool stuff! As is customary, the cool stuff is done only in couple simple lines of code. First training the model with training set, then using the model to predict values in the test set. Finally we check the results by merging predicted labels with actual labels in test set and creating a contingency table.

model <- svm(x=traindata, y=trainlabels, type = "C-classification")
preds <- predict(model, testdata)

results <- merge(testlabels, preds, by="row.names")

table(results$x, results$y)

And the following is the resulting contingency table (actual labels on rows, predicted on columns:

      KD KESK KOK PS RKP SDP VAS VIHR
  KD   24    4   3  3   1   1   1    2
  KESK  8   21   5  5   0   4   1    0
  KOK   2    5  27  3   0   2   4    0
  PS    4    2   2 30   0   2   3    0
  RKP   0    3   1  1  11   0   4    1
  SDP   0    6   2  2   0  27   7    0
  VAS   2    0   0  0   0   4  36    2
  VIHR  0    1   1  0   1   0   6   33

The SVM model obviously did pretty well. With each respective party, the vast majority of respondents were labeled correctly. And of the misses, a big portion went to parties ideologically close to correct answer. For example for the Green Party (VIHR), of the 9 misclassified observations 6 were classified as members of the Left Alliance (VAS). The odd one out is the mostly right-wing liberal Swedish People's Party (RKP) with 4 out 8 misclassification going under Left Alliance but the explanation propably lies in the respective parties' liberal take to moral questions. Also rather curiously 4 members of the right-wing National Coalition (KOK) were labeled Left Alliance members whereas none were assigned the label of the Green Party, once derided as the "National Coalition's garden department.

So based on this experiment, the political affiliation of a random questionnaire respondent can be predicted with reasonable accuracy. The news of parties' death have been greatly exaggerated.

Predicting elections with socio-economic indicators - case Finnish Centre Party

All the way back from my time in university as a political sciences student with growing interest towards statistical methods, I have been intrigued by the prospects of explaining and predicting political elections using socio-economic indicators. Without resorting to such traditional explanatory variables from within the political sphere as the polls, news events or candidates' media acumen, how accurate predictions or astute explanatory models could I draw from simple socio-economic variables such as regional unemployment or education levels? Could I predict the candidate's chance of being elected knowing his age, income, marital status and degree? (turns out I can to a surprisingly large degree, link in Finnish)

This time I showcase a neat predictive model called random forest with my test case being the 2015 Finnish parliamentary elections and specifically the Centre Party. A natural party of government ever since the second World War ideologically rooted in the Finnish agrarian movement and situated between centre-left social democrats and centre right National Coalition, the party slumped to it's worst ever post-independence election result in 2011, gathering 15,8 % of votes cast. Four year later the party regained top spot with 21,1 % support, aided largely by inept 6-party rainbow coalition government in charge in between the contests. Besides the overwhelming victory, what makes Centre Party so interesting as a test case is regionally stable and rather well-defined support concentrated in large part to the Finnish rural municipalities. Training a random forest model on 2011 election and predicting (or postdicting?) the 2015 results with it, can I do better than the baseline model of predicting exactly same election result for each municipality?

Lets begin! (for convenience I will skip large parts of code involving the nitty-gritties of data wrangling required to assemble the datasets used)

Lets start with the simple baseline model: the average of absolute difference in support of Centre Party in elections of 2015 and 2011, geographical unit being a municipality

mean(abs(centredf$KESK - centredf$KESK2011))

[1] 6.755305

 So this is the score to beat and below are the tools we attempt to accomplish the task with:

library(rgdal)
library(randomForest)
library(tmap)
library(ggplot2)

Tmap is for GIS purposes, that is visualizing the results on a map while rgdal allows me to read an kml-file on which the visualization is done on. Ggplot2 is for your more regular run-of-the-mill visualization purposes. The actual predictive tool is stored in aptly named library randomForest.

Very shortly explained, random forests are an extension of decision trees, one of the most used data mining algorithms. Random forest-model tries to overcome the weaknessess of decision trees by believing in the wisdom of the masses. As the name suggests, it creates a number of decision tree models, randomizing the variables and rows included in the modeling process. While losing the ease of interpretability of decision trees, by averaging the biases and errors of individual decision trees it should come packed with increased predictive power.

For my independent variables I have picked a number of indicators off Statistics Finland's open data menu, including such classics as unemployment level, average age, maintenance ratio and demographic loss from movement. While my variable set is still within maintainable levels, it is still easier to create the formula for the algorithm outside randomForest-function. That is achieved by saving the names of variables to a vector, picking a fitting subset of them and then pasting them on to an as.formula-function.

n <- names(df)
n <- n[-c(4:11)]

fkesk <- as.formula(paste("KESK ~", paste(n,collapse = " + ")))

Equipped with ready made formula, we are ready to start predicting. At this point, data is split between two dataframes, df and df2011, consisting of exactly the same make up of variables but one for 2015 elections and the latter, naturally, for 2011. Training the predictive model is done simply by feeding randomForest-function the formula saved in variable fkesk and the 2011 data we wish to train the predictive model with. By saving the resulting model to fitkesk and using predict-function to 2015 data we get our predictions. By merging the resulting data with the original 2015 dataframe it is easy to plot the predicted vs observed values on a scatter plot.

fitkesk <- randomForest(fkesk, data=df2011)
predkesk <- predict(fitkesk,df)
dffkesk <- merge(df,predkesk, by="row.names")

ggplot(data=dffkesk, aes(y, KESK)) + geom_point(color="darkgreen") + geom_smooth(method="lm") + coord_cartesian(xlim=c(0,80), ylim = c(0,80))

We see that there's definitely a clear trend between predicted and actual values. The variation is pretty evenly spread. The obvious problem are the few municipilaties where Centre Party gained no votes at all where the worst individual mistake predicted over 30 percent of votes.

Looking at the plot alone we can infer that the baseline model could have beaten us this time. And sure enough:

mean(abs(dffkesk$KESK - dffkesk$y))

11.4

We almost doubled the average absolute difference between predicted and actual values! How is this possible?

This is a proof that data science and fancy algorithms are often only as good as the domain knowledge and understanding of the subject matter behind it. Elections that really shake the political field are hard enough to gauge with a human eye with access to all the relevant information; almost impossible for models trained with secondary, "dumb" data. Centre Party's massive electoral victory meant that whereas the model trained for 2011 elections would have made mistakes even inside the specific 2011 electoral contest, the model's biases and mistakes were multiplied when the context was badly shaken.

So what kind of biases did our model have? Let's take a look at how the support for Centre Party was spread vis a vis the spread of error in predictions geographically. For this, we use some of R's great GIS capabilities, though in a very simple manner.

dffkesk$diff <- abs(dffkesk$KESK - dffkesk$y)
names(dffkesk)[19] <- "Name"

kml<-readOGR("C:\\Users\\user\\Desktop\\Kuntarajat 2015.kml", "Kuntarajat 2015", stringsAsFactors = F, use_iconv = T,
             encoding = "UTF-8")

kml@data <- left_join(kml@data, dffkesk)

qtm(kml, "diff")
qtm(kml, "KESK")

First we create a new variable diff to store absolute difference between. Then we change the column containing municipal names to "Name", which is exactly the column name in our kml-file. Somebody else can explain the details of kml-files but what one needs to know that they are files containing slots for both traditional data (such as, employment levels etc) and the geographical details (coordinates and such, creating an empty map we can paint with our data)

I have downloaded the kml file containing Finnish map with 2015 municipal borders from Finnish datajournalismi-blog. readOgr is used to bring it to R system. use_iconv and encoding-options are used to deal with the umlauts met everywhere in beautiful Finnish language (hello, yököttää!). Finally, by left_joining the traditional data set dffkesk to kml's data-slot, we have the data to visualize. Qtm-function from library tmap makes it about as it as it gets, requiring at it simplest only two parameters: kml file and the variable to be plotted. And the results aren't ugly either!

 Map of absolute difference between predicted and actual values

Actual electoral support of Finnish Centre Party in Finnish parliamentary elections 2015

Two likely patterns stand out: the model performed worst in cases of exceptionally high or exceptionally low actual support for Centre Party. Nobody who has heard the phrase "regression toward the mean" should be surprised. The model, not knowing better, tends gravitate more towards the average support. This is especially so when socioeconomic differences between municipalities are not as great as the difference in political support and traditions.

To sum up the lesson: good algorithms don't necessarily produce good results but the results of "dumb" models can be sufficiently close to the real deal.

Naturally I went through this same exercise for all the political parties involved in the elections. I just wanted to focus on the most interesting case and left the best performing model to be revealed at the end. So which model was the winner?

Dun dun dun.

The model predicting the support for Green Party was the standout performer. Below is the scatter plot and "baseline" and "model" absolute differences.

Absolute difference of 2011 and 2015 election scores for Greens: 0.91 
Absolute difference of predicted and actual values: 1.37 

This proves we can get close when the party in question has stable level of support with socioeconomically distinct strongholds (well-off, educated and most of all urban municipalies). Just imagine how good a model could be armed with a little common sense, such as polling numbers.

Social network of US presidential hopefuls

The US presidential elections will be finally kicked off tomorrow with Iowa being the first state to vote in primaries. Democratic contest will be largely between Hillary Clinton and Bernie Sanders with Martin O'Malley providing the third alternative. Donald Trump heads to Iowa leading the more contested Republican field. In due time, more and more hopefuls will drop from the race and then it's a race to gather the scraps between the remaining candidates. But who is there to most likely gain from dropout's supporters looking for a new political home?

In this blogpost we will use data from Facebook to plot a network graph of US presidential nominees. We build on the assumption that "liking" a Facebook post indicates a level of support for the person and liking more than one candidate's posts indicates that the person in question supports both/all of the candidates and could consider voting any of them in the actual election.

So, our indicator of closeness between Facebook candidates will be amount of individuals who like a post of both candidates.




In order to achieve this, we need help from three R libraries. Already introduced RFacebook to access the Facebook API, text mining package tm to create the candidate X candidate matrix with amount of shared "likers" in cells and finally qgraph (a convenient package for creating automatic network graphs when you don't want to tinker with details in igraph)

The code used in this blogpost is below:

pages <- c("DonaldTrump","hillaryclinton","berniesanders","MartinOMalley","realbencarson","govchristie",
           "tedcruzpage","CarlyFiorina","gilmoreforamerica","mikehuckabee","JohnKasich","RandPaul","MarcoRubio",
           "RickSantorum","jebbush")


listing <- list()
for (i in 1:length(pages)) {
temp <- getPage(pages[i], token=fb_oauth, n=3) 
temp2 <- temp$id 
id <- c() 

for (j in 1:length(temp2))  {
temp3 <- temp2[j]
post <- getPost(temp3,token=fb_oauth) 
likes <- post$likes$from_id
id <- c(id,likes) 
}

id <- unique(id)
listing[[i]] <- id

}

doc <- Corpus(VectorSource(listing))

shorts <- c("DT","HC","BS","MM","BC","CC","TC","CF","JG","MH","JK","RP","MR","RS","JB")

dtm <- DocumentTermMatrix(doc)
dtm <- as.matrix(dtm)
dtm <- dtm %*% t(dtm)
dtm <- dtm/diag(dtm)
row.names(dtm) <- shorts
colnames(dtm) <- shorts
diag(dtm) <- 0
qgraph(dtm)

First part is pretty much the same as used in the previous foray into the mysterious world of Facebook API. Remaining part is pretty straightforward as well. After collecting all the unique id:s from Facebook and saved them to a list called listing (sometimes I feel I am really bad at making up these object names) we transform the data to a text corpus. Text corpus is then turned into a document term matrix (an object with documents on the rows and terms (in this case Facebook ID:s) in the columns. We then multiply this document term matrix with it's transpose matrix to create the final matrix with candidates on both rows and columns and cell values indicating amount of shared likers.

However, simple absolute cell counts are a poor indicator for two candidate's closeness. Say, candidate A has 10 000 likes and candidate B has 1000. They share 500 likes. Obviously for candidate B, A is a very close candidate but the other way around the importance is lesser. Thus we want the relationsships to be relative and directed.

To achieve this, we divide each cell with the value in the diagonal cell of that row. Then we end up with a value ranging from 0 to 1, indicating how big a percentage of candidate's likers also liked the other candidate. So the value for A and B respectively is different, depending on the perspective. After the division, we set diagonal to 0 as we don't want candidates to have networks with themselves.

In order to know who is who, we name the rows and columns by the initials of candidates (sorry Bernie, no hard feelings?)

Finally, we end up with a graph seen above (sample used was three most recent Facebook posts due to constraints in Facebook API. And also because after manually collecting likes from 20 latest posts manually, the resulting network graph lost in clarity due to bigger masses leading to stronger networks)

Obviously, Republican candidates are far away from the Democrats. Martin O'Malley shares some likers with Chris Christie, John Kasich and Jim Gilmore but Bernie and Hillary are safely isolated from Republican social media, with very weak ties between themselves. It seems that with a narrow selection of candidates, people are more focused on supporting their own preferred man/woman.

In the republican field the people have more ties. The ultimate outsider and thorn in the backs of Republican establishment, Donald Trump, is relatively isolated from the rest of the pack but with strongest ties to two other more or less fiery and controversial anti-establishment candidates, Ben Carson and Ted Cruz. Carson and Cruz share the strongest tie seen in the sample, with Mike Huckabee also a close match for the duo. On the more moderate Republican camp, Jeb Bush, Chris Christie and Jim Gilmore create a close trio. Bush, the sorry establishment favourite sorely lacking in popular support, is however also close tied to Carly Fiorina, Rick Santorum and John Kasich. However, even with all these candidates dropping and leaving their supporters to Bush, that might still not enough to save him. Rand Paul, the son of libertarian Ron Paul with apparently almost equal distaste for federal government meddling as his father, is another lone wolf championing for the libertarian cause.

The sample used here has a total of 17161 observations (handily calculated using lapply, length and sum functions like this: sum(unlist(lapply(listing,length)))) ) so while the time frame of three posts is narrow, total amount of cases is still high enough to draw some initial insights. Especially on the Republican field, each candidate should carefully try to calculate the possible supporters gained after each drop out.

Tweet sentiments during Boxing Day matches

If you ask me, Boxing Day is the best of Christmas holidays. On Boxing Day my local club plays in a traditional charity match, giving the fan of Finnish football a small glimpse of things to come during the world's longest (painfully so) pre-season. But besides that, some less interesting action goes around in the one of the most revered institution of English football, the traditional Boxing Day match round when all English Premier League sides are in action. This is a prime time to analyze Twitter feed to see whether sentiment analysis techniques can catch signal of the score of the game.

For this, we broadly need three components. First is of course access to Twitter API and the ability to collect data from it. For this, we use excellent TwitteR package. Here is one tutorial on how to set it up.

Second, we want an algorithm for estimating expressed sentiment. Since the R's sentiment package which did all this for us is apparently now defunct, we can either access one of the many sentiment analysis APIs on the Internet or create our own classification algorithm. For this purpose, I will loan the ideas of Jeffrey Breen and an opinion lexicon from Hu and Liu (also used by Jeffrey). We don't concern ourselves so much with the quality of individual classifications but the overall sentiment expressed in the tweets. For this we will calculate a positivity index.

Thirdly, some datetime functions to limit the tweets to be analysed to a pre-defined time frame is required. For this example I select only the tweets tweeted by official accounts of EPL clubs during the match itself and two hours afterwards. (the reason to download only official tweets from clubs is the fact that keyword -based search produces far too noisy data as supporters of a club, those likely to feel based on the scoreline, are hard to filter from the great mass of tweets. Although, as we shall see, official tweets of EPL clubs contain about as much information as interviews of managers)

We will mash all this functionality together to define a single function that is easy to call for different clubs. Functions are in R what macros are in SAS, allowing to run same batch of code over and over again dynamically by changing few parameters. Of course, R functions are more than that and all in all more flexible than SAS macros but let's not get into that on any deeper level.

Ok, lets begin! Again we start with loading the required libraries.

library(twitteR)
library(stringr)
library(dplyr)
library(lubridate)

Twitter is to access the API of, well you know. Stringr is mainly needed for one function in order to dissect tweets into individual words to be matched to opinion lexicons. Dplyr we can't live without and lubridate provides the function to work with datetime columns.


The function we define is as follows. We will dissect that beast to smaller sections below:

tweetsentiment <- function(user, n, dateday, datemonth, hourstart, hourend, minutestart, minuteend) {

 
tweets <- userTimeline(user,n=n)
tweetdf <- twListToDF(tweets)
tweetdf <- filter(tweetdf, month(created) == datemonth)
tweetdf <- filter(tweetdf, day(created) == dateday)
tweetdf <- filter(tweetdf, hour(created) >= hourstart &hour(created) <= hourend)
tweetdf <- filter(tweetdf, !(hour(created) == hourstart & minute(created) < minutestart)  
                  & !(hour(created) == hourend & minute(created) > minuteend)  )



tweetdf$text = gsub("[[:punct:]]", "", tweetdf$text)
tweetdf$text = gsub("[[:digit:]]", "", tweetdf$text)

tweetdf$text <-  tolower(tweetdf$text)


pos <- scan('C:/data/positive-words.txt',
            what='character', comment.char=';')
neg <- scan('C:/data/negative-words.txt',
            what='character', comment.char=';')

tweetdf$score <- 0
for(i in 1:length(tweetdf$text)) {
 
  words = str_split(tweetdf$text[i], '\\s+')
  words = unlist(words)
  pos.matches = match(words, pos)
  neg.matches = match(words, neg)
  pos.matches = !is.na(pos.matches)
  neg.matches = !is.na(neg.matches)
  tweetdf$score[i] = sum(pos.matches) - sum(neg.matches)
}

tweetdf$class[tweetdf$score < 0] <- "negative"
tweetdf$class[tweetdf$score == 0] <- "neutral"
tweetdf$class[tweetdf$score > 0] <- "positive"


x <- table(tweetdf$class)
x <- as.matrix(x)
y <- (x[3,]-x[1,])/colSums(x)
returnlist <- list(y, tweetdf)
return(returnlist)
}

Ok, lets start diving into individual pieces:

tweetsentiment <- function(user, n, dateday, datemonth, hourstart, hourend, minutestart, minuteend) {

The code starts with a function definition ending with curly brackets. Here we define the name and the parameters of the function. At the end of the function we obviously need to close the curly brackets.

tweets <- userTimeline(user,n=n)
tweetdf <- twListToDF(tweets)
tweetdf <- filter(tweetdf, month(created) == datemonth)
tweetdf <- filter(tweetdf, day(created) == dateday)
tweetdf <- filter(tweetdf, hour(created) >= hourstart &hour(created) <= hourend)
tweetdf <- filter(tweetdf, !(hour(created) == hourstart & minute(created) < minutestart)  
                  & !(hour(created) == hourend & minute(created) > minuteend)  )

In this portion we access the Twitter API with userTimeline function, feeding it parameters user and n in the function call. Then we create a dataframe out of the resulting object.

Next, we use a bunch of filter-statements from dplyr to narrow down the resulting time frame, using the datetime parameters specified in the function call. We begin by selecting the correct month, then day and then hours. Finally we exclude the rows based on starting and ending minutes knowledge. Lubridate functions are conveniently named and it is easy to figure which datetime unit specific functions return.

tweetdf$text = gsub("[[:punct:]]", "", tweetdf$text)
tweetdf$text = gsub("[[:digit:]]", "", tweetdf$text)

tweetdf$text <-  tolower(tweetdf$text)


pos <- scan('C:/data/positive-words.txt',
            what='character', comment.char=';')
neg <- scan('C:/data/negative-words.txt',
            what='character', comment.char=';')

tweetdf$score <- 0
for(i in 1:length(tweetdf$text)) {
 
  words = str_split(tweetdf$text[i], '\\s+')
  words = unlist(words)
  pos.matches = match(words, pos)
  neg.matches = match(words, neg)
  pos.matches = !is.na(pos.matches)
  neg.matches = !is.na(neg.matches)
  tweetdf$score[i] = sum(pos.matches) - sum(neg.matches)
}

This portion is much the same as in Jeffrey's example. Text-field is slightly cleaned, opinion lexicons are loaded and sentiment score is calculated by matching words used in the tweets to two opinion lexicons. To bring atleast some of my own flair, I did the scoring via a for-loop.

tweetdf$class[tweetdf$score < 0] <- "negative"
tweetdf$class[tweetdf$score == 0] <- "neutral"
tweetdf$class[tweetdf$score > 0] <- "positive"


x <- table(tweetdf$class)
x <- as.matrix(x)
y <- (x[3,]-x[1,])/colSums(x)
returnlist <- list(y, tweetdf)
return(returnlist)
}

In the final portion we first classify any sentiment scores below 0 as negative, above 0 as positive and those exactly 0 as neutral. This is done via the somewhat unintuitive base R syntax.

Next we calculate an index which I call the "positivity index". It is one simple answer to the problem of presenting classified data in a simple, numeric format to gauge at the general feeling. It can get values from -1 (all tweets classified as "negative" to 1 (all tweets classified as "positive"), with 0 possibly meaning both "all tweets classified as neutral" or "amount of tweets classified as negative equals the amount of tweets classified as positive". The index has a tendency to hover near zero just because of the latter quality but it still serves a purpose of quantifying classification data.

Without explicitly returning the dataframe or other resulting temporary help objects the function works as a "black box", with all the resulting objects vanishing into the thin air. This is not always desirable as we might want to check out the raw data or processed data from different phases of the function, especially in testing phase. In this case we might want to see individual examples of classification, to gauge at the quality of our algorithm.

So, I want to return the dataframe with tweets classified into either positive, neutral or negative. But I also want the positivity index already calculated for me inside the function. This means that I want to return two objects. In R, if we want to return more than one object, we need to use a list. This is why we save the positivity index to vector y and save that along with tweetdf to returnlist, which we pass to return-function. This makes the function to return a list, with first slot occupied by the positivity index and second the data frame with all the tweets classified. When calling the function, we should want to save the results to an object as well.

Ok, now we have a new toy to play with. Let's try it out! We pass to the function call the parameters user, the amount of tweets we collect, and the date-parameters to limit the final dataframe to be analysed to tweets made during and soon after the match.

results <- tweetsentiment("@arsenal",500,26,12,19,23,45,45)

results2 <- tweetsentiment("@southamptonfc",500,26,12,19,23,45,45)

We begin with the most surprising result of the match day, Southampton's 4-0 trashing of title contenders Arsenal. As a team looking to leapfrog Leicester to pole position, having your hopes crushed by such a rubbing must result in some pretty negative tweets, right?

results[1] 

0.1428571 

results2[1]

0.2909091 

Nooot exactly. Arsenal's official twitter account receives a positivity index of 0.14, as opposed to 0.29 of Southampton's. Southampton's official tweeter is obviously more thrilled but still Arsenal manages to be surprisingly positive. This means that our very simple and naive sentiment classifier doesn't quite work up to 100 % accuracy and that the official Twitter accounts are not exactly the forum to vent the frustration.


Lets try it out the second time:

results <- tweetsentiment("@manutd",500,26,12,12,16,45,45)

results2 <- tweetsentiment("@stokecity",500,26,12,12,16,45,45) 

Manchester United slumped to another defeat at the hands of Stoke City, resulting in the most successive defeats in over 40 years. This put Louis van Gaal's position as the manager on a very insecure footing and sacking can be thought to be coming in the very near future. Manchester United should then omit little positive signals while Stoke should celebrate the defeat of the fallen giant of English football. 

results[1] 
0.03703704 

results2[1] 
0.1935484

 Again, we notice a clear difference in sentiments. Manchester United is overall nearly neutral while Stoke's positivity index is a solid 0.19. Not quite the ecstasy exhibited by Southampton but pretty high still.

Overall, based on this small sample, we can be reasonably satisfied with our effort. Our naive classifier seems to find a signal amid all the noise and meaningless football jargon. And our function possessess enough flexibility to allow quick analysis of match and post-match tweets by certain users. And it would be reasonably simple to add another parameter to the function to control an if-else statement, which could then be used to control whether we want the download the tweets of specific user or search for a specific keyword.

Deducing US presidential candidates' core demography with Facebook activists first names

In this blog post we will first gather data from Facebook and use that data to perform a simple comparison wordcloud. The end goal is to make simple inference on the demography of American presidential candidates support base. Names are not just words but they also carry information. Most obviously you can deduce the person's gender with reasonable confidence and his/her ethnicity with tolerable accuracy. It also carries a highly unreliable indication of it's carrier's age (some names are more common in certain era than others).

First, we begin by loading the required R libraries.

library(Rfacebook)
library(dplyr)
library(wordcloud)
library(tm)
library(RColorBrewer)

Rfacebook is used to access Facebook API and you can read a tutorial on setting it up for example here. Dplyr is the must-have package for data wrangling, making the horrendously unintuitive subsetting tasks of base R much more bearable and also introducing the neat pipe operator %>% which connects numerous operations called on data together, making your R code cleaner and more efficient.

Wordcloud is used for visualizing the, well, final wordcloud and RColorBrewer to give the plot a bit nicer visual look (as you can see from this blog I may not the be the most visually competent person). Tm is a package used for text mining and is used to create the term matrix to feed the comparison.cloud-function. Ok, let's begin!

load("fb_oauth") 

pages <- c("DonaldTrump","hillaryclinton") 

df <- data.frame()
for (i in 1:length(pages)) {
  temp <- getPage(pages[i], token=fb_oauth, n=30) 
  temp2 <- temp$id 
  helpframe <- data.frame()
 
  for (j in 1:length(temp2))  {
    post <- getPost(temp2[j],token=fb_oauth)
    id <- post$likes$from_id
    name <- post$likes$from_name
    likesdf <- data.frame(name,id,stringsAsFactors=FALSE)
    likes <- likesdf$likesname
    name <- post$comments$from_name
    id <- post$comments$from_id
    comsdf <- data.frame(name, id,stringsAsFactors=FALSE)
    alldf <- rbind(likesdf, comsdf)
    helpframe <- rbind(helpframe, alldf,stringsAsFactors=FALSE)
  }
  helpframe <- unique(helpframe)
  fullname <- helpframe$name
  candidate <- pages[i]
  candidate <- rep(candidate,length(fullname))
  helpdf <- data.frame(fullname, candidate,stringsAsFactors=FALSE)
  df <- rbind(df,helpdf,stringsAsFactors=FALSE)
}

Let's look a little closer what that code does. For preparations, first we load up the fb-authentication token I have saved earlier, as in the RFacebook-tutorial. Then we save the public Facebook pages I am interested in a vector called pages. I limited this blogpost to just the Hillary Clinton (who's deadset to win the democratic primary) and Donald Trump (who despite his strong showing in the polls remains a long-shot to actually win the Republican race) Finally we initialize the empty dataframe df for storing the data.

What follows is a nested loop. We use getPage-function from RFacebook to get page data for ith member of earlier initialized pages vector using the fb_oauth. N limits the amount of posts we collect from the page so in this example we get 30 latest posts from each page. We save this all in a dataframe called temp.

However, what we are really interested in is the details of the likes and comments found under the posts published on the page. For that we collect post id's from results of getPage and store them in temp2, also initializing helpframe for storing data in the phase. The second loop uses temp2 as input for getPost-function, much like pages was for getPage. What follows is getting the userID and username for likes and comments respectively. The rest is all about creating a succession of data frames to eventually collect all the userIDs and usernames from all the posts stored in temp2 to helpframe. After all likers and commenters under the page posts are collected, we leave the inner loop and go back to outer loop.

Here we use unique-function to select distinct username-userID pairs (the reason we collected id in the first place, calling unique on username alone might have dropped few unintentional doubles). After unique we no longer have any use for the id-variable so we select only the variable username to a vector called fullname. To accompany name information in our final dataframe, we create the variable candidate to give us a clue which presidential nominee's post said person had liked/commented on Facebook. We do this by using the page name from our pages vector and repeating it for the number of unique persons we collected in the inner loop. Finally, we store these two vectors in helpdf which we combine with our initially empty df to collect the data from all the iterations of the loop in a single data frame.

df$firstname <- word(df$fullname)


vectorofvectors <- list()
for (i in 1:length(pages)) {
 vector  <- df  %>% filter(grepl(pages[i],candidate))  %>% select(firstname)
 vector <- vector$firstname
  vectorofvectors[[i]] <- vector
  }


mycorpus <- Corpus(VectorSource(vectorofvectors))
mytdm <- TermDocumentMatrix(mycorpus)
mymatrix <- as.matrix(mytdm)
colnames(mymatrix) <- pages
comparison.cloud(mymatrix,colors=brewer.pal(6,"Dark2"),title.size=1,random.order = FALSE)

Now we have finally gathered the data from Facebook using a little nested for-loop. Next we use word-function to split the first name from the full name (we make the assumption that people usually put their first name, well, first in Facebook) and save it as third column of the dataframe df.

What we do next felt somewhat unintuitive and there must be a cleaner way to accomplish the task. Nevertheless, the idea behind the code was following:

First we initialize an empty list vectorofvectors to store name-data in vector format. This is because I want to use corpus-related functions from the tm package and want as many documents in my corpus as there are presidential nominees in pages. We use a little for-loop filter the rows where value of candidate equals the i:th value in pages. %>% - pipe operator is used to connect two operations, filter and select, from dplyr-package together in a nice and clean way, used on dataframe df. We turn the resulting one-column dataframe to more appropriate vector and store that in the list at i:th slot.

Finally we read the list into a corpus, turn the corpus to a term-document-matrix, and the term-document-matrix to a normal matrix. Before finally calling the comparison.cloud-function to visualize differences in the first names of the selected presidential nominees, we name the matrix columns to know which portion of the cloud belongs to which nominee. In the comparison.cloud-call, note the colors=brewer.pal-portion in which use colour palette from RColorBrewer to give some nicer visuals to the resulting plot.

And finally, we can enjoy the fruits of our labour:

Two things spring immediately to mind from the comparison cloud. First we notice that the Trump portion of the cloud is more crowded than the Clinton part. Trump did lead in the number of unique likers/commenters in our sample by almost 4000 people, 20 990 to Hillary's 17 151. But we could also deduce that the variability in the names of Trump supporters is smaller and thus they get a proportionally bigger share of the resulting pie, which holds only so many names (cloud collects names from the entire matrix, not for each column individually).

Secondly we see that Trump supporters seem to possess mostly male, Anglo-sounding names (John, James, Michael) whereas Hillary's supporters names are more feminine and ethnically diverse (Sarah, Jose, Mohammed).

I'd reckon most surveys would find the demographics of two nominee's supporters broadly in line with the above, simplistic deduction.