Exercise from Case Study I
Christopher Manzano
We are going to determine if a comment is in favor or against of the death penalty on Spain. For this purpose we are going to use the twits dataset provided on this case study. It contains many tweets regarding this matter.
Dataset
The dataset contains two features:
| Variable | Description |
|---|---|
| Text | The content of the tweet |
| Category | In FAVOR or AGAINST the death penalty |
tweets <- read.csv("twits.csv", sep = ';')
str(tweets)## 'data.frame': 730 obs. of 2 variables:
## $ Text : chr "Mientras sigamos con la doctrina Zaffaroni y el ejecutivo no tenga huevos para promover pena de muerte y tolerancia 0 seguir\x8 "\x9311 Legisladores han dado luz verde para llevar al Pleno de propuesta de pena de muerte, eso ya es n\xfamero alto\x85" "\xbf\xbf\xbf\xbfLa gente que pide la reinstauraci\xf3n de la pena de muerte tiene alguna noci\xf3n sobre derechos humanos?????" "siempre estuve contra la la pena de muerte hasta que aparecio macri" ...
## $ Category: chr "FAVOR" "FAVOR" "AGAINST" "FAVOR" ...After reading the dataset I encountered a problem. I was not able to read the file with the correct encoding. Thus I had to convert the dataset into another one with utf-8 encoding. I used libre office calc to do this. The resulting dataset is called tweets.csv
tweets <- read.csv("tweets.csv")
str(tweets)## 'data.frame': 730 obs. of 2 variables:
## $ Text : chr "Mientras sigamos con la doctrina Zaffaroni y el ejecutivo no tenga huevos para promover pena de muerte y tolerancia 0 seguir…" "“11 Legisladores han dado luz verde para llevar al Pleno de propuesta de pena de muerte, eso ya es número alto…" "¿¿¿¿La gente que pide la reinstauración de la pena de muerte tiene alguna noción sobre derechos humanos?????" "siempre estuve contra la la pena de muerte hasta que aparecio macri" ...
## $ Category: chr "FAVOR" "FAVOR" "AGAINST" "FAVOR" ...attach(tweets)Feature Engineering
We are going to use the library tm to process the corpus of our data
library(tm)## Loading required package: NLPcorpus_original <- Corpus(VectorSource(Text))
corpus <- corpus_originaltransformation <- function(s)
{
s <- tolower(s)
s <- removeNumbers(s)
s <- removePunctuation(s)
return(s)
}
corpus <- tm_map(corpus, transformation)Now we are going to remove some stopwords.
stopwords("es")[1:10]## [1] "de" "la" "que" "el" "en" "y" "a" "los" "del" "se"transformation2 <- function(s)
{
s <- transformation(s)
s <- removeWords(s, stopwords("es")[1:(length(stopwords("es")) - 20)])
s <- stripWhitespace(s)
return(s)
}
corpus <- Corpus(VectorSource(Text))
corpus <- tm_map(corpus, transformation2)
corpus_vectorized <- tm_map(corpus, strsplit, " ")
corpus_vectorized$content[1:5]## [[1]]
## [1] "mientras" "sigamos" "doctrina" "zaffaroni" "ejecutivo"
## [6] "huevos" "promover" "pena" "muerte" "tolerancia"
## [11] "seguir…"
##
## [[2]]
## [1] "“" "legisladores" "dado" "luz" "verde"
## [6] "llevar" "pleno" "propuesta" "pena" "muerte"
## [11] "número" "alto…"
##
## [[3]]
## [1] "¿¿¿¿" "gente" "pide" "reinstauración"
## [5] "pena" "muerte" "alguna" "noción"
## [9] "derechos" "humanos"
##
## [[4]]
## [1] "siempre" "pena" "muerte" "aparecio" "macri"
##
## [[5]]
## [1] "" "puede" "ser" "racista" "mierda" "pedir"
## [7] "pena" "muerte" "antorcha" "mano" "llamen" "facha"After seeing this results we luckyly discoverd two things:
- The function removePunctuation only works with the English punctuation signs.
- In contrast with the English language, spanish language have the precence of tildes.
We need to remove also the punctuation signs which do not belong to English but do not belong to Spanish. I found out on this site that we should remove the "¿", "…" and "¡" signs.
In addition, we also have to take into account that most of the people tweets not taking into account the tildes. Therefore I suppose that there will be examples where the tildes appear, and where they do not. Theferore we are going to remove all the tildes.
library(stringr)
transformation3 <- function(s)
{
s <- transformation2(s)
s <- str_remove(s, "¡")
s <- str_remove(s, "¿")
s <- str_remove(s, "…")
s <- str_replace(s, "á", "a")
s <- str_replace(s, "é", "e")
s <- str_replace(s, "í", "i")
s <- str_replace(s, "ó", "o")
s <- str_replace(s, "ú", "u")
s <- str_replace(s, "Á", "a")
s <- str_replace(s, "É", "e")
s <- str_replace(s, "Í", "i")
s <- str_replace(s, "Ó", "o")
s <- str_replace(s, "Ú", "u")
return(s)
}
corpus <- tm_map(corpus_original, transformation3)
corpus_vectorized <- tm_map(corpus, strsplit, " ")
corpus_vectorized$content[1:5]## [[1]]
## [1] "mientras" "sigamos" "doctrina" "zaffaroni" "ejecutivo"
## [6] "huevos" "promover" "pena" "muerte" "tolerancia"
## [11] "seguir"
##
## [[2]]
## [1] "“" "legisladores" "dado" "luz" "verde"
## [6] "llevar" "pleno" "propuesta" "pena" "muerte"
## [11] "numero" "alto"
##
## [[3]]
## [1] "¿¿¿" "gente" "pide" "reinstauracion"
## [5] "pena" "muerte" "alguna" "noción"
## [9] "derechos" "humanos"
##
## [[4]]
## [1] "siempre" "pena" "muerte" "aparecio" "macri"
##
## [[5]]
## [1] "" "puede" "ser" "racista" "mierda" "pedir"
## [7] "pena" "muerte" "antorcha" "mano" "llamen" "facha"We got some interesting results:
- Also the
"“"character was not removed. - Thre may ve some empty components of the form
"". - Finally, there are substrings such as
"?????"that for any reason are not being removed.
This makes me think that I will not be able to detect all of these issues. Have I covered the substring"????" or "“"? I do not know. Should I cover it? I do not know neither… It may not be worth it. Thus, I will not fix the last issue.
transformation4 <- function(s)
{
s <- transformation3(s)
s <- str_remove(s, "¿¿¿")
s <- str_remove(s, '“')
s <- stripWhitespace(s)
}
corpus <- tm_map(corpus_original, transformation4)
corpus_vectorized <- tm_map(corpus, strsplit, split=" ")
corpus_vectorized$content[1:10]## [[1]]
## [1] "mientras" "sigamos" "doctrina" "zaffaroni" "ejecutivo"
## [6] "huevos" "promover" "pena" "muerte" "tolerancia"
## [11] "seguir"
##
## [[2]]
## [1] "" "legisladores" "dado" "luz" "verde"
## [6] "llevar" "pleno" "propuesta" "pena" "muerte"
## [11] "numero" "alto"
##
## [[3]]
## [1] "" "gente" "pide" "reinstauracion"
## [5] "pena" "muerte" "alguna" "noción"
## [9] "derechos" "humanos"
##
## [[4]]
## [1] "siempre" "pena" "muerte" "aparecio" "macri"
##
## [[5]]
## [1] "" "puede" "ser" "racista" "mierda" "pedir"
## [7] "pena" "muerte" "antorcha" "mano" "llamen" "facha"
##
## [[6]]
## [1] "" "sistema" "sistema" "favororito"
## [5] "gringo" "pena" "muerte" "tambien"
## [9] "usan" "diversos" "metodos" "admiras"
## [13] "dices" "firman" "ordenes" "ejecutivas"
## [17] "asesinatos" "selectivos" "ciudadanos" "gringos"
## [21] "nacionalidades" "cualquiera" "parte" "mundo"
##
## [[7]]
## [1] "" "dia" "aprueben" "pena" "muerte" "voy" "ser"
## [8] "tan" "feliz"
##
## [[8]]
## [1] "si" "legalizan" "aborto" "q" "legalicen" "pena"
## [7] "muerte" "si" "vamos" "matar" "inocentes" "q"
## [13] "podido" "hacer" "matemos"
##
## [[9]]
## [1] "" "pais" "necesita" "pena" "muerte" "sistema" "judicial"
## [8] "cague" "si"
##
## [[10]]
## [1] "piden" "pena" "muerte" "asesino"
## [5] "instituto" "floridacreeis" "pena" "muerte"
## [9] "eeuu" "hecho" "descender"Finally we seem to make progress
Data analysis
corpus <- tm_map(corpus_original, transformation4)library(wordcloud)## Loading required package: RColorBrewerwordcloud(corpus)
We are going to ceck the most frequent words.
in_favor <- which(Category == "FAVOR")
against <- which(Category == "AGAINST")
wordcloud(corpus[in_favor], max.words = 100)
wordcloud(corpus[against], max.words = 100)
We can see that the words “pena” and “muerte” are common in both cases. They will not give us any clue to classify a whether a tweet is against or in favor. Thus we are going to remove these words.
transformation5 <- function(s)
{
s <- transformation4(s)
s <- str_remove(s, "pena")
s <- str_remove(s, "muerte")
}
corpus <- tm_map(corpus_original, transformation5)
in_favor <- which(Category == "FAVOR")
against <- which(Category == "AGAINST")
wordcloud(corpus[in_favor], max.words = 100)
wordcloud(corpus[against], max.words = 100)
To be honest I do not get why the wods muerte and pena still appear. However they are not that frequent now. We can say that we removed some noise from our data.
Classifier
First of all we need to convert our corpus to a matrix with words as elements.
data_sparse <- DocumentTermMatrix(corpus)
inspect(data_sparse)## <<DocumentTermMatrix (documents: 730, terms: 1780)>>
## Non-/sparse entries: 6403/1292997
## Sparsity : 100%
## Maximal term length: 29
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs aborto asesinos gente niños ojo pena perpetua pide puede ser
## 154 1 1 0 0 0 1 0 0 0 0
## 155 0 0 1 0 0 0 0 0 0 0
## 210 0 0 1 0 0 0 0 0 0 0
## 238 0 1 0 0 0 0 0 0 1 0
## 300 0 0 0 0 0 0 0 0 0 0
## 35 1 0 0 0 0 1 1 0 0 0
## 357 0 0 0 0 0 1 0 0 1 0
## 484 0 0 0 0 0 1 0 0 0 0
## 543 1 0 0 0 0 0 0 0 0 1
## 612 0 0 1 0 0 0 0 0 0 0We will use 5 fold cross validation as validation strategy.
set.seed(0)
folds <- sample(1:5, replace=T, data_sparse$nrow)We are going to use a naive bayes classifier. And we are going to tune some parameters:
- Number of words to take into account
- Prior distribution of the data
Frequent words
We are not gping to take into account all the words but a subset of the most frequent words.
min_freq <- 10
words <- findFreqTerms(data_sparse, min_freq)
words## [1] "mientras" "seguir"
## [3] "gente" "pide"
## [5] "antorcha" "facha"
## [7] "llamen" "mano"
## [9] "mierda" "pedir"
## [11] "puede" "racista"
## [13] "ser" "dia"
## [15] "tan" "aborto"
## [17] "hacer" "inocentes"
## [19] "legalicen" "legalizan"
## [21] "matar" "matemos"
## [23] "podido" "vamos"
## [25] "pais" "asesino"
## [27] "eeuu" "hecho"
## [29] "muerte" "pena"
## [31] "piden" "choros"
## [33] "cucuteño" "escondancomo"
## [35] "hicieron" "identificados"
## [37] "israelies" "manos"
## [39] "merece" "nazis"
## [41] "ojo" "plaza"
## [43] "plenamente" "publica"
## [45] "pueblo" "quiera"
## [47] "resto" "rojos"
## [49] "usurpador" "venezuelaexigejuicioamaduroya"
## [51] "creo" "niños"
## [53] "violadores" "trump"
## [55] "acuerdo" "cadena"
## [57] "perpetua" "decir"
## [59] "van" "años"
## [61] "españa" "solo"
## [63] "puta" "carcel"
## [65] "asesinos" "despues"
## [67] "vida" "elrepasadorpy"
## [69] "homosexuales" "lgtb"
## [71] "paises" "protestan"
## [73] "permanente" "prision"
## [75] "revisable" "delincuentes"
## [77] "gabriel" "pidiendo"
## [79] "militares" "politicos"
## [81] "argentina" "personas"
## [83] "asesinan" "asesinando"
## [85] "bombardeado" "explotadores"
## [87] "hambre" "numerosos"
## [89] "países" "antisistemas"
## [91] "autonomías" "dig"
## [93] "llenando" "peligrosos"
## [95] "regiones" "supresion"
## [97] "httpst" "dos"
## [99] "hijos" "debate"
## [101] "casos" "crees"
## [103] "deberia" "haber"
## [105] "claro" "favoror"
## [107] "mismo" "persona"
## [109] "diciendo" "solucion"
## [111] "colombia" "acusaron"
## [113] "dolores" "existido"
## [115] "imaginais" "legislar"
## [117] "vázquez" "gracias"
## [119] "merecen" "amarillismo"
## [121] "lumbreras" "againsttra"
## [123] "asi" "salga"
## [125] "ahora" "ojala"
## [127] "mas" "campaña"
## [129] "apoyan" "hacen"
## [131] "chofer" "hdp"
## [133] "aplicar" "seguro"
## [135] "molt"Naive Bayes tunning
convert_count <- function(x){
y <- ifelse(x > 0, 1,0)
y <- factor(y, levels=c(0,1), labels=c("No", "Yes"))
y
}We are going to use a gridsearch with cross-validation. In order to speed up things we are going to use the libraries foreach and doParallel which will allow us to parallelize the execution.
The execution code for the gridsearch is given in the following cells. We had to start the search by lookinng values among 0 and 10 for laplace smoothing and 1 and 31 in steps of 5 for the frequency. Then we had to search in a more accurate grid a couple of times. At the end we got somethig liek this:
library(e1071)
library(doParallel)## Loading required package: foreach## Loading required package: iterators## Loading required package: parallellibrary(foreach)
min_freq <- seq(0, 15,1)
laplace_smoothing <- seq(1, 2, 1)
ncores <- detectCores()
cluster <- makeCluster(ncores-3)
registerDoParallel(cluster)
accuracies <- foreach(freq=min_freq, .combine="cbind") %dopar% {
library(foreach)
library(tm)
Category <- tweets$Category
words <- tm::findFreqTerms(data_sparse, freq)
data <- tm::DocumentTermMatrix(corpus, control=list(dictionary=words))
data <- apply(data, 2, convert_count)
acc <- foreach::foreach(smoothing=laplace_smoothing, .combine="c") %do% {
a <- foreach::foreach(fold=1:5, .combine="c") %do% {
model <- e1071::naiveBayes(x=data[folds==fold,],
y=Category[folds==fold],
laplace=smoothing)
# Accuracy
sum(predict(model, data[folds!=fold,]) == Category[folds!=fold])/length(Category[folds!=fold])
}
mean(a)
}
}
stopCluster(cluster)We are going to analyze our results
library(plot.matrix)
rownames(accuracies) <- laplace_smoothing
colnames(accuracies) <- min_freq
accuracies## 0 1 2 3 4 5 6
## 1 0.6924629 0.6924629 0.7677475 0.7809116 0.7854282 0.7902170 0.7888691
## 2 0.6263379 0.6263379 0.6775839 0.7079144 0.7139075 0.7332283 0.7470585
## 7 8 9 10 11 12 13
## 1 0.7840193 0.7734036 0.7816671 0.7752108 0.7730921 0.7707274 0.7790398
## 2 0.7400738 0.7503068 0.7556412 0.7611671 0.7611498 0.7612007 0.7501186
## 14 15
## 1 0.7763665 0.7702320
## 2 0.7460997 0.7448194plot(accuracies, xlab="min_freq", ylab="laplace_smoothing")
There is not much difference for the min_frequency around 5. Therefore We will choose 2.
Conclusions
At the end we got an accuracy of 0.79 which is not bad. I can not wait to see if someone improves this score.
words <- findFreqTerms(data_sparse, 5)
data <- DocumentTermMatrix(corpus, control=list(dictionary=words))
data <- apply(data, 2, convert_count)
model <- naiveBayes(x=data,
y=Category,
laplace=1)We must say that not using a Bayesian approach (Laplace smoothing = 0) achieves a 0.8 of accuracy. However, I decided that the difference is not that big. And that the classifier can generalize better if it follows a bayesin approach.