BEPS.Rmd

---
title: "British vote prediction 2002"
author: 
  - Mourad Abbou Aazaz
output:
  html_document: default
  pdf_document: default
---
\clearpage
\tableofcontents
\clearpage


```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
set.seed(1234)
```

# Introduction

In 2002 there was a survey which collected some information from people in the UK for the british elections in 2002. The information collected was stored in a data set called *BEPS* and registered data related to people's ideology, euroscepticism, opinion about certain candidates, etc. Having this information, our main target was to predict the candidate a person would vote if they gathered some of the opinions and ideology patterns. Thus, we made a statistical supervised learning analysis based on the data set we have in hand to study the influence and utility of each variable composing the dataset to predict the political party a person would vote.

# Data Set and Subsets

## Variables of the data set

The data set can be found using the `carData` library. 

```{r}
library(carData)
str(BEPS)
```

As we see, we have 10 different variables/predictors:

 * `vote`: This is the *output* we want to draw. It's a Factor variables which represent the three main political parties: Conservative, Liberal Democrat and Labour.
 * `age`: The age of each person surveyed.
 * `gender`: Each person's gender (Male or Female). 
 * `economic.cond.national`: This variable represents each person's knowledge of the national economy.
 * `economic.cond.household`: This variable represents each person's knowledge of families' household economy.
 * `Blair`: This variable represents each person's opinion about labourist candidate Blair.
 * `Hague`: This variable represents each person's opinion about conservative candidate Hague.
 * `Kennedy`: This variable represents each person's opinion about conservative candidate Kennedy.
 * `Europe`: This variable represents each person's euroscepticism. If a persons is very eurosceptic, the value will be 11. If is very pro-european, the value will be 0
 * `political.knowledge`: This variable represents each person's political knowledge.
 
## Data subsets

 The methodology to design a vote prediction model, following learning techniques, will be based on dividing the data set into two data subsets for training and testing, predictors analysis and several learning training algorithms trying to create the most reliable and accurate model. Our main target is to predict the **vote**, which is a factor variable and therefore our model must be a classification model.
 
Before starting to analyze the variables, we loaded the necessary libraries and create the subset partitions. 

```{r} 
library (reshape2)
library(lattice)
library(ggplot2)
library(caret)
library(mlbench)
library(e1071)
data(BEPS)      
BEPS.data.all <- BEPS
BEPS.data.outputs <- c("vote")
BEPS.data.inputs <- setdiff(names(BEPS.data.all), BEPS.data.outputs)
str(BEPS.data.inputs)
```

Now we have the following datasets:

* `BEPS.data.all` which represents the whole dataset.
* `BEPS.data.inputs` which contains all the values except the ones in the **vote** field.
* `BEPS.data.outputs` which contains the **vote** variable values.

We create a partition in which the 80% of the whole dataset will be used for training and the remaining 20% will be used for testing.

```{r}
train <-createDataPartition(BEPS.data.all[[BEPS.data.outputs]],p=0.8, list = FALSE, times = 1)
BEPS.data.all.80 <- BEPS.data.all[train,]
mask = sapply(BEPS.data.all.80, class) != "factor"
BEPS.data.all.20 <- BEPS.data.all[-train,]
BEPS.data.all.Train <- BEPS.data.all.80[,mask]
BEPS.data.all.Test <- BEPS.data.all[-train,]
BEPS.data.all.Test <- BEPS.data.all.Test[,mask]
output.values <- BEPS.data.all.80[[BEPS.data.outputs]]
```

The new subsets we created above are the following:

* `train` : The created partition. The 'p' value means the proportion and the argument `list = FALSE` se used so that the result can't be a list.
* `BEPS.data.all.80` : This subset will be used for training and it represents the 80% of the whole dataset.
* `BEPS.data.all.20` : This subset will be used for testing and it represents the 20% of the whole dataset.
* `BEPS.data.all.Train` : Training subset.
* `BEPS.data.all.Test` : Testing subset.
* `output.values` : Output values subset.

# Variable analysis


Varible analysis is an important part of data science because we measure the influence and utilty of each of every variable on prediction result. 

We first take a look at dataset summary>

```{r}
summary(BEPS)
```

As we can see, there are no null values, so null values tratement won't be necessary. Now, we would like to have a look at the votes proportion>

```{r}
barplot(table(BEPS$vote))
```

As we see, the majority of the people survey claimed they would vote for the Labor Party. Now it's time to see what type of person would one of these three candidates. 


## Factor typed variables

Our two factor variables are `gender` and `vote`, which represent the voter gender and favorite party. Now, if we look at the table below, we can see that most males and females would vote for the Labor Party. 


```{r}
table(BEPS$gender, BEPS$vote)
```

To have a better visualization, we plot a spineplot:

```{r}
spineplot(BEPS[,10] ~ BEPS[, 1], data=BEPS, main="Gender/vote ratio", xlab = "Candidate party", ylab = "Gender", col = c("pink", "skyblue"))
```

Focusing on people that would vote for conservatives, there are slightly more females and males voting for this party, but the difference between males and females is pretty weak. To check if there's any statistical difference, we will execute a `chiSquare`.

```{r}
chisq.test(table(BEPS$gender, BEPS$vote))
```


The `p-value` is greater than `0.05`, which means differences are statistically insignificant and both factors are independent. 


## Numerical variables


Now we are going to explore the numerical predictor and analyze each of everyone of them.

#### Age

In the image below we can see that the majority of young people and people between 35 and 40 would vote for the Labour Party, while the elders would vote for the Conservative Party. The Liberal Democrat Party is not very popular though some people who are between 20 and 25, and people between 45 and 50 would for them. 


```{r}
spineplot(BEPS[,1] ~ BEPS[,2], data=BEPS, main = "Age/Vote Ratio", xlab = "Ages of People Surveyed", ylab = "Vote", col = c("red", "blue","green"))
```


\hfill \break

#### Knowledge on National Economy (economic.cond.national)

This variable shows how aware people are of national economic situation, where value 1 means a person knows nothing and 5 means a person is very aware of national economy. Well, the histogram below shows that majority of people aware of the nacional economic conditions and situation would vote for the Labour Party while the least they know about, they're more likely to vote for conservatives. 

```{r}
ggplot(BEPS) + aes(x=as.numeric(economic.cond.national), group=vote, fill=vote) + 
geom_bar(position = "stack") +
  geom_histogram(binwidth=0.25) +
coord_trans() +
scale_fill_manual(values = c("skyblue", "brown1", "orange")) + 
theme_classic()
```


#### Knowledge on Domestic Economy (economic.cond.national)

Now we are going to evaluate people's knowledge on domestic economy.


```{r}
ggplot(BEPS) + aes(x=as.numeric(economic.cond.household), group=vote, fill=vote) + 
geom_bar(position = "stack") +
  geom_histogram(binwidth=0.25) +
coord_trans() +
scale_fill_manual(values = c("skyblue", "brown1", "orange")) + 
theme_classic()
```

We obtain similar results to the ones we drew on National Economy. Basicly, people who are aware of national economy situation, are also aware of domestic economy. 



\hfill \break


#### Conocimiento sobre política (political.knowledge) 

Now we'll look on people's political knowledge. 




```{r}
ggplot(BEPS) + aes(x=as.numeric(political.knowledge), group=vote, fill=vote) + 
geom_bar(position = "stack") +
  geom_histogram(binwidth=0.25) +
coord_trans() +
scale_fill_manual(values = c("skyblue", "brown1", "orange")) + 
theme_classic()
```

The results show us a funny thing. Most people who are aware of the economic situation would vote for Labour Party, but also people who have a low level of political knowledge do intend to vote for labor party. It would be interesting to study any correlation between people's economic awareness and their political knowledge. Meanwhile, as political knowledge grows, the vote intention is apparently more balanced.

\hfill \break

#### Europe

Now let's see the level of euroscepticism voters have. 

```{r}
spineplot(BEPS[,1] ~ BEPS[,8], data=BEPS, main = "Political affinity and euroscepticism", 
          xlab = "Euroscepticism scale", ylab = "Vote", col = c("skyblue", "brown1", "orange"))
```

The results are clear. The more eurosceptic people are, the more like they are to vote for the Conservative Party while pro-europeans would vote for Labour Party. 


\hfill \break

#### Blair

Let's focus on Blair Candidate. Blair was the leader of the Labour Party and candidate to Prime Minister in 2002. The `Blair` value shows the opinion people on Tony Blair, where value 1 represents the worst opinion and value 5 represents the best.


```{r}
ggplot(BEPS) + aes(x=as.numeric(Blair), group=vote, fill=vote) + 
geom_bar(position = "stack") +
  geom_histogram(binwidth=0.25) +
coord_trans() +
scale_fill_manual(values = c("skyblue", "brown1", "orange")) + 
theme_classic()
```

As expected, the better opinion people have on Blair, the more likely they are to vote for democrats. 


## Multivariable Analysis


From the  monovariable analysis we would draw some results such as age and euroscepticism may condition the vote. If a person is old and eurosceptic, that person may vote for Conservative. On the other side, if a person is young and aware of the economic situation, they would probably vote for Conservatives.  But we still can't properly know what variables are useless or have any correlation with another variables. It would be great if all variables had no correlation among each other. If so, it would be an obstacle for the training and accuracy error rate would rise. Therefore, it's necessary to calculate all correlation pairs, and if a correlation of *n* pairs of variables is above a certain threshold, then we would have to eliminate the one having the high absolute average value of correlation with the other variables.

If we have a look at the correlation table.

```{r}
cor(BEPS[,2:9])
```

When a correlation value between two variables is close to zero o negative, it means those two variable are not correlated, as we can see, for instance ,in the table above with variable `Kennedy` and `political.knowledge`. 

We plot the correlation table:

```{r}
corrplot::corrplot(cor(BEPS[,2:9]))
```

If we have a look at the variables `economic.cond.national`. `economic.cond.household` and `Blair` have a certain correlation. If we have a look at the three of them.


```{r}
par(mfrow=c(3,1))
dens<- density (BEPS$economic.cond.household,na.rm=T)
hist(BEPS$economic.cond.household, xlab="", main = "Percepción de la economía doméstica",
     ylim= c (0, max (dens $ y) * 1.2),probability=T)
lines(dens)

dens<- density (BEPS$economic.cond.national,na.rm=T)
hist(BEPS$economic.cond.national, xlab="", main = "Percepción de la economía nacional",
     ylim= c (0, max (dens $ y) * 1.1),probability=T)
lines(dens)

dens<- density (BEPS$economic.cond.national,na.rm=T)
hist(BEPS$Blair, xlab="", main = "Blair", ylim= c (0, max (dens$y)*1.1),probability=T)
lines(dens)

```

The charts show the density and values of the three variables are similar. `Blair` has the least correlation value with the rest of the other two variables, and thus we would remove the `economic.cond.national` and `economic.cond.household` variables.  

\hfill \break


# Preprocess and Data Cleansing


In this section we clean the usesless data so we can avoid noise that could difficult the training. As we saw, the variables `economic.cond.national` and `economic.cond.household` are considerably correlated, so we will remove them from the dataset. We will also remove non numerical variables, such us gender.


```{r}
BEPS.data.all.Train$gender = NULL
BEPS.data.all.Train$economic.cond.national = NULL
BEPS.data.all.Train$economic.cond.household = NULL
```

We check there are no null values

```{r}
sum(is.na(BEPS.data.all.Train))
```


## Outliers

There might be extreme values, within the dataset, which coud be greater than 3/2 interquartile distance called outliers. To check if there are outliers, we plot a boxplot of all the variables. 


```{r}
boxplot(BEPS.data.all.Train, col=rainbow(4, s = 0.5))
```

As we see, there's no evidence of outiliers and then it's not necessary to execute any outlier treatment. 


##  Removing unnecessary variables in the testing dataset

```{r}
BEPS.data.all.Test$economic.cond.national = NULL
BEPS.data.all.Test$economic.cond.household = NULL
```

\hfill \break

# Predicting variables influence on vote

After treating our variables and removing the unnecessary ones, we neaded to know what were the ones which could influence on vote. Therefore, we'll execute a logistic regression to what coefficients are favourable to better predict a type of vote or another. 

## Logistic Regression

Our main target in this section is to observe the cofficient variable influence on vote. We will implement a logistic regression model because, unlike linear regression, this tecnique is used to predict binary coefficients. The function `glm()` creates a **generalized linear model**. Using the argument `family=binomial` Rstudio will execute a logistic regression. However, there's a problem. Logistic Regression is used only for binary results. We have three different values or *outputs* and, thus, we must execute three logistic regressions in which we compare each vote value with the rest. 

### Liberal Democrats vs Non-Liberal Democrats

To measure the predictors coefficients we have created a set called `liberals` which contains all the votes values contained in the `BEPS` dataset.

```{r}
liberals = as.character(BEPS.data.all.80$vote)
liberals[BEPS.data.all.80$vote != "Liberal Democrat"] = "Non-Liberal"
liberals <- as.factor(liberals)
```

We use the `contrasts()` to create a `dummy` version for the `liberals` values.

```{r}
contrasts(liberals)
```

Having created dummy variables, if a coefficient was negative, it means that coefficent positively influences the liberal vote. 

\hfill \break

Now we execute the logistic regression. 

```{r}
reg.log.lib=glm(liberals~., family=binomial(link = "logit"), data=BEPS.data.all.Train)
summary(reg.log.lib)
```


If we look only at the coefficients:

```{r}
coef(reg.log.lib)
```

Observations we can draw here are:

* Except the variable `age`, the rest of `p-values` are too small, which means results are good.
* The only negative values are the `Kennedy` and `political.knowledge` ones, which means, as opinion about Kennedy improves and political knowledge grow, the probability to vote for democrats rises. * As the rest of coefficients values rise, the probability of voting for democrat decreases. 

### Conservatives vs Non-Conservatives

```{r}
conservatives = as.character(BEPS.data.all.80$vote)
conservatives[BEPS.data.all.80$vote != "Conservative"] = "Non-Conservative"
conservatives <- as.factor(conservatives)
```

We establish de `dummy` variables.

```{r}
contrasts(conservatives)
```

We execute our logistic model.

```{r}
reg.log.con=glm(conservatives~., family=binomial(link = "logit"), data=BEPS.data.all.Train)
summary(reg.log.con)
```


```{r}
coef(reg.log.con)
```


The observations we can draw are:

* The `Blair` and `Kennedy` have a negative impact on Conservative vote.
* The rest have a good influence on the conservative vote election. 
* `p-values` are small, which means results quality is good. 


### Laborists vs Non-Laborists


```{r}
laborists = as.character(BEPS.data.all.80$vote)
laborists[BEPS.data.all.80$vote != "Labour"] = "Non-Labour"
laborists <- as.factor(laborists)
contrasts(laborists)
```

We execute our regression model. 

```{r}
reg.log.lab=glm(laborists~., family=binomial(link = "logit"), data=BEPS.data.all.Train)
summary(reg.log.lab)
```


```{r}
coef(reg.log.lab)
```


The only predictor that could positively influence on Labour Vote was `Blair`. The rest, as they increase, they have a negative impact on Labour vote.  


### Conclusions 

After executing a logistic regression for each vote value, the general conclusion we can extract are the following:

* **Conservatives**: People who vote for conservatives are people who have a good opinion on `Hague` candidate, they are eurosceptic and have certain political knowledge.
* **Laborists**: They're more likely to be chosen by people who are young or have a good opinion on `Blair`.
* **Liberals**: They're more likely to be chosen by people who have a good opinion on `Kennedy`. 

\clearpage



# Machine Learning training models

Now we are going to use some Machine Learning models offered by `Caret` Library in RStudio. The three tecniques we will use are:

* **K-nearest neighbors**: This simple classification tecnique classifies an element based on the `k` neighbours previously classified. 
* **Support Vector Machine**: The Support Vector Machine algorithm is an autom'atic learning technique which consists on building a hyperplane in a high dimensionality space which separates the classes we have.
* **Random Forests**: It's a predictive algorithm which uses a *Bagging* technique that combines different trees, where each tree is created by observations and random variables. 


To validate our models, we are going to use a 10-Fold repeated cross-validation using the command `trainControl`.

```{r}
beps.trainCtrl <- trainControl(
  method = "repeatedcv",
  number = 5,
  repeats = 5,
  verboseIter = F,
)
```


## K-Nearest Neighbors (KNN)  Model

To build a propoer `KNN` model, we must apply a normalization and re-scale all the variables so that distances can be comparable. This process is called *Data standarization* and reason is because each variable has a different measure and it would be incorrect to use the same measures for all different type variables and could disturb the prediction results. 

```{r}
center.scale <- preProcess(BEPS.data.all.Train, method = c("scale", "center"))
BEPS.data.all.Train.scale <- predict(center.scale, BEPS.data.all.Train)
```

`BEPS.data.all.Train.scale` represents the normalized and scaled training set. 

If we have a look at KNN hyperparameters:

```{r}
modelLookup("knn")
```

There's only one parameters which represents the number of nearest neighbours. 

```{r}
knn.grid <- expand.grid(k=c(40,60,80,100,150))
beps.knn.model <- train(BEPS.data.all.Train.scale, output.values, 
                         method="knn", trControl=beps.trainCtrl, tuneGrid=knn.grid)
beps.knn.model
``` 

If we focus on the best tune: 

```{r}
knn.k <- beps.knn.model$bestTune
knn.k$k
```

We see that the best number of neighbour is `80`.

\clearpage

## Support Vector Machine Model

SVM model, just like KNN, needs to manage normalized and re-scaled data.

If we look at its hyperparameters:

```{r}
modelLookup(model="svmRadial")
```

We create two vectors, one containing the sigma values and another containing the cost values

```{r}
svm.grid <- expand.grid(sigma = c(0.01, .015, 0.2), C = c(1.5, 1.75, 2.0, 2.25, 2.5, 3.0))
beps.svm.model <- train(BEPS.data.all.Train.scale, output.values, method = "svmRadial", 
                         tuneGrid = svm.grid, trControl = beps.trainCtrl)
svm.sigma <- beps.svm.model$bestTune$sigma
svm.C <- beps.svm.model$bestTune$C
beps.svm.model
```

As we see, the best hyperparameter values are `sigma=0.015` and `C=3`

\clearpage

## Random Forests Model

```{r}
modelLookup("rf")
```

The hyperparameter `mtry` represents the number of random variables marked as candidates for each branch. 

```{r}
rf.grid <- expand.grid(mtry=c(1,2,3,4))
beps.rf.model <- train(BEPS.data.all.Train, output.values, method="rf", tuneGrid=rf.grid, trControl=beps.trainCtrl, verbose=F)
beps.rf.model
```

If we have a look at the `mtry` influence, we see that the best `mtry` value is 1 

```{r}
plot(beps.rf.model, col = "blue")
```



\clearpage


# Comparing models obtained

After training the chosen models, it's necessary to  validate and  make a comparison of each of them. First of all, we will train again the models but using only their best hyperparameters

```{r}
rf.grid <- expand.grid(mtry=c(1))
beps.rf.model <- train(BEPS.data.all.Train, output.values, method="rf", 
                        tuneGrid=rf.grid, trControl=beps.trainCtrl, verbose=F)

svm.grid <- expand.grid(sigma = svm.sigma, C = svm.C)
beps.svm.model <- train(BEPS.data.all.Train.scale, output.values, method = "svmRadial",
                         tuneGrid = svm.grid, trControl = beps.trainCtrl)

knn.grid <- expand.grid(k=c(knn.k$k))
beps.knn.model <- train(BEPS.data.all.Train.scale, output.values, method="knn", 
                        trControl=beps.trainCtrl, tuneGrid=knn.grid)

```

## Comparing models

After training the chosen models, it's necessary to  validate and  make a comparison of each of them. 

```{r}
set.seed(1234)
model.list <- list(
  SVM.MODEL=beps.svm.model,
  RF.MODEL=beps.rf.model,
  KNN.MODEL=beps.knn.model
)
beps.resamples <- resamples(model.list)
```


The function `resamples` groups the 30 permutes for each algorithm. The function `summary` helps us make a summary of  `Acuraccy` and  `Kappa` values.

```{r}
summary(beps.resamples)
```

\hfill \break

```{r}
bwplot(beps.resamples)
```


Apparently, we cant draw any conclusion of the optimal model among the three of them for our predictions due to the `Accuracy` and `Kappa` overlapping values and both variables have a similar behaviour. As for the `Kappa` variable, it is said that if its value is between `0.4` and `0.75`, then it's a good value and it can help us if the `Accuracy` variable can have problemas with unbalanced classes. 

\hfill \break


# Testing and validation

As we saw the comparison table, we could tell all models have a similar average and median. Now, we are going to execute a prediction using the testing dataset  `BEPS.data.all.20`. 


```{r}
BEPS.data.all.20$vote = as.factor(BEPS.data.all.20$vote)
BEPS.data.all.test.scale <- predict(center.scale, BEPS.data.all.Test)
preds.rf <- predict(beps.rf.model, newdata = BEPS.data.all.Test)
preds.knn <- predict(beps.knn.model, newdata = BEPS.data.all.test.scale)
preds.svm <- predict(beps.svm.model, newdata = BEPS.data.all.test.scale)
```

After performing our predictions using the testing dataset, we proceed to observe the results. We use the `postResample()` function, which calculates the `MSE` and the `R-squared` and draws an `Accuracy` and `Kappa` estimate.  

```{r}
result.svm <- postResample(preds.svm, BEPS.data.all.20$vote)
result.knn <- postResample(preds.knn, BEPS.data.all.20$vote)
result.rf <-  postResample(preds.rf, BEPS.data.all.20$vote)
```

\hfill \break

SVM:
```{r}
result.svm
```

KNN:
```{r}
result.knn
```

RF:
```{r}
result.rf
```

The result of the testing doesn't seem very significant due to it's  mere informative data and it's not a vital value. We should repeat the same experiment several times to have an opinion and a significant response that could show clear differences between different models. Whatsmore, we've seen that in the previous section that comparison results overlap each other. However, **KNN** seems to show a slightly better accuracy result. If we have a look at confussion matrix using this model:

```{r}
caret::confusionMatrix(preds.svm, BEPS.data.all.20$vote)
```

The model has a good predition of the Labour and conservative vote, but a has a bad prediction of the Liberal vote. Our dataset is very small and we may need more tecniques and exemplar to search for a good model.