Task6.R

library(arules)
library(arulesViz)

library(textclean)
library(tidyverse)
library(patchwork)
library(stringr)

library(tm)
library(readr)
library(dplyr)
library(gridExtra)
library(RColorBrewer)
library(skmeans)
library(countrycode)
library(syuzhet)
library(e1071)
library(caret)
library(tidyr)
library(ggplot2)
library(forcats)
library(countrycode)
library(patchwork)
library(corrplot)
library(purrr)
library(caret)
library(xgboost)
library(rpart)

library(textstem)
library(quanteda)
library(quanteda.textmodels)
library(quanteda.textstats)
library(quanteda.textplots)

library(recommenderlab)

set.seed(123)

# -------------------------------------------
# Improvement of the model XGBOOST with findings from TASK 2 - changes in the demographics
# -------------------------------------------

# Loading needed data
dfm_filtered <- read_csv("original_df.csv")
unique_tweets_data <- read_csv("unique_tweets_data.csv")
tf_idf_data <- read_csv("tf_idf_data.csv")

# One hot encode data 
dfm_filtered <- fastDummies::dummy_cols(dfm_filtered, select_columns = c("age", "ethnicity", "education", "gender", "continent", "label_task1_1"), remove_selected_columns = TRUE, remove_first_dummy = TRUE)
dfm_filtered <- dfm_filtered %>% rename_at('label_task1_1_YES', ~'label_task1_1')

# Remove unneeded columns from tweet data
unique_tweets_data <- unique_tweets_data[, c(1, (ncol(unique_tweets_data)-9):ncol(unique_tweets_data))]

# Join tweet and tf_idf
merge_df_orig_emotios <- unique_tweets_data %>% inner_join( tf_idf_data, by = "id_EXIST", relationship = "many-to-many")

# Join everything
merge_all = merge_df_orig_emotios %>% inner_join( dfm_filtered, by = "id_EXIST", relationship = "many-to-many")

# Split data
labels <- as.numeric(merge_all$label_task1_1)
train_index <- createDataPartition(labels, p = 0.8, list = FALSE)

feature_cols <- setdiff(colnames(merge_all), c("label_task1_1", "id_EXIST", "annotator_id"))

train_data <- merge_all[train_index, feature_cols]
test_data <- merge_all[-train_index, feature_cols]

train_labels <- labels[train_index]
test_labels <- labels[-train_index]

train_matrix <- as.matrix(train_data)
test_matrix <- as.matrix(test_data)

# Create DMatrix objects for XGBoost
dtrain <- xgb.DMatrix(data = train_matrix, label = train_labels)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

params <- list(
  objective = "binary:logistic",
  eval_metric = "logloss"
)

xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

# Make predictions on the test set
pred_prob <- predict(xgb_model, dtest)   

# Visualizing to see what probability threshold we'll use
labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

# It seem like there's an okay separation of the labels at around 0.38 of probability
pred_class <- ifelse(pred_prob > 0.38, 1, 0)  

# Create a confusion matrix to compare predictions with true labels
confusionMatrix(as.factor(pred_class), as.factor(test_labels))

# ------------------------
# Confusion Matrix and Statistics
# 
# Reference
# Prediction    0    1
# 0 1467  417
# 1  563  997
# 
# Accuracy : 0.7154          
# 95% CI : (0.7001, 0.7305)
# No Information Rate : 0.5894          
# P-Value [Acc > NIR] : < 2.2e-16       
# 
# Kappa : 0.4212          
# 
# Mcnemar's Test P-Value : 3.624e-06       
#                                           
#             Sensitivity : 0.7227          
#             Specificity : 0.7051          
#          Pos Pred Value : 0.7787          
#          Neg Pred Value : 0.6391          
#              Prevalence : 0.5894          
#          Detection Rate : 0.4260          
#    Detection Prevalence : 0.5470          
#       Balanced Accuracy : 0.7139          
#                                           
#        'Positive' Class : 0    

# Removing the demographics from our data and creating the model again to verify that our model would improve or not without the demographics

merge_all <- merge_all[, -((ncol(merge_all) - 7):(ncol(merge_all) - 1))]

labels <- as.numeric(merge_all$label_task1_1)
train_index <- createDataPartition(labels, p = 0.8, list = FALSE)

feature_cols <- setdiff(colnames(merge_all), c("label_task1_1", "id_EXIST", "annotator_id"))

train_data <- merge_all[train_index, feature_cols]
test_data <- merge_all[-train_index, feature_cols]

train_labels <- labels[train_index]
test_labels <- labels[-train_index]

train_matrix <- as.matrix(train_data)
test_matrix <- as.matrix(test_data)

dtrain <- xgb.DMatrix(data = train_matrix, label = train_labels)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

params <- list(
  objective = "binary:logistic",
  eval_metric = "logloss"
)

xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

pred_prob <- predict(xgb_model, dtest)  

# Visualizing to see what probability threshold we'll use
labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

# It seem like there's an okay separation of the labels at around 0.38 of probability
pred_class <- ifelse(pred_prob > 0.38, 1, 0)  

confusionMatrix(as.factor(pred_class), as.factor(test_labels))

# ------------------------
# Confusion Matrix and Statistics
# 
# Reference
# Prediction    0    1
# 0 1489  347
# 1  584 1024
# 
# Accuracy : 0.7297          
# 95% CI : (0.7145, 0.7445)
# No Information Rate : 0.6019          
# P-Value [Acc > NIR] : < 2.2e-16       
# 
# Kappa : 0.452           
# 
# Mcnemar's Test P-Value : 1.037e-14       
#                                           
#             Sensitivity : 0.7183          
#             Specificity : 0.7469          
#          Pos Pred Value : 0.8110          
#          Neg Pred Value : 0.6368          
#              Prevalence : 0.6019          
#          Detection Rate : 0.4323          
#    Detection Prevalence : 0.5331          
#       Balanced Accuracy : 0.7326          
#                                           
#        'Positive' Class : 0               
#
# Conclusion
# It becomes sightly better without the demographics data. This is fine because in task 3 we used the demographic data for clustering instead. Hopefully the results from that make our model better 

# -------------------------------------------
# Improvement of the model XGBOOST with findings from TASK 3 - clustering analysis
# -------------------------------------------
# Load clustering data
clusters <- read_csv("annotator_clusters.csv")

# Merge clustering data
with_clusters <- merge_all %>% left_join(clusters, by = "annotator_id")

feature_cols <- setdiff(colnames(with_clusters), c("label_task1_1", "id_EXIST", "annotator_id"))

labels <- as.numeric(with_clusters$label_task1_1)
train_index <- createDataPartition(labels, p = 0.8, list = FALSE)

train_data <- with_clusters[train_index, feature_cols]
test_data <- with_clusters[-train_index, feature_cols]

train_labels <- labels[train_index]
test_labels <- labels[-train_index]

train_matrix <- as.matrix(train_data)
test_matrix <- as.matrix(test_data)

# Create DMatrix objects for XGBoost
dtrain <- xgb.DMatrix(data = train_matrix, label = train_labels)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

params <- list(
  objective = "binary:logistic",
  eval_metric = "logloss"
)

xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

pred_prob <- predict(xgb_model, dtest)  

# Visualizing to see what probability threshold we'll use
labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())


pred_class <- ifelse(pred_prob > 0.40, 1, 0)  

# Create a confusion matrix to compare predictions with true labels
confusionMatrix(as.factor(pred_class), as.factor(test_labels))

#  Confusion Matrix and Statistics
#  
#  Reference
#  Prediction    0    1
#  0 1608  499
#  1  429  908
#  
#  Accuracy : 0.7305          
#  95% CI : (0.7154, 0.7453)
#  No Information Rate : 0.5915          
#  P-Value [Acc > NIR] : < 2e-16         
#  
#  Kappa : 0.4381          
#  
#  Mcnemar's Test P-Value : 0.02351         
#                                            
#              Sensitivity : 0.7894          
#              Specificity : 0.6453          
#           Pos Pred Value : 0.7632          
#           Neg Pred Value : 0.6791          
#               Prevalence : 0.5915          
#           Detection Rate : 0.4669          
#     Detection Prevalence : 0.6118          
#        Balanced Accuracy : 0.7174          
#                                            
#         'Positive' Class : 0     
#
#  Conclusion:      
# We the addition of the clustering data we see an improvement to our results

# -------------------------------------------
# Improvement of the model XGBOOST with findings from TASK 4 - association rules
# -------------------------------------------
# Load results from task 4
weights_data <- read_csv("weights.csv")

# Merge with weight data
merge_wth_weights <- merge(weights_data, with_clusters, by = c("id_EXIST", "annotator_id"), all = TRUE)

feature_cols <- setdiff(colnames(merge_wth_weights), c("label_task1_1", "id_EXIST", "annotator_id"))

labels <- as.numeric(merge_wth_weights$label_task1_1)
train_index <- createDataPartition(labels, p = 0.8, list = FALSE)

train_data <- merge_wth_weights[train_index, feature_cols]
test_data <- merge_wth_weights[-train_index, feature_cols]

train_labels <- labels[train_index]
test_labels <- labels[-train_index]

train_matrix <- as.matrix(train_data)
test_matrix <- as.matrix(test_data)

# Create DMatrix objects for XGBoost
dtrain <- xgb.DMatrix(data = train_matrix, label = train_labels)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

params <- list(
  objective = "binary:logistic",
  eval_metric = "logloss"
)

xgb_model_X <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

pred_prob <- predict(xgb_model_X, dtest)  

# Visualizing to see what probability threshold we'll use
labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())


pred_class <- ifelse(pred_prob > 0.40, 1, 0)  

# Create a confusion matrix to compare predictions with true labels
confusionMatrix(as.factor(pred_class), as.factor(test_labels))

#  Confusion Matrix and Statistics
# 
# Reference
# Prediction    0    1
# 0 1626  479
# 1  441  898
# 
# Accuracy : 0.7329          
# 95% CI : (0.7178, 0.7476)
# No Information Rate : 0.6002          
# P-Value [Acc > NIR] : <2e-16          
# 
# Kappa : 0.4408          
# 
# Mcnemar's Test P-Value : 0.2225          
#                                           
#             Sensitivity : 0.7866          
#             Specificity : 0.6521          
#          Pos Pred Value : 0.7724          
#          Neg Pred Value : 0.6706          
#              Prevalence : 0.6002          
#          Detection Rate : 0.4721          
#    Detection Prevalence : 0.6112          
#       Balanced Accuracy : 0.7194          
#                                           
#        'Positive' Class : 0         
#         'Positive' Class : 0               
#  Conclusion:
#   The improvements were very minor, almost negible. Nevertheless being an improvement we'll keep that feature.

# -------------------------------------------
# Improvement of the model XGBOOST with findings from TASK 5 - recomender system
# -------------------------------------------

cf_weights <- read_csv("cf_weights.csv")

merge_wth_cf_weights <- merge_wth_weights %>% left_join(cf_weights %>% select(annotator_id, id_EXIST, cf_weight),by = c("annotator_id", "id_EXIST"))

feature_cols <- setdiff(colnames(merge_wth_cf_weights), c("label_task1_1", "id_EXIST", "annotator_id"))

labels <- as.numeric(merge_wth_cf_weights$label_task1_1)
train_index <- createDataPartition(labels, p = 0.8, list = FALSE)

train_data <- merge_wth_cf_weights[train_index, feature_cols]
test_data <- merge_wth_cf_weights[-train_index, feature_cols]

train_labels <- labels[train_index]
test_labels <- labels[-train_index]

train_matrix <- as.matrix(train_data)
test_matrix <- as.matrix(test_data)

# Create DMatrix objects for XGBoost
dtrain <- xgb.DMatrix(data = train_matrix, label = train_labels)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

params <- list(
  objective = "binary:logistic",
  eval_metric = "logloss"
)

xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

pred_prob <- predict(xgb_model, dtest)  

# Visualizing to see what probability threshold we'll use
labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())


pred_class <- ifelse(pred_prob > 0.55, 1, 0)  

# Create a confusion matrix to compare predictions with true labels
confusionMatrix(as.factor(pred_class), as.factor(test_labels))

#  Confusion Matrix and Statistics
#  
#  Reference
#  Prediction    0    1
#  0 2025   17
#  1   25 1377
#  
#  Accuracy : 0.9878          
#  95% CI : (0.9836, 0.9912)
#  No Information Rate : 0.5952          
#  P-Value [Acc > NIR] : <2e-16          
#  
#  Kappa : 0.9747          
#  
#  Mcnemar's Test P-Value : 0.2801          
#                                            
#              Sensitivity : 0.9878          
#              Specificity : 0.9878          
#           Pos Pred Value : 0.9917          
#           Neg Pred Value : 0.9822          
#               Prevalence : 0.5952          
#           Detection Rate : 0.5880          
#     Detection Prevalence : 0.5929          
#        Balanced Accuracy : 0.9878          
#                                            
#         'Positive' Class : 0  
#
#  Conclusion:
#   At first glance it appears that adding the cf weights greatly improved our data, however, such high values clearly are a sign of overfitting. We can verify by training a model with our full data and then testing it on the provided test dataset.

# -------------------------------------------
# Model validity
# -------------------------------------------

## Training model (with) cf_weights : if it shows signs of overfitting we'll instead train a model without these added cf_weights
feature_cols <- setdiff(colnames(merge_wth_cf_weights), c("label_task1_1", "id_EXIST", "annotator_id"))

labels <- as.numeric(merge_wth_cf_weights$label_task1_1)

train_data <- merge_wth_cf_weights[, feature_cols]
train_matrix <- as.matrix(train_data)
dtrain <- xgb.DMatrix(data = train_matrix, label = labels)

params <- list(objective = "binary:logistic", eval_metric = "logloss")

xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,
  watchlist = list(train = dtrain),
  verbose = 0
)

## Load test data
for_test_df <- read_csv("EXIST2025_dev_labeled.csv")

## Pre-processing
# Renaming columns
names(for_test_df)[names(for_test_df) == 'study_level'] <- 'education'
names(for_test_df)[names(for_test_df) == 'annotator'] <- 'annotator_id'
names(for_test_df)[names(for_test_df) == 'age_group'] <- 'age'

# Removing lang column since it only has the same values
for_test_df <- select(for_test_df, -lang)

# Check for nan values
if (any(is.na(for_test_df))) {print("There were NaN values found in the matrix.")} 

# Making a continent variable
for_test_df$continent <- countrycode(sourcevar = for_test_df$country, origin = "country.name",destination = "continent")

# Shortening names for viz purposes
for_test_df$country <- countrycode(for_test_df$country, origin = 'country.name', destination = 'iso3c')

map_edu <- c("Master’s degree" = "MS", "Bachelor’s degree" = "BS", "Doctorate" = "PhD", "other" = "Other", "High school degree or equivalent" = "HS", "Less than high school diploma" = "CE") # ce = common education

map_eth <- c("Multiracial" = "Mr", "other" = "Ot", "Asian" = "As", "Hispano or Latino" = "La", "White or Caucasian" = "Ca", "Black or African American" = "Bl", "Middle Eastern" = "ME" )

for_test_df$education <- map_edu[for_test_df$education]
for_test_df$ethnicity <- map_eth[for_test_df$ethnicity]

if (any(is.na(for_test_df))) {print("There were NaN values found in the matrix.")} 

## Clean tweets
clean_tweets <- function(df) {
  df %>%
    mutate(
      # Extract mentions
      mentions = str_extract_all(tweet, "@\\w+"),
      
      # Extract hashtags
      hashtags = str_extract_all(tweet, "#\\w+"),
      
      # Extract emojis
      emojis = str_extract_all(tweet, emoji::emoji_rx),
      
      # Clean tweet text
      tweet = tweet %>%
        # Remove URLs
        str_remove_all("https?://\\S+") %>%
        # Remove mentions
        str_remove_all("@\\w+") %>%
        # Remove hashtags
        str_remove_all("#\\w+") %>%
        # Remove emojis
        str_remove_all(emoji::emoji_rx) %>%
        # Replace punctuation (excluding ! and ?) with space
        str_replace_all("[[:punct:]&&[^'!?]]", " ") %>%
        # Remove extra whitespace
        str_squish()
    )
}

test_unique_tweet_data <- for_test_df %>% select(id_EXIST, tweet) %>% distinct()

test_unique_tweet_data <- clean_tweets(test_unique_tweet_data)
test_unique_tweet_data <- subset(test_unique_tweet_data, select = -c(emojis, mentions, hashtags ) )

## Extracting the tokens: keeping only the tokens we used in our original data
corpus_train <- corpus(test_unique_tweet_data$tweet)

tokens_train <- tokens(corpus_train,
                       remove_punct = TRUE,
                       remove_symbols = TRUE,
                       remove_numbers = TRUE,
                       remove_separators = TRUE) %>%
  tokens_tolower() %>%
  tokens_remove(stopwords("en")) %>%
  tokens_remove(c("said", "user", "amp", "just", "like", "get", "can", "will", "one", "and", "'")) %>%
  tokens_remove(pattern = "^[a-z]{1,2}$", valuetype = "regex")

tokens_train <- tokens_train %>%
  as.list() %>%
  lapply(lemmatize_words) %>%
  tokens()

# Only keep tokens that exists in our matrix
tokens_to_keep <- colnames(merge_all)[12:(ncol(merge_all) - 2)]

dfm_filtered <- dfm(tokens_train) %>% dfm_select(pattern = tokens_to_keep, selection = "keep")

# Conversion to TF-IDF
dfm_tfidf <- dfm_tfidf(dfm_filtered)
dfm_matrix <- as.matrix(dfm_tfidf)

# Sentiment analysis
nrc_sentiments <- get_nrc_sentiment(test_unique_tweet_data$tweet)
nrc_normalized <- scale(nrc_sentiments)

combined_features <- cbind(dfm_matrix, nrc_sentiments)

# Making sure we have all the tokens (even if they didn't exist in the test data we must add them for modeling purposes )
missing_cols <- setdiff(names(merge_all), names(combined_features))
for (col in missing_cols) { combined_features[[col]] <- 0}
combined_features <- subset(combined_features, select = -c(annotator_id, label_task1_1 ) )

# Change demographics like we did in task2
for_test_df$ethnicity[for_test_df$ethnicity %in% c("ME", "Ot", "La", "Bl", "Mr", "As")] <- "Not_Ca"
for_test_df$continent[for_test_df$continent %in% c("Asia", "Americas", "Oceania", "Africa")] <- "Not_Europe"
for_test_df$education[for_test_df$education %in% c("CE", "HS")] <- "HS_CE"
for_test_df$education[for_test_df$education %in% c("PhD", "Other", "MS")] <- "MS+"

for_test_df <- select(for_test_df, -c(tweet, country))

# Determine clusters
annotator_demo <- for_test_df %>% select(annotator_id, gender, age, ethnicity, education, continent) %>% distinct()

annotator_demo <- annotator_demo %>%  mutate(across(c(gender, age, ethnicity, education, continent), as.factor))

dummies <- dummyVars(~ gender + age + ethnicity + education + continent, data = annotator_demo)
demo_cat <- predict(dummies, newdata = annotator_demo) %>% as.data.frame()

c_info <- readRDS("cluster_info.rds")

demo_scaled <- scale(demo_cat, center = c_info$scaling$center,scale = c_info$scaling$scale)

kmeans_result <- kmeans(demo_scaled, centers = 4, nstart = 25)

annotator_demo$cluster <- as.factor(kmeans_result$cluster)

# Create weight based on rules
rule_df <- read_csv("rule_df.csv")

for_test_df$weight <- 0

categorical_columns <- c("age", "gender", "continent", "education", "ethnicity")

combined_features$id_EXIST <- test_unique_tweet_data$id_EXIST

test_merged = for_test_df %>%
  inner_join( combined_features, by = "id_EXIST", relationship = "many-to-many")

for (i in seq_len(nrow(rule_df))) {
  lhs_col <- rule_df$lhs[i]
  subset_val <- rule_df$subset[i]
  rule_weight <- rule_df$weight[i]
  
  # subset of tweets with our wanted words
  is_lhs_match <- test_merged[[lhs_col]] >= 1
  
  # check if any categorical column has subset_val
  is_subset_match <- apply(test_merged[categorical_columns], 1, function(row) subset_val %in% row)
  
  # combine both conditions and add weight
  test_merged$weight[is_lhs_match & is_subset_match] <- test_merged$weight[is_lhs_match & is_subset_match] + rule_weight}

## Recomender system weights
pred_matrix <- readRDS("cf_matrix.rds")

# Because we won't have the same tweets, we need to find a way to nevertheless get cf_weights incorporated into our data. This approach is not ideal: we should've found a way to consider the tweets.
cf_mat <- as.data.frame(pred_matrix)
summary_values <- apply(cf_mat, 1, function(row) {sum(row, na.rm = TRUE) / sum(!is.na(row))})

cf_mat$summary <- summary_values
cf_mat$group_id <- rownames(cf_mat)

test_merged$group_id <- paste(test_merged$gender, test_merged$age, test_merged$ethnicity, test_merged$education, test_merged$continent, sep = "_")

test_merged$group_id <- as.character(test_merged$group_id)
test_merged$id_EXIST <- as.character(test_merged$id_EXIST)

# Merge CF scores as weights
test_merged <- test_merged %>%
  left_join(cf_mat %>% select(group_id, summary), by = "group_id") %>%
  rename(cf_weight = summary)

ggplot(test_merged, aes(x = 1, y = cf_weight, color = as.factor(label_task1_1))) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

# The way we are obtaining the cf_weights for data we did not train for is not outputing good results. Another way of extracting weights should have been developed, however, because of the way we've done our task 5 (meaning we needed a matrix filled with the values of the label, which is impossible to get for the no_label data) we were unable to addapt a method that could accomplish as much. Because of this we won't be able to use the results of task5 even though they were promising.

## Because of this we'll use the model trained without the cf_weights (xgb_model_X)

## Checking if we have the right columns for the predictions
test_merged <- test_merged %>%
  left_join(annotator_demo %>% select(annotator_id, cluster), by = "annotator_id")

test_labels <- ifelse(test_merged$label_task1_1 == "YES", 1, 0)

test_merged <- test_merged[, colnames(test_merged) %in% colnames(merge_wth_weights)]
missing_cols <- setdiff(colnames(merge_wth_weights), colnames(test_merged))
print(missing_cols) # empty so we have the right columns

## Making the predictions
model_feature_names <- xgb_model_X$feature_names
test_merged <- test_merged[, model_feature_names]

test_matrix <- as.data.frame(lapply(test_merged, as.numeric))
test_matrix <- as.matrix(test_matrix)
dtest <- xgb.DMatrix(data = test_matrix, label = test_labels)

pred_prob <- predict(xgb_model_X, dtest)  

labels <- getinfo(dtest, "label")
plot_data <- data.frame(pred_prob = pred_prob, label = as.factor(labels))

ggplot(plot_data, aes(x = 1, y = pred_prob, color = label)) +
  geom_jitter(width = 0.3, height = 0, size = 1) +
  scale_color_brewer(palette = "Set1") +  
  labs(color = "Label") +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

pred_class <- ifelse(pred_prob > 0.38, 1, 0)  

confusionMatrix(as.factor(pred_class), as.factor(test_labels))

# Confusion Matrix and Statistics
# 
#           Reference
# Prediction   0   1
#          0 280 128
#          1 138 174
#                                           
#                Accuracy : 0.6306          
#                  95% CI : (0.5941, 0.6659)
#     No Information Rate : 0.5806          
#     P-Value [Acc > NIR] : 0.003511        
#                                           
#                   Kappa : 0.2449          
#                                           
#  Mcnemar's Test P-Value : 0.581068        
#                                           
#             Sensitivity : 0.6699          
#             Specificity : 0.5762          
#          Pos Pred Value : 0.6863          
#          Neg Pred Value : 0.5577          
#              Prevalence : 0.5806          
#          Detection Rate : 0.3889          
#    Detection Prevalence : 0.5667          
#       Balanced Accuracy : 0.6230          
#                                           
#        'Positive' Class : 0   
#
# Conclusions:
# As to be expected, our model performs worse in this biggest test data, with accuracy of less 10 than what we were seeing in our other test set (that was a partition of our training data).

# -------------------------------------------
# Prediction our labels in the no_label test data
# -------------------------------------------

## We'll have to do the same alteration we did for our original data for this one, as well as use the saved objects we did for the clustering and the association rules

## Load no labels csv
no_label_df <- read_csv("EXIST_test_nolabel.csv")

## Pre-processing
# Renaming columns
names(no_label_df)[names(no_label_df) == 'study_level'] <- 'education'
names(no_label_df)[names(no_label_df) == 'annotator'] <- 'annotator_id'
names(no_label_df)[names(no_label_df) == 'age_group'] <- 'age'

# Removing lang column since it only has the same values
no_label_df <- select(no_label_df, -lang)

# Check for nan values
if (any(is.na(no_label_df))) {print("There were NaN values found in the matrix.")} 

# Making a continent variable
no_label_df$continent <- countrycode(sourcevar = no_label_df$country, origin = "country.name",destination = "continent")

# Shortening names for viz purposes
no_label_df$country <- countrycode(no_label_df$country, origin = 'country.name', destination = 'iso3c')

map_edu <- c("Master’s degree" = "MS", "Bachelor’s degree" = "BS", "Doctorate" = "PhD", "other" = "Other", "High school degree or equivalent" = "HS", "Less than high school diploma" = "CE") # ce = common education

map_eth <- c("Multiracial" = "Mr", "other" = "Ot", "Asian" = "As", "Hispano or Latino" = "La", "White or Caucasian" = "Ca", "Black or African American" = "Bl", "Middle Eastern" = "ME" )

no_label_df$education <- map_edu[no_label_df$education]
no_label_df$ethnicity <- map_eth[no_label_df$ethnicity]

if (any(is.na(no_label_df))) {print("There were NaN values found in the matrix.")} 

## Clean tweets
no_label_unique_tweet_data <- no_label_df %>% select(id_EXIST, tweet) %>% distinct()

no_label_unique_tweet_data <- clean_tweets(no_label_unique_tweet_data)
no_label_unique_tweet_data <- subset( no_label_unique_tweet_data, select = -c(emojis, mentions, hashtags ) )

## Extracting the tokens: keeping only the tokens we used in our original data
corpus_train <- corpus(no_label_unique_tweet_data$tweet)

tokens_train <- tokens(corpus_train,
                       remove_punct = TRUE,
                       remove_symbols = TRUE,
                       remove_numbers = TRUE,
                       remove_separators = TRUE) %>%
  tokens_tolower() %>%
  tokens_remove(stopwords("en")) %>%
  tokens_remove(c("said", "user", "amp", "just", "like", "get", "can", "will", "one", "and", "'")) %>%
  tokens_remove(pattern = "^[a-z]{1,2}$", valuetype = "regex")

tokens_train <- tokens_train %>%
  as.list() %>%
  lapply(lemmatize_words) %>%
  tokens()

# Only keep tokens that exists in our matrix
tokens_to_keep <- colnames(merge_all)[12:(ncol(merge_all) - 2)]

dfm_filtered <- dfm(tokens_train) %>% dfm_select(pattern = tokens_to_keep, selection = "keep")

# Conversion to TF-IDF
dfm_tfidf <- dfm_tfidf(dfm_filtered)
dfm_matrix <- as.matrix(dfm_tfidf)

# Sentiment analysis
nrc_sentiments <- get_nrc_sentiment(no_label_unique_tweet_data$tweet)
nrc_normalized <- scale(nrc_sentiments)

combined_features <- cbind(dfm_matrix, nrc_sentiments)

# Change demographics like we did in task2
no_label_df$ethnicity[no_label_df$ethnicity %in% c("ME", "Ot", "La", "Bl", "Mr", "As")] <- "Not_Ca"
no_label_df$continent[no_label_df$continent %in% c("Asia", "Americas", "Oceania", "Africa")] <- "Not_Europe"
no_label_df$education[no_label_df$education %in% c("CE", "HS")] <- "HS_CE"
no_label_df$education[no_label_df$education %in% c("PhD", "Other", "MS")] <- "MS+"

no_label_df <- select(no_label_df, -c(tweet, country))

# Determine clusters
annotator_demo <- no_label_df %>% select(annotator_id, gender, age, ethnicity, education, continent) %>% distinct()

annotator_demo <- annotator_demo %>%  mutate(across(c(gender, age, ethnicity, education, continent), as.factor))

dummies <- dummyVars(~ gender + age + ethnicity + education + continent, data = annotator_demo)
demo_cat <- predict(dummies, newdata = annotator_demo) %>% as.data.frame()

demo_scaled <- scale(demo_cat, center = c_info$scaling$center,scale = c_info$scaling$scale)

kmeans_result <- kmeans(demo_scaled, centers = 4, nstart = 25)

annotator_demo$cluster <- as.factor(kmeans_result$cluster)

# Create weight based on rules
no_label_df$weight <- 0

categorical_columns <- c("age", "gender", "continent", "education", "ethnicity")

combined_features$id_EXIST <- no_label_unique_tweet_data$id_EXIST

no_label_merged = no_label_df %>%
  inner_join( combined_features, by = "id_EXIST", relationship = "many-to-many")

for (i in seq_len(nrow(rule_df))) {
  lhs_col <- rule_df$lhs[i]
  subset_val <- rule_df$subset[i]
  rule_weight <- rule_df$weight[i]
  
  # subset of tweets with our wanted words
  is_lhs_match <- no_label_merged[[lhs_col]] >= 1
  
  # check if any categorical column has subset_val
  is_subset_match <- apply(no_label_merged[categorical_columns], 1, function(row) subset_val %in% row)
  
  # combine both conditions and add weight
  no_label_merged$weight[is_lhs_match & is_subset_match] <- no_label_merged$weight[is_lhs_match & is_subset_match] + rule_weight}

## Checking if we have the right columns for the predictions
no_label_merged <- no_label_merged %>%
  left_join(annotator_demo %>% select(annotator_id, cluster), by = "annotator_id")

no_label_merged <- no_label_merged[, colnames(no_label_merged) %in% colnames(merge_wth_weights)]
missing_cols <- setdiff(colnames(merge_wth_weights), colnames(no_label_merged))
print(missing_cols) # we are missing the token "important"

no_label_merged$important <- 0

## Making the predictions
model_feature_names <- xgb_model_X$feature_names
no_label_merged <- no_label_merged[, model_feature_names]

no_label_matrix <- as.data.frame(lapply(no_label_merged, as.numeric))
no_label_matrix <- as.matrix(no_label_matrix)

d_no_label <- xgb.DMatrix(data = no_label_matrix)

pred_prob <- predict(xgb_model_X, d_no_label)  

pred_class <- ifelse(pred_prob > 0.38, "YES", "NO")  

to_save <- read_csv("EXIST_test_nolabel.csv")

to_save$label <- pred_class
write.csv(to_save, "Group_F_results.csv", row.names = FALSE)