1 - Train & Test.Rmd

---
title: "1 - Train & Test"
author: '100385774'
date: "2023-04-27"
output: html_document
---

# Data opening and pre-processing

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

```{r warning=FALSE, include=FALSE}
library(tidyverse)
library(data.table)
library(ggplot2)
library(stringr)
library(openxlsx)
library(lubridate)
library(emo)
library(stopwords)
library(tidytext)
library(caret)
library(textrecipes)
library(SnowballC)
library(rsample)
library(quanteda)
```

```{r}

df <- read.xlsx("data/annotationbis.xlsx")
df <- df %>% mutate(
  hate = case_when(hate == 0 ~ "No", 
                   hate == 1 ~ "Yes"),
  hate = factor(hate, levels = c("No", "Yes"))
)

annotation_b <- read.delim("data/HaterNet.txt", sep = ";", col.names = c("id", "X1", "text", "X2", "hate")) %>% 
  select(-c(X1, X2))

annotation_c <- read.delim("data/hateval/hateval2019_es_train.csv", sep = ",") %>% 
  select(-c(TR, AG)) %>% 
  rename(hate = HS) 

table(df$hate)
```


## Noise removal (bots), Boolean mention and URL presence, Boolean terms presence, lower casing, time conversion: 

```{r}
df <- df %>% 
  distinct(text, .keep_all = T) %>% 
  mutate(text = tolower(text),
         entities.mentions = ifelse(str_detect(text, "@.{1,15} "), 1, 0),
         entities.url = ifelse(str_detect(text, "https://.*\\b"), 1, 0),
         #text = str_replace_all(text, "[^[:alnum:]]", ""),
         text = str_remove_all(text, "https://.*\\b"),
         hateterm = str_detect(text, "(?:^|\\s)moros?\\b|(?:^|\\s)maric[oó]na?e?s?\\b|(?:^|\\s)monos?\\b|(?:^|\\s)putas?\\b|(?:^|\\s)hijos? de puta\\b|(?:^|\\s)hijos?deputa|(?:^|\\s)zorras?\\b|(?:^|\\s)panchitos?\\b"))

```

## Emojis and laughs tokenization: 
https://regex101.com/r/UbZ90u/1

```{r}
df <- df %>% 
  mutate(text = str_replace_all(text, "🏻|🏼|🏽|🏾|🏿", ""),
         text = str_replace_all(text, "\\\\n|&lt", " "), 
         text = str_replace_all(text, "🤣+|😂+", " tokenrisa "),
         text = str_replace_all(text, "🐀+", " tokenrata "),
         text = str_replace_all(text, "😡+|🔪+|🤬+|👊+|🪓+|🤮+|💩+", " tokenenfado "),
         text = str_replace_all(text, "👏+|💪+|✊+|💪+|❤️+|🥰+|❤+|🤍+", " tokenpositivo "),
         text = ji_replace_all(text, ""),
         text = iconv(text, to = "UTF-8//IGNORE"),
         text = str_replace_all(text, "\\b(?:a*(?:ha*){2,}h?)\\b|\\b(?:a*(?:ja*)+j?)\\b|\\b(?:e*(?:je*)+j?)\\b|\\b(?:i*(?:ji+)+j?)\\b|\\b(?:A*(?:JA+)+J?)\\b|\\b(?:A*(?:HA+)+H?)\\b|\\b(?:e*(?:he+){2,}h?)\\b|\\b(?:Ja*(?:ja+)+j?)\\b|\\b(?:Je*(?:je+)+j?)\\b|\\bJa+\\b|\\b(?:Ji*(?:ji+)+j?)\\b|\\b(?:Ha*(?:ha+)+h?)\\b|\\b(?:Jo*(?:jo+)+j?)\\b|\\b(?:o*(?:jo+)+j?)\\b|\\b(?:a*((?:ja+)|(?:js+))+j?)\\b|\\b(?:A*((?:JA+)|(?:JS+))+J?)\\b|\\blo*l\\b", " tokenrisa "))

```

## Other features factorizing: 

```{r}
df <- df %>% 
  mutate(entities.url = factor(entities.url, levels = c(0,1)),
         entities.mentions = factor(entities.mentions, levels = c(0,1)),
         hateterm = case_when(hateterm == F ~ 0, 
                              hateterm == T ~ 1),
         hateterm = factor(hateterm, levels = c(0,1)),
         text = str_replace_all(text, "@|#|\\|+", ""),
         text = stringi::stri_replace_all_regex(text, "[^[:alnum:][:space:]]+|\\p{So}+|[0-9]+", ""))
```

# Building the model

## Corpus and DFM

```{r}

corpus <- corpus(df$text, docvars = data.frame(hate = df$hate, hateterm = df$hateterm, mentions = df$entities.mentions, url = df$entities.url))
summary(corpus)

```

```{r}
set.seed(1234)
id_train <- sample(1:4985,4500, replace=F)
```

```{r}

docvars(corpus, "id_numeric") <- 1:ndoc(corpus)

dfmat_train <- corpus_subset(corpus, id_numeric %in% id_train) %>%  
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>%
  #tokens_remove("[^[:alnum:]]+|[^\\p{L}\\p{N}]+") %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

dfmat_test <- corpus_subset(corpus, !(id_numeric %in% id_train)) %>% 
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>% 
  #tokens_remove("[^[:alnum:]]+|[^\\p{L}\\p{N}]+") %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

```

```{r}
dfmat_matched_train <- dfm_match(dfmat_test, features=featnames(dfmat_train))
actual_class <- docvars(dfmat_matched_train, "hate")
```


## SVM: 

```{r}
library(e1071)

sentmod.svm <- svm(x=dfmat_train,
                   y=as.factor(docvars(dfmat_train)$hate),
                   kernel="linear", 
                   cost=10,  # arbitrary regularization cost
                   probability=TRUE)


```

```{r}
predicted_class.svm <- predict(sentmod.svm, newdata=dfmat_matched)
tab_class.svm <- table(actual_class,predicted_class.svm)
tab_class.svm
```

```{r}
confusionMatrix(tab_class.svm, mode="everything", positive="Yes")
```

```{r}
svm_mod <- train(x = dfmat_train,
                 y = dfmat_train$hate,
                 method = "svmLinearWeights2",
                 trControl = trainControl(method="cv", number=5, 
                                              verboseIter=T,
                                      classProbs = T),
                 tuneGrid = data.frame(cost = 1, 
                                       Loss = 0, 
                                       weight = 1))
```


```{r}
predicted_class.svm <- predict(svm_mod, newdata=dfmat_matched)
tab_class.svm <- table(actual_class,predicted_class.svm)
tab_class.svm
```

## XGBoost: 

```{r}
XGB <- train(x = dfmat_train, 
             y = as.factor(docvars(dfmat_train)$hate),
             method = "xgbTree",
             trControl = trainControl(method="cv", number=5, 
                                              verboseIter=T,
                                      classProbs = T),
             #summaryFunction = twoClassSummary,
  metric = "ROC" 
)

#Fitting nrounds = 150, max_depth = 2, eta = 0.4, gamma = 0, colsample_bytree = 0.8, min_child_weight = 1, subsample = 1 on full training set
```


```{r}
predicted_prob.XGB <- predict(XGB, newdata=dfmat_matched_train, type = "prob")
predicted_class.XGB <- as.factor(ifelse(predicted_prob.XGB[,2] > 0.3, "Yes", "No"))
tab_class.XGB <- table(actual_class,predicted_class.XGB)
tab_class.XGB
```

```{r}
confusion_matrix <- confusionMatrix(tab_class.XGB, mode="everything", positive="Yes")
confusion_matrix
```

```{r}
confusion_matrix_df <- as.tibble(confusion_matrix_obj$table)
library(cvms)
plot_cm <- plot_confusion_matrix(confusion_matrix_df, 
                      target_col = "actual_class", 
                      prediction_col = "predicted_class.XGB",
                      counts_col = "n", 
                      class_order = c("Yes", "No"))
plot_cm

ggsave("confusionmatrix.jpeg", plot = plot_cm, width = 5, height = 5, dpi = 300)
```


```{r}

library(pROC)
library(ROCR)
roc.xgb=roc(dfmat_test$hate ~ predicted_prob.XGB[,2])
roc.xgb$auc

plot(roc.xgb, col="red",print.thres=TRUE)
```


## LR:

```{r}

logit.model = glm(dfmat_train$hate ~ ., family = binomial(link = 'logit'), dfmat_train)

logprobability = predict(logit.model, newdata=dfmat_matched, type="response")
head(logprobability)
```


## Lasso: 

```{r}
library(glmnet)
#registerDoMC(cores=2) # parallelize to speed up
sentmod.lasso <- cv.glmnet(x=dfmat_train,
                   y=docvars(dfmat_train)$hate,
                   family="binomial", 
                   alpha=1,  # alpha = 1: LASSO
                   nfolds=5, # 5-fold cross-validation
                   parallel=TRUE, 
                   intercept=TRUE,
                   type.measure="class")
```
```{r}
predicted_value.lasso <- predict(sentmod.lasso, newx=dfmat_matched,s="lambda.min")[,1]
predicted_class.lasso <- rep(NA,length(predicted_value.lasso))
predicted_class.lasso[predicted_value.lasso>0] <- "pos"
predicted_class.lasso[predicted_value.lasso<0] <- "neg"
tab_class.lasso <- table(actual_class,predicted_class.lasso)
tab_class.lasso
```

# Trying with the 3 datasets

```{r}
df2 <- annotation_b %>% 
  rbind(annotation_c) %>% 
  mutate(id = row_number() + 5000)  %>% 
  distinct(text, .keep_all = T) %>% 
  mutate(text = tolower(text),
         entities.mentions = ifelse(str_detect(text, "@.{1,15} "), 1, 0),
         entities.url = ifelse(str_detect(text, "https://.*\\b"), 1, 0),
         #text = str_remove_all(text, "@.{1,15} "),
         text = str_remove_all(text, "https://.*\\b"),
         hateterm = str_detect(text, "(?:^|\\s)moros?\\b|(?:^|\\s)maric[oó]na?e?s?\\b|(?:^|\\s)monos?\\b|(?:^|\\s)putas?\\b|(?:^|\\s)hijos? de puta\\b|(?:^|\\s)hijos?deputa|(?:^|\\s)zorras?\\b|(?:^|\\s)panchitos?\\b")) %>% 
  mutate(text = str_replace_all(text, "🏻|🏼|🏽|🏾|🏿", ""),
         text = str_replace_all(text, "\\\\n|&lt", " "), 
         text = str_replace_all(text, "🤣+|😂+", " tokenrisa "),
         text = str_replace_all(text, "🐀+", " tokenrata "),
         text = str_replace_all(text, "😡+|🔪+|🤬+|👊+|🪓+|🤮+|💩+", " tokenenfado "),
         text = str_replace_all(text, "👏+|💪+|✊+|💪+|❤️+|🥰+|❤+|🤍+", " tokenpositivo "),
         text = ji_replace_all(text, ""),
         text = iconv(text, to = "UTF-8//IGNORE"),
         text = str_replace_all(text, "\\b(?:a*(?:ha*){2,}h?)\\b|\\b(?:a*(?:ja*)+j?)\\b|\\b(?:e*(?:je*)+j?)\\b|\\b(?:i*(?:ji+)+j?)\\b|\\b(?:A*(?:JA+)+J?)\\b|\\b(?:A*(?:HA+)+H?)\\b|\\b(?:e*(?:he+){2,}h?)\\b|\\b(?:Ja*(?:ja+)+j?)\\b|\\b(?:Je*(?:je+)+j?)\\b|\\bJa+\\b|\\b(?:Ji*(?:ji+)+j?)\\b|\\b(?:Ha*(?:ha+)+h?)\\b|\\b(?:Jo*(?:jo+)+j?)\\b|\\b(?:o*(?:jo+)+j?)\\b|\\b(?:a*((?:ja+)|(?:js+))+j?)\\b|\\b(?:A*((?:JA+)|(?:JS+))+J?)\\b|\\blo*l\\b", " tokenrisa "))
```

```{r}
df3 <- rbind(df, df2)

corpus2 <- corpus(df3$text, docvars = data.frame(hate = df3$hate, hateterm = df3$hateterm, mentions = df3$entities.mentions, url = df3$entities.url))
summary(corpus2)
```

```{r}
set.seed(1234)
id_train <- sample(1:13624,12000, replace=F)
```

```{r}

docvars(corpus2, "id_numeric") <- 1:ndoc(corpus2)

dfmat_train2 <- corpus_subset(corpus, id_numeric %in% id_train) %>%  
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

dfmat_test2 <- corpus_subset(corpus, !(id_numeric %in% id_train)) %>% 
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

```
```{r}
dfmat_matched2 <- dfm_match(dfmat_test2, features=featnames(dfmat_train2))
actual_class <- docvars(dfmat_matched2, "hate")
```

SVM:

```{r}
svm_mod <- train(x = dfmat_train2,
                 y = dfmat_train2$hate,
                 method = "svmLinearWeights2",
                 trControl = trainControl(method="cv", number=5, 
                                              verboseIter=T,
                                      classProbs = T),
                 tuneGrid = data.frame(cost = 1, 
                                       Loss = 0, 
                                       weight = 1))
```


```{r}
predicted_class.svm <- predict(svm_mod, newdata=dfmat_matched2)
tab_class.svm <- table(actual_class,predicted_class.svm)
tab_class.svm
```

```{r}
library(glmnet)
#registerDoMC(cores=2) # parallelize to speed up
sentmod.lasso <- cv.glmnet(x=dfmat_train2,
                   y=docvars(dfmat_train2)$hate,
                   family="binomial", 
                   alpha=1,  # alpha = 1: LASSO
                   nfolds=5, # 5-fold cross-validation
                   parallel=TRUE, 
                   intercept=TRUE,
                   type.measure="class")
```


```{r}
predicted_value.lasso <- predict(sentmod.lasso, newx=dfmat_matched2,s="lambda.min")[,1]
predicted_class.lasso <- rep(NA,length(predicted_value.lasso))
predicted_class.lasso[predicted_value.lasso>0] <- "pos"
predicted_class.lasso[predicted_value.lasso<0] <- "neg"
tab_class.lasso <- table(actual_class,predicted_class.lasso)
tab_class.lasso
```

```{r}
XGB <- train(x = dfmat_train, 
             y = as.factor(docvars(dfmat_train2)$hate),
             method = "xgbTree",
             trControl = trainControl(method="cv", number=5,
                                      classProbs = T),
  metric = "ROC", # evaluation metric
  maximize = TRUE # whether to maximize the evaluation metric
)

#nrounds = 50, max_depth = 3, eta = 0.3, gamma = 0, colsample_bytree = 0.6, min_child_weight = 1, subsample = 1
```


```{r}
predicted_class.XGB <- predict(XGB, newdata=dfmat_matched2, type = "prob")
predicted_class.XGB <- as.factor(ifelse(predicted_class.XGB[,2] > 0.35, "Yes", "No"))
tab_class.XGB <- table(actual_class,predicted_class.XGB)
tab_class.XGB
```

```{r}
confusionMatrix(tab_class.XGB, mode="everything", positive="Yes")
```

# Trying with n-grams


```{r}
set.seed(1234)
id_train <- sample(1:4985,4500, replace=F)
```


```{r}
docvars(corpus, "id_numeric") <- 1:ndoc(corpus)

dfmat_train <- corpus_subset(corpus, id_numeric %in% id_train) %>%  
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>% 
  tokens_ngrams(n = 2) %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

dfmat_test <- corpus_subset(corpus, !(id_numeric %in% id_train)) %>% 
  tokens(remove_punct = T, remove_numbers = T, remove_separators = T) %>% 
  tokens_remove(stopwords("es", source = "nltk")) %>% 
  tokens_wordstem(language = "spanish") %>% 
  tokens_ngrams(n = 2) %>% 
  dfm() %>%
  dfm_tfidf() %>% 
  dfm_trim(min_docfreq=2,verbose=TRUE)

```

```{r}
dfmat_matched <- dfm_match(dfmat_test, features=featnames(dfmat_train))
actual_class <- docvars(dfmat_matched, "hate")
```

```{r}
XGB <- train(x = dfmat_train, 
             y = as.factor(docvars(dfmat_train)$hate),
             method = "xgbTree",
             trControl = trainControl(method="cv", number=5, 
                                              verboseIter=T,
                                      classProbs = T),
  metric = "ROC", # evaluation metric
  maximize = TRUE # whether to maximize the evaluation metric
)

#nrounds = 50, max_depth = 3, eta = 0.3, gamma = 0, colsample_bytree = 0.6, min_child_weight = 1, subsample = 1
```


```{r}
predicted_class.XGB <- predict(XGB, newdata=dfmat_matched, type = "prob")
predicted_class.XGB <- as.factor(ifelse(predicted_class.XGB[,2] > 0.2, "Yes", "No"))
tab_class.XGB <- table(actual_class,predicted_class.XGB)
tab_class.XGB
```

```{r}
svm_mod <- train(x = dfmat_train,
                 y = dfmat_train$hate,
                 method = "svmLinearWeights2",
                 trControl = trainControl(method="cv", number=5, 
                                              verboseIter=T,
                                      classProbs = T),
                 tuneGrid = data.frame(cost = 1, 
                                       Loss = 0, 
                                       weight = 1))
```


```{r}
predicted_class.svm <- predict(svm_mod, newdata=dfmat_matched)
tab_class.svm <- table(actual_class,predicted_class.svm)
tab_class.svm
```

# Trying with word2vec



# Saving the model

```{r}
saveRDS(XGB, "data/XGB_model.rds")
```