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.