Trabajo final-op 2.Rmd

---
title: "Trabajo Final-Opción 2"
author: "Thelma Fratarelli, Beatriz Soria e Ignacio Luis Bastías"
date: "2023-12-27"
output:
  html_document:
    df_print: paged
---
Trabajo Final Diploma Universitario  en Ciencias Sociales Computacionales y Humanidades Digitales

# Introducción

## Preparación de los datos

## Se cargan las librerías a emplear

```{r librerias, warning=TRUE}

library(tidyverse)
library(tidytext)
library(tidymodels)
library(stm)
library(knitr)
library(themis)
# library(doParallel)
# library(topicmodels)
# library(tictoc)
# library(reshape2)

```
## Se carga el dataset de noticias provisto

```{r base_noticias}

noticias <- read_csv('M5_corpus_medios.csv')

noticias |> 
  slice(1:50) |> 
  head()

```

# Preprocesamiento de los datos
## Construimos la tabla de tokens del texto

```{r limpieza_noticias}

#Armado del listado de noticias que no contienen texto
noticias_vacias <- noticias |> 
  filter(is.na(texto))

# Uso de anti_join para eliminar esas noticias de la base "noticias"
noticias <- noticias |> 
  anti_join(noticias_vacias, by = c("titulo" = "titulo"))

# Armado del listado de noticias que tuvieron errores en el webscrapeo, ya que inician con "Article # download()' failed with" o con 'NoneType' object has no attribute 'find_all'

noticias_mal_descargadas <- noticias |> 
  # El ^ antes de artículo es una expresión regular para marcar que debe buscarse al inicio del título
  filter(str_detect(titulo, "^'NoneType'|^Article"))

# Usa anti_join para eliminar esas noticias de la base "noticias"
noticias <- noticias |> 
  anti_join(noticias_mal_descargadas, by = c("titulo" = "titulo"))

noticias <- noticias |> 
  # Elimina puntuación y valores numéros y, posteriormente, lleva todo a minúsculas
  mutate(texto = tolower(gsub("[[:punct:]0-9]", "", texto))) %>%
  # Elimina múltiples espaciados erróneamente ingresados
  mutate(texto = str_squish(texto))

# Arma el listado de noticias que, después de limpieza de caracteres, se considera que son demasiado cortas y producen "ruido" a la hora de evaluar las term frequency (TF)

noticias_cortas <- noticias |> 
  # "\\S+" es la expresión regular para detectar palabras con un espacio
  filter(str_count(texto, "\\S+") < 40)

# Usa anti_join para eliminar esas noticias de la base "noticias"
noticias <- noticias |> 
  anti_join(noticias_cortas, by = c("titulo" = "titulo"))

# Arma el listado de noticias de La Nación que tuvieron errores en el webscraping, ya que inician con "envía tu comentario ver legales los comentarios publicados son"

noticias_error_ln <- noticias |> 
  filter(str_detect(texto, "^envía tu comentario ver legales los comentarios publicados son"))

# Usa anti_join para eliminar esas noticias de la base "noticias"
noticias <- noticias |> 
  anti_join(noticias_error_ln, by = c("titulo" = "titulo"))

```

```{r noticias_tidy}

noticias_tidy <- noticias %>%
  unnest_tokens(input = texto, 
                output = word,
                token = "words") 

noticias_tidy |> 
  slice(1:50) |> 
  print()
```

## Cargamos el diccionario de stopwords y agregamos stopwords específicas

```{r diccionario_stopwords}

stop_words <- read_csv("https://raw.githubusercontent.com/Alir3z4/stop-words/master/spanish.txt", 
                       col_names=FALSE) %>%
        rename(word = X1) %>%
        mutate(word = stringi::stri_trans_general(word, "Latin-ASCII"))

stop_words |> 
  slice(1:50) |> 
  print()

stop_words <- stop_words %>%
  bind_rows(tibble(word = c("\tminutouno.com", "\tpáginai12", "a", "además", "además", "ahí", "allí", "ante", "año", "años", "así", "aún", "bajo", "comentar", "comentario", "como", "cómo", "compartir", "compartir", "con", "contra", "cronica.com.ar", "cronicacomar", "de", "desde", "después", "día", "días", "durante","él", "email", "embed", "en", "entre", "está", "están", "facebook", "fuente", "guardar", "gusta", "había", "hacia", "hasta", "jpe", "jpg", "l.l",      "leé", "loading", "mail", "más", "mediante", "minutouno.com", "nacion", "páginai", "páginai12", "para", "podría", "por", "pristupluk", "que", "qué", "según", "será", "si", "sí", "sin", "sobre", "sólo", "también", "tenía", "través", "twitter", "whatsapp", "fvazquezcronicacomar", "cronicavirales", "minutounocom", "telamla", "venturacrónica", "thieberger", "viercovich", "nersesian", "lucianobugner", "foglia", "jch", "failla", "foglia", "morenocrónica", "frannutti","bugner", "ernie", "zenteno", "nespolo", "marelli", "ll", "nutti", "massobrio","devito", "adami")))

```

## Procedemos a la eliminación de stopwords

```{r anti_join}
corpus_noticias <- noticias_tidy %>%
  anti_join(stop_words, 
            by = c("word" = "word"))

# Elimina ambos archivos porque ya no son necesarios
rm(stop_words, noticias_tidy)

corpus_noticias |> 
  slice(1:50) |> 
  print()
```

## Generamos una matriz token-por-fila para cada documento

```{r corpus_tf_idf_medio}

# Creamos un corpus centrado en los medios
corpus_tf_idf_medio <- corpus_noticias %>%
  count(medio, word, 
        sort = TRUE) %>%
  bind_tf_idf(term = word,
              # Al poner como "document" el medio, el idf expresa cuánto usa más un medio que otro 
              # ciertas palabras
              document = medio,
              n = n)

corpus_tf_idf_medio |> 
  slice_max(n = 50,
            order_by = tf,
            # En caso de empates ("tie"), por default la función trae ambos valores; lo seteamos
            # para que sólo traiga uno
            with_ties = FALSE) |> 
  print()

```

# Punto 1 

    - a) ¿Cuáles son las palabras más utilizadas en cada uno de los medios?
    - b) ¿Pueden verse diferencias? (tener en cuenta las diferentes métricas trabajadas en el curso: tf, tf-idf, etc.)
    - c) Generar las visualizaciones que considere más pertinentes para responder la pregunta

## Puntos a y b
### Armamos un corpus con las TF, IDF y las TF_IDF por medio
#### Buscamos las TF (las palabras más importantes/frecuentes)

```{r todos_los_medios}

 top_words_tf <- corpus_tf_idf_medio %>%
  group_by(medio) %>%
  slice_max(n = 10, 
            # Si seteamos otra variable en "order_by", obtenemos otra respuesta posible
            order_by = tf,
            with_ties = FALSE) %>%
  ungroup()
  
top_words_tf |>   
  print()

```

#### Buscamos las IDF (las palabras más informativas)

```{r}
top_words_idf <- corpus_tf_idf_medio %>%
  group_by(medio) %>%
  slice_max(n = 10, 
            # Si seteamos otra variable en "order_by", obtenemos otra respuesta posible
            order_by = idf,
            with_ties = FALSE) %>%
  ungroup()
  
top_words_idf |>   
  print()
```

#### Buscamos las TF_IDF (la frecuencia ponderada o ajustada por la importancia que tiene en el corpus)

```{r}
top_words_tf_idf <- corpus_tf_idf_medio %>%
  group_by(medio) %>%
  slice_max(n = 10, 
            # Si seteamos otra variable en "order_by", obtenemos otra respuesta posible
            order_by = tf_idf,
            with_ties = FALSE) %>%
  ungroup()
  
top_words_tf_idf  |>   
  print()
```
### C) Gráficos
#### Gráfico 1: Palabras más frecuentes (TF)

```{r grafico_palabras_frecuentes}
top_words_tf$medio <- factor(top_words_tf$medio, levels = c("clarin", "cronica", "infobae", "lanacion", "pagina12", "perfil", "telam", "minutouno"), labels = c("Clarín", "Crónica", "Infobae", "La Nación", "Página 12", "Perfil", "Télam", "Minuto Uno"))


ggplot(top_words_tf, aes(x = tf, 
                         y = word, 
                         fill = medio)) +
  geom_col(width = 0.7) +
  scale_fill_discrete(name = "Medio") +
  labs(x = "Frecuencia (TF) cada 1000 palabras", 
       y = "Término") +
  facet_wrap(~medio, scales = "free_y") +
  theme_minimal() +
  theme(legend.position = "none",
        axis.text.y = element_text(size = 7)) +  # Ajustar el tamaño de las etiquetas del eje y
  labs(title = "Las 10 palabras más utilizadas por medio",
       subtitle = "Julio - Septiembre 2019", 
       caption = "Gráfico 1")

```

#### Tabla 1: Palabras de mayor frecuencia ajustadas por la importancia que tienen en el corpus (tf_idf)

```{r tabla_palabras_informativas}
top_words_idf %>%
  select(medio, word, idf) %>% 
  kable(caption = "Top 10 palabras por IDF en cada medio")

```
#### Gráfico 2: Palabras de mayor frecuencia ajustadas por la importancia que tiene en el corpus (tf_idf)

```{r grafico_palabras_informativas}
ggplot(top_words_tf_idf, aes(x = tf_idf *1000, 
                             y = word, 
                             fill = medio)) +
  geom_col() +
  scale_fill_discrete(name = "Medio") +
  labs(x = "TF-IDF cada 1000 palabras", 
       y = "Palabra") +
  facet_wrap(~medio, scales = "free_y") +
  theme_minimal()+
  theme(legend.position = "none") +
  labs(title = "Las 10 palabras más informativas en cada medio",
       subtitle = "Julio - Septiembre 2019", 
       caption = "Gráfico 2" )

```

#### Gráfico 3: Las 3 palabras más utilizadas en los medios

```{r}

 top_words_tf_ok <- corpus_tf_idf_medio %>%
  group_by(medio) %>%
  slice_max(n = 3, 
            order_by = tf,
            with_ties = FALSE) %>%
  ungroup()

ggplot(top_words_tf_ok, aes(x = tf*1000, 
                             y = word, 
                             fill = medio)) +
  geom_col() +
  scale_fill_discrete(name = "Medio") +
  labs(x = "TF-IDF cada 1000 palabras", 
       y = "Palabra") +
  facet_wrap(~medio, scales = "free_y") +
  theme_minimal()+
  theme(legend.position = "none") +
  labs(title = "Las 3 palabras más informativas en cada medio",
       subtitle = "Julio - Septiembre 2019", 
       caption = "Gráfico 3" )
```





```{r elimina_objetos_punto1}
# Elimina objetos que ya no necesitamos
rm(top_words_tf, top_words_idf, top_words_tf_idf, corpus_tf_idf_medio,top_words_tf_ok, noticias_vacias, noticias_mal_descargadas, noticias_cortas, noticias_error_ln)
```

# Punto 2 

    - a) ¿Cuáles son los tópicos principales en el corpus?
    - b) ¿Pueden evidenciar diferencias en cada uno de los medios? Explicar qué método se utilizó para responder la pregunta y cuáles son los supuestos del mismo
    - c) Generar las visualizaciones más adecuadas para responder a las preguntas

## Trabajo con modelo Latent Dirichlet Allocation (LDA)

```{r corpus_tf_idf_noticia}

# Creamos un corpus, pero esta vez centrados en los títulos
corpus_tf_idf_noticia <- corpus_noticias |> 
  count(titulo, word, 
        sort = TRUE) |> 
  bind_tf_idf(term = word,
              # Al poner como "document" el titulo, el idf expresa cuánto usa más un titulo que otro 
              # ciertas palabras
              document = titulo,
              n = n)

corpus_tf_idf_noticia |> 
  slice_max(n = 500,
            order_by = tf_idf,
            # En caso de empates ("tie"), por default la función trae ambos valores; lo seteamos
            # para que sólo traiga uno
            with_ties = FALSE) |> 
  print()

```

### Document Term Matrix (DTM) del corpus de noticias

```{r corpus_dtm}

# Creación de la Document Term Matrix (DTM) del corpus de noticias
corpus_dtm <- corpus_tf_idf_noticia %>%
  cast_dtm(term = word,
           document = titulo, 
           value = n)

# La cantidad de documentos y de palabras parece coincidir con la del corpus
corpus_dtm |> 
  print()

```

Ejecutamos el LDA con 7 tópicos

```{r modelo_topicos, eval=FALSE, include=FALSE}

# El encabezado de este código está seteado por default para no correr; así, cuando se pone "Run all code", este paso se saltea

modelo_armado <- topicmodels::LDA(corpus_dtm, 
                              k = 7, 
                              control = list(seed = 1234567))

write_rds(modelo_armado, 'models/LDA7.rds')

```
 

```{r modelo_topicos_carga}

# Como se saltea el paso anterior, se carga el modelo que ya está guardado en la carpeta de "models"

modelo_armado <- read_rds('models/LDA7.rds')

```

```{r prob_x_palabra}
                  # Si esta línea tira algún error, hagan install.packages("reshape2")
palabras_topicos <- tidy(modelo_armado, matrix = "beta") 

#Lo pasamos a porcentajes
palabras_topicos %>%
  mutate(beta = round(100*beta, 6))

```

### Gráfico 4: Principales palabras por tópico en LDA

Visualizamos las principales palabras por tópico en LDA

```{r top_palabras_topico}

# Agrupamos por tópicos y seleccionamos las principales 15 palabras de cada uno

top_palabras_topicos <- palabras_topicos %>%
  group_by(topic) %>%
  slice_max(beta, n = 15) %>% 
  ungroup() %>%
  arrange(topic, -beta) %>%
  select(topic, term, beta) %>%
  mutate(topic = case_when(
    topic == 1 ~ "1.Policiales",
    topic == 2 ~ "2.Política internacional",
    topic == 3 ~ "3.Economía y finanzas",
    topic == 4 ~ "4.Cultura y entretenimiento",
    topic == 5 ~ "5.Justicia y Seguridad",
    topic == 6 ~ "6.Política nacional y elecciones",
    topic == 7 ~ "7.Deportes",
    TRUE ~ as.character(topic)
  ))

grafico4 <- top_palabras_topicos %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(x = beta * 1000, 
             y = term, 
             fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales='free_y') +
  scale_y_reordered() +
  labs(x = "Probabilidad de aparición en una noticia cada 1000 palabras", 
       y = "Términos") +
  theme_minimal() +
  labs(title = "Principales palabras por tópicos según modelo LDA",
       caption = "Gráfico 4",
       plot.title = element_text(size = 10))

print (grafico4)

# Guardamos el gráfico en la carpeta "Graficos"
ggsave(filename = "Graficos/Grafico4.png", plot = grafico4, width = 8, height = 6)


```

Para observar qué probabilidad tiene cada noticia de pertenecer a cada tópico y analizar en detalle el tópico 4

```{r noticias_x_topico}

# El gamma es el valor de probabilidad de cada noticia de pertenecer a cierto tópico
topicos_noticias <- tidy(modelo_armado, matrix = "gamma")

```

Para observar qué títulos aparecen en las noticias del tópico 4


```{r top_noticias_x_topico, eval=FALSE, include=FALSE}

# Este código no se corre, es sólo para revisar qué noticias pertenecen más probablemente a un tópico (ej: tópico 4)


# Para observar qué títulos aparecen en las noticias del tópico 4
topicos_noticias |>
  filter(topic == 4) %>%
  filter(gamma > 0.9) |> 
  mutate(gamma = round(gamma, 5)) |> 
  View()

```


Para observar cuáles noticias no parecen ajustarse bien en ninguno de los tópicos posibles.


```{r noticias_poco_clasificables, eval=FALSE, include=FALSE}

# Este código no se corre, es sólo para revisar qué noticias no estarían perteneciendo claramente a ningún tópico

topicos_noticias |> 
  # Ponemos un umbral de bajas chances de encajar en cualquier tópico
  filter(gamma < 0.3) |> 
  # Contamos cuántos son los documentos que cumplen la condición anterior (porque si encajan perfecto en un tópico, es obvio que en los otros no encajan)
  count(document) |> 
  # Si aparece 7 veces el título, es que en los 7 tópicos tiene menos de un 30% de chances
  filter(n == 7) |> 
  View()

```


```{r grafico 5}

# Obtener los datos de los tópicos por medio
topicos_por_medio <- topicos_noticias %>%
  rename(titulo = document) %>% 
  left_join(noticias %>% select(titulo, medio) %>% unique()) %>%
  group_by(medio, topic) %>%
  summarise(mean = mean(gamma) * 100)

# Renombrar las etiquetas de los tópicos
nombres_topicos <- c("1.Policiales" = "Policiales",
                     "2.Política internacional" = "Política internacional",
                     "3.Economía y finanzas" = "Economía y finanzas",
                     "4.Cultura y entretenimiento" = "Cultura y entretenimiento",
                     "5.Justicia y Seguridad" = "Justicia y Seguridad",
                     "6.Política nacional y elecciones" = "Política nacional y elecciones",
                     "7.Deportes" = "Deportes")

# Crear el gráfico facetado por tópico

grafico5 <- ggplot(topicos_por_medio, aes(x = factor(medio), y = mean)) +
  geom_col(aes(fill = medio), position = "dodge") +
  facet_wrap(~ factor(topic, labels = nombres_topicos), scales = "free") +
  theme_minimal() +
  theme(legend.position = "none",  
        axis.text.x = element_text(angle = 45, hjust = 1),
        panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank()) +  
  labs(x = "Medio", 
       y = "Porcentaje (%)",
       title = "Tópicos por medio según modelo LDA", 
       caption = "Gráfico 5")

print(grafico5)

ggsave(filename = "Graficos/Grafico5.png", plot = grafico5, width = 8, height = 6)
```

### Tópicos resultantes LDA 
Tópico 1: Policiales
Tópico 2: Política internacional
Tópico 3: Economía y finanzas
Tópico 4: Cultura y entretenimiento
Tópico 5: Justicia y Seguridad 
Tópico 6: Política nacional y elecciones
Tópico 7: Deportes 

## Alternativa con  Structural Topic Modeling (STM)
Todos estos chunks están configurados para que no corran cuando se corre todo el código. Sin embargo, dan como resultado tópicos similares a los que se logra con LDA.

Construimos una DFM
```{r}

word_counts <- corpus_noticias %>%  
        group_by(id,word) %>%
        summarise(n = n()) %>%
        ungroup()

noticias_dfm <- word_counts %>%
                cast_dfm(id, word, n)

noticias_dfm

```

Entrenamos el DFM y establecemos la misma cantidad de tópicos que con LDA: 7 tópicos

```{r}

metadata <- corpus_noticias %>%  
        group_by(id,medio ) %>%
        summarise(n = n()) %>%
        ungroup()

```


```{r eval=FALSE, include=FALSE}

stm_7 <- stm(documents = noticias_dfm,
             K = 7,
             prevalence = ~ medio,
             max.em.its = 75, 
             data = metadata,
             init.type = "Spectral")

write_rds(stm_7, 'models/stm_7_prev_cont.rds')

```

```{r}

stm_7 <- read_rds('models/stm_7_prev_cont.rds')

```


Generamos la matriz beta y theta

```{r}

betas_stm <- tidy(stm_7, matrix = 'beta')
tetha_stm <- tidy(stm_7, matrix = 'theta')

```

### Gráfico 6: Principales palabras por tópico en STM


```{r}

grafico6 <- betas_stm %>%
  group_by(topic) %>%
  slice_max(beta, n = 15) %>% 
  ungroup() %>%
  arrange(topic, -beta) %>%
  mutate(term = reorder_within(term, beta, topic),
         topic = case_when(
           topic == 1 ~ "1.Política nacional y elecciones",
           topic == 2 ~ "2.Política internacional",
           topic == 3 ~ "3.Economía",
           topic == 4 ~ "4.Astrología, salud y ciencia",
           topic == 5 ~ "5.Justicia y seguridad",
           topic == 6 ~ "6.Cultura y entretenimiento",
           topic == 7 ~ "7.Deportes",
           TRUE ~ as.character(topic))) %>%
  ggplot(aes(beta, term, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales='free_y') +
  scale_y_reordered() +
  theme_minimal() +
  labs(title = "Principales palabras por Tópico según modelo STM", 
       caption = "Gráfico 6",
       plot.title = element_text(size = 10))

  print(grafico6)

# Guardar el gráfico como un archivo
ggsave(filename = "Graficos/Grafico6.png", 
       plot = grafico6, 
       width = 8, height = 6)

```


```{r}

theta_stm_7 <- tetha_stm %>%
  rename(id = document) %>%
  left_join(metadata)
 
```

### Gráfico 7: Principales palabras por tópico según medio en STM 

```{r}

grafico7 <- theta_stm_7 %>%
  group_by(medio, topic) %>%
  summarise(mean = mean(gamma)) %>%
  drop_na() %>%
  ggplot(aes(x=medio, y=mean, fill=medio)) + 
    geom_col(position='dodge') +
    facet_wrap(~case_when(
           topic == 1 ~ "1.Política nacional y elecciones",
           topic == 2 ~ "2.Política internacional",
           topic == 3 ~ "3.Economía",
           topic == 4 ~ "4.Astrología, salud y ciencia",
           topic == 5 ~ "5.Justicia y seguridad",
           topic == 6 ~ "6.Cultura y entretenimiento",
           topic == 7 ~ "7.Deportes",
           TRUE ~ as.character(topic)), scales = "free_y", strip.position = "bottom")+     theme_minimal() +
    theme(legend.position = "none",  # Quitar la leyenda de medio
          axis.text.x = element_text(angle = 45, hjust = 1)) +  # Ajustar las etiquetas del eje x
    labs(title = "Tópicos por medio según modelo STM", 
       caption = "Gráfico 7",  
         plot.title = element_text(size = 14))

print(grafico7)


ggsave(filename = "Graficos/Grafico7.png", 
       plot = grafico7, 
       width = 8, height = 6)

```

```{r eval=FALSE, include=FALSE}

labelTopics(stm_7)

```

### Tópicos resultantes 
    - Tópico 1: Política nacional y elecciones
    - Tópico 2: Política internacional
    - Tópico 3: Economía y finanzas
    - Tópico 4: Astrología, salud y ciencia 
    - Tópico 5: Justicia y seguridad
    - Tópico 6: Cultura y entretenimiento
    - Tópico 7: Deportes


# Punto 3

A continuación, seleccionar las noticias vinculadas a algún tópico relevante (por ejemplo, “Elecciones”) y construir un clasificador para predecir la orientación del diario. Utilizar alguno de los modelos de clasificación vistos a lo largo de al Diplomatura (regresión logística, random forest, etc.). 
Utilizar como features el “Spanish Billion Word Corpus and Embeddings”, analizado en clase. ¿Qué resultados arroja el modelo? ¿Es posible mediante el texto de las noticias conocer la línea editorial del diario? 
Generar las visualizaciones y tablas correspondientes para una correcta evaluación del modelo.

## Armado del corpus

Selección de noticias del tópico 6 política/elecciones del modelo LDA

```{r noticias_topico_6}

# Creamos el objeto con las noticias que más probablemente (70% de probabilidad) pertenecen al tópico 6, que es el que trata sobre política/ elecciones

noticias_topico_6 <- topicos_noticias |> 
  mutate(gamma = round(gamma, 6)) |> 
  filter(topic == 6,
         gamma > 0.7)

```

## Elimina objetos previos

```{r elimina_objetos_punto3}

# Elimina todos los objetos excepto los necesarios para la consigna 3

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```

## Carga del embedding

Vamos a usar un embedding para predecir la orientación en función del texto de la noticia. En particular, el mismo está entrenado mediante el algoritmo wor2vec por C. Cardelino. Está entrenado sobre un corpus grande en español. Disponible en https://crscardellino.ar/SBWCE/
Primero escribirmos la función que carga el embedding y después la ejecutamos:

```{r carga_embedding}

load_embeddings <- function(path=NULL, type=c("w2v", "ft")){
        if (type=="w2v"){
                embedding <- word2vec::read.wordvectors(path, 
                                                        type = "bin", 
                                                        normalize = TRUE) %>%
                        as_tibble(rownames="word")
        }
        else if (type=="ft"){
                model <- fastTextR::ft_load(path)
                words <- fastTextR::ft_words(model)
                embedding <- fastTextR::ft_word_vectors(model,
                                                        words) %>%
                        as_tibble(rownames="word")
        }
        
        return(embedding)
}


embedding <- load_embeddings(path = "embedding/SBW-vectors-300-min5.bin/sbw_vectors.bin",
                             type = "w2v")

```
Vamos a realizar distintas pruebas con dos modelos de clasificación (Random Forest y Regresión logística regularizada por LASSO), realizando combinaciones de variables e hiperparámétros.

# PRUEBA 1	RANDOM FOREST
    - Se excluye de la variable orientación, las observaciones que corresponden a la categoría "neutro"
    - Sin variable “medio”
    - Sin balancear en la receta por orientación

        **Curva Roc sobre train:  0.7544600 **
        **Curva Roc sobre test:  0.6693104 **

## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r corpus_noticias_t6}

# Se arma el objeto "corpus_noticias_t6", con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/elecciones), a lo cual se suman el texto y la orientación del medio de la noticia.

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id, 
         #medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |> 
  filter(orientacion != "neutro") |> 
  mutate(orientacion = factor(orientacion,
                              levels = c("conservador", "progresista"))) 
                              

table(corpus_noticias_t6$orientacion)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación.

```{r preprocesamiento1}

## No vamos a pasar a minúscula  y tampoco vamos a eliminar caracteres no ASCII para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 |>
        
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) |> 
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```


```{r tokenización1}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```

### Embedding: de palabra a noticia

```{r union_embedding1}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension1}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, orientacion) %>%
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```

## Preparación del modelado

### Partición de los datos en entrenamiento (train) y prueba (test)

```{r spliteo1}

set.seed(1234)

noticias_split <- initial_split(noticias_c_embedding,
                                strata = orientacion)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$orientacion)

```

### Elaboración de la receta

```{r receta1}

# Especificación de la receta
receta <- train_embed |> 
  recipe(orientacion ~ .) |> 
  update_role("title_id", new_role = "id")
  # No balanceamos
  #step_downsample(orientacion, under_ratio = 1)

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta)

```

### Tuneo

Los hiperparámetros a definir son:
      -`trees`: define el número de árboles que se van a establecer
      -`mtry`: cantidad de variables que se van a probar en cada iteración
      -`min_n`: mínima cantidad de observaciones que tiene que haber en cada nodo

```{r hiperparametros1}

# Se establece el modelo a tunear
modelo_a_tunear <- rand_forest(trees = 1000,
                               mtry = tune(),
                               min_n = tune()) %>%
  set_mode("classification") %>%
  set_engine("ranger")

# Se agrega al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation1}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r combinaciones_hiperparametros1, eval=FALSE, include=FALSE}
tictoc::tic()

# Entrenamiento del modelo con distintas combinaciones de hiperparámetros
a_tunear_1 <- tune_grid(object = wf,
                        resamples = embed_folds,
                        grid = 30,
                        metrics = metric_set(precision, recall,
                                              roc_auc, f_meas))

write_rds(a_tunear_1, 'models/a_tunear_1.rds')

tictoc::toc()

```

```{r combinaciones_carga1}

a_tunear_1 <- read_rds('models/a_tunear_1.rds')

```


## Métricas y elección de hiperparámetros

```{r métricas1}

# Muestra las métricas en una tibble
a_tunear_1 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot1}

a_tunear_1 |> 
  autoplot() +
  theme_minimal()

```

```{r}

# Se muestran los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_1, "roc_auc")

```

Si bien no se muestra aquí, probamos con  otros parámetros posibles por si los hiperparámetros pudiesen generar un problema de overfitting. Pero en el set de test, la mejor curva ROC corresponde simultáneamente a los hiperparámetros que producen la mejor curva ROC en el set de train.

```{r parametros_finales1}

#best_ROC <- show_best(a_tunear_1, "roc_auc") |> 
#  filter(mtry == 118 &
#         min_n == 14)

best_ROC <- select_best(a_tunear_1,
                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_rf <- finalize_model(modelo_a_tunear,
                           best_ROC)

# Modelo final
final_rf

```

## Entrenamiento del modelo final

```{r fit_final1}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_rf) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```


## Evaluación sobre test

```{r fit_en_test1}

# Creamos un nuevo flujo de trabajo, agregamos la receta y el modelo y ajustamos a los datos de entrenamiento
tree_fit <- workflow() %>%
  add_recipe(receta) %>%
  add_model(final_rf) %>%
  fit(data = train_embed)

```


```{r prediccion1}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(tree_fit, test_embed, type="prob")) %>%
        bind_cols(predict(tree_fit, test_embed, type="class"))


print(preds_embed)

```


```{r metricas1_test}

metricas_1 <- roc_auc(preds_embed, orientacion, .pred_conservador) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_1")

metricas_1

```

## Elimina objetos previos

```{r}

# Elimina todos los objetos excepto los necesarios para el siguiente modelo

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias", "embedding", "metricas_1")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```


# PRUEBA 2 RANDOM FOREST
    - Excluye de la variable orientación la categoría "neutro" 
    - Con variable medio
    - Balanceando en la receta por medio	

        **Curva Roc sobre train: 0.7444554**
        
        **Curva Roc sobre test: 0.7472527** 15	2
                              **0.7490110** 118	14
                              **0.7384615** 30	12
                              **0.7428571** 65	22
                              **0.7498901** 41	20

## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r}

# Se arma el objeto "corpus_noticias_t6", que con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/ elecciones), a lo cual se suman el texto, el medio y la orientación del medio del cual sale la noticia

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id,
         medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |>
  filter(orientacion != "neutro")|> 
  mutate(orientacion = factor(orientacion,
                              levels = c("conservador", "progresista")))
                             

table(corpus_noticias_t6$medio)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación

```{r preprocesamiento2}

## No vamos a pasar a minúscula nada y tampoco vamos a eliminar caracteres no ascii para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 |>
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) |> 
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```


```{r tokenización2}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```

### Embedding: de palabra a noticia

```{r union_embedding2}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico, con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension2}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, medio, orientacion) %>% 
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```


## Preparación del modelado (Prueba 2)

### Partición de los datos en entrenamiento (train) y prueba (test)

```{r spliteo2}

set.seed(1234)

noticias_split <- initial_split(noticias_c_embedding, 
                                strata = medio)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$medio)

```

### Elaboración de la receta

```{r receta2}

# Especificación de la receta
receta <- train_embed |> 
  recipe(orientacion ~ .) %>%
  step_rm(medio) |> 
  update_role("title_id", new_role = "ID") %>% 
  step_downsample(orientacion,
                  under_ratio = 1)
  

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta)

```


### Tuneo

Los hiperparámetros a definir son:
      -`trees`: define el número de árboles que se van a establecer
      -`mtry`: cantidad de variables que se van a probar en cada iteración
      -`min_n`: mínima cantidad de observaciones que tiene que haber en cada nodo

```{r hiperparametros2}

# Establecimiento del modelo a tunear
modelo_a_tunear <- rand_forest(trees = 1000,
                               mtry = tune(),
                               min_n = tune()) %>%
  set_mode("classification") %>%
  set_engine("ranger")


# Se agrega al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation2}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r combinaciones_hiperparametros2, eval=FALSE, include=FALSE}

tictoc::tic()

# Entreno el modelo con distintas combinaciones de hiperparámetros
a_tunear_2 <- tune_grid(wf,
                        resamples = embed_folds,
                        grid = 30,
                        metrics = metric_set(precision, recall,
                                             roc_auc, f_meas))

write_rds(a_tunear_2, 'models/a_tunear_2.rds')

tictoc::toc()

```

```{r combinaciones_carga2}

a_tunear_2 <- read_rds('models/a_tunear_2.rds')

```


## Métricas y elección de hiperparámetros

```{r métricas2}

# Muestra las métricas en una tibble
a_tunear_2 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot2}

a_tunear_2 |> 
  autoplot() +
  theme_minimal()

```

```{r}

# Mostramos los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_2, "roc_auc")

```

Si bien no se muestra, probamos con los otros parámetros posibles por si los hiperparámetros pudiesen generar un problema de overfitting. Pero en el set de test, la mejor curva ROC corresponde simultáneamente a los hiperparámetros que producen la mejor curva ROC en el set de train

```{r parametros_finales2}

# best_ROC <- show_best(a_tunear_2, "roc_auc") |> 
#  filter(mtry == 118 &
#         min_n == 14)

best_ROC <- select_best(a_tunear_2,
                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_rf <- finalize_model(modelo_a_tunear,
                           best_ROC)

# Modelo final
final_rf

```

## Entrenamiento modelo final

```{r fit_final2}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_rf) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```


## Evaluación sobre test

```{r fit_en_test2}

# Crear un nuevo flujo de trabajo, agregar la receta y el modelo, y ajustar al conjunto de datos de entrenamiento en una sola línea
tree_fit <- workflow() %>%
  add_recipe(receta) %>%
  add_model(final_rf) %>%
  fit(data = train_embed)

```


```{r prediccion2}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(tree_fit, test_embed, type="prob")) %>%
        bind_cols(predict(tree_fit, test_embed, type="class"))

print(preds_embed)

```


```{r metricas2_test}

metricas_2 <- roc_auc(preds_embed, orientacion, .pred_conservador) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_2")

metricas_2

```


## Elimina objetos previos

```{r elimina_objetos_previos}

# Elimina todos los objetos excepto los necesarios para el siguiente modelo

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias", "embedding", "metricas_1", "metricas_2")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```




# PRUEBA 3	REGRESIÓN LOGÍSTICA LASSO:
    - Excluye orientación "neutro"
    - Sin balancear en la receta por orientación 

        **Curva Roc sobre train:  0.7066328 **
        **Curva Roc sobre test:  0.6992730 **


## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r}

# Se arma el objeto "corpus_noticias_t6", que con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/ elecciones), a lo cual se suman el texto y la orientación del medio del cual sale la noticia

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id, 
         #medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |> 
  filter(orientacion != "neutro") |> 
  mutate(orientacion = factor(orientacion,
                              levels = c("conservador", "progresista"))) 
                              #levels = c("conservador", "neutro", "progresista")))

table(corpus_noticias_t6$orientacion)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación.

```{r preprocesamiento3}

## No vamos a pasar a minúscula nada y tampoco vamos a eliminar caracteres no ASCII para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 %>% 
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) %>%
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```

```{r tokenización3}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```

### Embedding: de palabra a noticia

```{r union_embedding3}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico, con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension3}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, orientacion) %>% 
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```

## Preparación del modelado (Prueba 3)

### Partición de los datos en entrenamiento (train) y prueba (test)


```{r spliteo3}

set.seed(1234)

noticias_split <- initial_split(noticias_c_embedding, 
                                strata = orientacion)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$orientacion)

```


### Elaboración de la receta

```{r receta3}

# Se específica la receta
receta_lasso <- train_embed |> 
  recipe(orientacion ~ .) %>%
  update_role("title_id", new_role = "ID")
  #step_downsample(orientacion,
  #                under_ratio = 1)
  

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta_lasso)

```


### Tuneo


```{r hiperparametros3}

# Establecimiento  del modelo a tunear
modelo_a_tunear <- logistic_reg(penalty = tune(),
                                mixture = 1) %>%
  set_mode("classification") %>%
  set_engine("glmnet")


# Se agrega al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation3}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r}

# Se especifica la grilla
grid_lasso <- grid_regular(penalty(),
                           levels = 30)

```

```{r combinaciones_hiperparametros3, eval=FALSE, include=FALSE}

tictoc::tic()

# Entrenamiento del modelo con distintas combinaciones de hiperparámetros
a_tunear_3 <- tune_grid(wf,
                        resamples = embed_folds,
                        grid = grid_lasso,
                        control = control_resamples(save_pred = TRUE))
                        #metrics = metric_set(precision, recall,
                        #                     roc_auc, f_meas))



write_rds(a_tunear_3, 'models/a_tunear_3.rds')

tictoc::toc()

```

```{r combinaciones_carga3}

a_tunear_3 <- read_rds('models/a_tunear_3.rds')

```


## Métricas y elección hiperparámetros

```{r métricas3}

# Muestra las métricas en una tibble
a_tunear_3 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot3}

#a_tunear_3 |> 
  #autoplot() +
  #theme_minimal()
  
```

```{r}

# Mostramos los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_3, "roc_auc")

```

Si bien no se muestra, seleccionamos el cuarto valor de penalty, ya que se obtiene, aplicando el modelo sobre el set de test, una curva ROC más alta.

```{r parametros_finales3}

best_ROC <- show_best(a_tunear_3, "roc_auc") |> 
  filter(.config == "Preprocessor1_Model23")

# best_ROC <- select_best(a_tunear_3,
#                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_lasso <- finalize_model(modelo_a_tunear,
                              best_ROC)

# Modelo final
final_lasso

```

## Entrenamiento modelo final

```{r fit_final3}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_lasso) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```


## Evaluación sobre test

```{r fit_en_test3}

# Crear un nuevo flujo de trabajo, agregar la receta y el modelo, y ajustar al conjunto de datos de entrenamiento en una sola línea
lasso_fit <- workflow() %>%
  add_recipe(receta_lasso) %>%
  add_model(final_lasso) %>%
  fit(data = train_embed)

```


```{r prediccion3}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(lasso_fit, test_embed, type="prob")) %>%
        bind_cols(predict(lasso_fit, test_embed, type="class"))

print(preds_embed)

```


```{r metricas3_test}

# Calcular las métricas de evaluación
metricas_3 <- roc_auc(preds_embed, orientacion, .pred_conservador) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_3")

metricas_3

```


## Elimina objetos previos

```{r elimina_objetos}

# Elimina todos los objetos excepto los necesarios para el siguiente modelo

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias", "embedding", "metricas_1", "metricas_2", "metricas_3")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```



# PRUEBA 4	RANDOM FOREST
    - Orientación dicotómica conservador vs no conservador (incluye neutro y progresista)
    - Balanceando en la receta por orientación	

        **Curva Roc sobre train: 0.6609971**
        **Curva Roc sobre test: 0.6949003**


## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r}

# Se arma el objeto "corpus_noticias_t6", que con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/ elecciones), a lo cual se suman el texto, el medio y la orientación del medio del cual sale la noticia

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id,
         medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |>
  # filter(orientacion != "neutro") |> 
  mutate(orientacion = ifelse(orientacion %in% c('progresista', 'neutro'), 'no conservador', 'conservador')) |>
  mutate(orientacion = factor(orientacion,
                            levels = c("conservador", "no conservador")))


table(corpus_noticias_t6$orientacion)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación

```{r preprocesamiento4}

## No vamos a pasar a minúscula nada y tampoco vamos a eliminar caracteres no ascii para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 |>
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) |> 
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```

```{r tokenización4}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```


### Embedding: de palabra a noticia

```{r union_embedding4}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico, con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension4}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, medio, orientacion) %>%
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```

## Preparación del modelado (Prueba 4)

### Partición de los datos en entrenamiento (train) y prueba (test)

```{r spliteo4}

set.seed(1234)

noticias_split <- initial_split(noticias_c_embedding, 
                                strata = medio)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$medio)

```

### Elaboración de la receta

```{r receta4}

# Se específica la receta
receta <- train_embed |> 
  recipe(orientacion ~ .) %>%
  step_rm(medio) |> 
  update_role("title_id", new_role = "ID") %>% 
  step_downsample(orientacion,
                  under_ratio = 1)
  

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta)

```


### Tuneo

Los hiperparámetros a definir son:
      -`trees`: define el número de árboles que se van a establecer
      -`mtry`: cantidad de variables que se van a probar en cada iteración
      -`min_n`: mínima cantidad de observaciones que tiene que haber en cada nodo

```{r hiperparametros4}

# Establezco el modelo a tunear
modelo_a_tunear <- rand_forest(trees = 1000,
                               mtry = tune(),
                               min_n = tune()) %>%
  set_mode("classification") %>%
  set_engine("ranger")


# Se agrega al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation4}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r combinaciones_hiperparametros4, eval=FALSE, include=FALSE}

tictoc::tic()

# Entreno el modelo con distintas combinaciones de hiperparámetros
a_tunear_4 <- tune_grid(wf,
                        resamples = embed_folds,
                        grid = 30,
                        metrics = metric_set(precision, recall,
                                             roc_auc, f_meas))

write_rds(a_tunear_4, 'models/a_tunear_4.rds')

tictoc::toc()

```

```{r combinaciones_carga4}

a_tunear_4 <- read_rds('models/a_tunear_4.rds')

```


## Métricas y elección hiperparámetros

```{r métricas4}

# Muestra las métricas en una tibble
a_tunear_4 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot4}

a_tunear_4 |> 
  autoplot() +
  theme_minimal()

```

```{r}

# Mostramos los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_4, "roc_auc")

```

Si bien no se muestra, probamos con los otros parámetros posibles por si los hiperparámetros pudiesen generar un problema de overfitting. Pero en el set de test, la mejor curva ROC corresponde simultáneamente a los hiperparámetros que producen la mejor curva ROC en el set de train

```{r parametros_finales4}

#best_ROC <- show_best(a_tunear_4, "roc_auc") |> 
#  filter(mtry == 113 &
#         min_n == 5)

best_ROC <- select_best(a_tunear_4,
                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_rf <- finalize_model(modelo_a_tunear,
                           best_ROC)

# Modelo final
final_rf

```


## Entrenamiento modelo final

```{r fit_final4}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_rf) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```

## Evaluación sobre test

```{r fit_en_test4}

# Crear un nuevo flujo de trabajo, agregar la receta y el modelo, y ajustar al conjunto de datos de entrenamiento en una sola línea
tree_fit <- workflow() %>%
  add_recipe(receta) %>%
  add_model(final_rf) %>%
  fit(data = train_embed)

```


```{r prediccion4}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(tree_fit, test_embed, type="prob")) %>%
        bind_cols(predict(tree_fit, test_embed, type="class"))

print(preds_embed)

```


```{r metricas4_test}

metricas_4 <- roc_auc(preds_embed, orientacion, .pred_conservador) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_4")

metricas_4

```


## Elimina objetos previos

```{r}

# Elimina todos los objetos excepto los necesarios para el siguiente modelo

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias", "embedding", "metricas_1", "metricas_2", "metricas_3", "metricas_4")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```



# PRUEBA 5	REGRESIÓN LOGÍSTICA LASSO
    - Con variable orientación dicotómica conservador vs no conservador (incluye neutro y progresista)
    - Balanceando en la receta por orientación	

        **Curva Roc sobre train: 0.7143954**
        **Curva Roc sobre test: 0.6704384**
        

## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r}

# Se arma el objeto "corpus_noticias_t6", que con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/ elecciones), a lo cual se suman el texto, el medio y la orientación del medio del cual sale la noticia

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id,
         medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |>
  # filter(orientacion != "neutro") |> 
  mutate(orientacion = ifelse(orientacion %in% c('progresista', 'neutro'), 'no conservador', 'conservador')) |>
  mutate(orientacion = factor(orientacion,
                            levels = c("conservador", "no conservador")))


table(corpus_noticias_t6$orientacion)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación

```{r preprocesamiento5}

## No vamos a pasar a minúscula nada y tampoco vamos a eliminar caracteres no ascii para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 |>
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) |> 
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```

```{r tokenización5}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```

### Embedding: de palabra a noticia

```{r union_embedding5}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico, con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension5}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, medio, orientacion) %>%
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```

## Preparación del modelado (Prueba 5)

### Partición de los datos en entrenamiento (train) y prueba (test)


```{r spliteo5}

set.seed(1234)

noticias_split <- initial_split(noticias_c_embedding, 
                                strata = orientacion)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$medio)

```


### Elaboración de la receta

```{r receta5}

# Se especifica la receta
receta_lasso <- train_embed |> 
  recipe(orientacion ~ .) %>%
  update_role("title_id", new_role = "ID") |> 
  step_rm(medio) |> 
  step_downsample(orientacion,
                 under_ratio = 1)
  

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta_lasso)

```

### Tuneo

      
```{r hiperparametros5}

# Establecimiento del modelo a tunear
modelo_a_tunear <- logistic_reg(penalty = tune(),
                                mixture = 1) %>%
  set_mode("classification") %>%
  set_engine("glmnet")


# Se agrega al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation5}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r}

# Se especifica la grilla
grid_lasso <- grid_regular(penalty(),
                           levels = 30)

```

```{r combinaciones_hiperparametros5, eval=FALSE, include=FALSE}

tictoc::tic()

# Entrenamiento  del modelo con distintas combinaciones de hiperparámetros
a_tunear_5 <- tune_grid(wf,
                        resamples = embed_folds,
                        grid = grid_lasso,
                        control = control_resamples(save_pred = TRUE))
                        #metrics = metric_set(precision, recall,
                        #                     roc_auc, f_meas))



write_rds(a_tunear_5, 'models/a_tunear_5.rds')

tictoc::toc()

```

```{r combinaciones_carga5}

a_tunear_5 <- read_rds('models/a_tunear_5.rds')

```


## Métricas y elección hiperparámetros

```{r métricas5}

# Muestra las métricas en una tibble
a_tunear_5 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot5}

#a_tunear_5 |> 
  #autoplot() +
  #theme_minimal()

```

```{r}

# Mostramos los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_5, "roc_auc")

```

Si bien no se muestra, seleccionamos el cuarto valor de penalty, ya que se obtiene, aplicando el modelo sobre el set de test, una curva ROC más alta.

```{r parametros_finales5}

#best_ROC <- show_best(a_tunear_5, "roc_auc") |> 
#  filter(.config == "Preprocessor1_Model25")

best_ROC <- select_best(a_tunear_5,
                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_lasso <- finalize_model(modelo_a_tunear,
                              best_ROC)

# Modelo final
final_lasso

```


## Entrenamiento modelo final

```{r fit_final5}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_lasso) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```

## Evaluación sobre test

```{r fit_en_test5}

# Crear un nuevo flujo de trabajo, agregar la receta y el modelo, y ajustar al conjunto de datos de entrenamiento en una sola línea
lasso_fit <- workflow() %>%
  add_recipe(receta_lasso) %>%
  add_model(final_lasso) %>%
  fit(data = train_embed)

```


```{r prediccion5}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(lasso_fit, test_embed, type="prob")) %>%
        bind_cols(predict(lasso_fit, test_embed, type="class"))

print(preds_embed)

```


```{r metricas5_test}

# Calcular las métricas de evaluación
metricas_5 <- roc_auc(preds_embed, orientacion, .pred_conservador) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_5")

metricas_5

```


## Elimina objetos previos

```{r}

# Elimina todos los objetos excepto los necesarios para el siguiente modelo

# Lista todos los objetos que existen
todos_los_objetos <- ls()

# Sólo estos son necesarios para la consigna 3
objetos_a_no_eliminar <- c("noticias_topico_6", "noticias", "embedding", "metricas_1", "metricas_2", "metricas_3", "metricas_4", "metricas_5")

# Hace la diferencia
objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

# Elimina los objetos
rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```



# PRUEBA 6 RANDOM FOREST
    - Incluye orientación "neutro"
    - Con variable “medio”
    - Balanceando antes de la receta por orientación-medio	

        **Curva Roc sobre train:  0.6637545**
        **Curva Roc sobre test:  0.4485185**

## Sobre el corpus

### Tokenización y construcción de features mediante el embedding

```{r}

# Se arma el objeto "corpus_noticias_t6", que con el conjunto de noticias que más probablemente pertenezcan al tópico 6 (política/ elecciones), a lo cual se suman el texto, el medio y la orientación del medio del cual sale la noticia

corpus_noticias_t6 <- noticias_topico_6 |>
  rename(titulo = document) |> 
  left_join(noticias) |>
  select(titulo, gamma, id,
         medio,
         orientacion, texto) |> 
  mutate(orientacion = gsub("\\+ ", "", orientacion)) |>
  # filter(orientacion != "neutro") |> 
  mutate(orientacion = factor(orientacion,
                              levels = c('progresista', 'neutro', "conservador")))


table(corpus_noticias_t6$orientacion)

```

Tokenización pero sin pasar todo a minúscula y sin eliminar la puntuación

```{r preprocesamiento6}

## No vamos a pasar a minúscula nada y tampoco vamos a eliminar caracteres no ascii para que se unan correctamente con el embedding

corpus_noticias_t6 <- corpus_noticias_t6 |>
        mutate(texto = str_replace_all(texto, "'\\[.*?¿\\]\\%'", " ")) |> 
        # Reemplaza cualquier dígito por la cadena "DIGITO"
        mutate(texto = str_replace_all(texto, "[[:digit:]]+", "DIGITO"))

```

```{r tokenización6}

corpus_noticias_t6 <- corpus_noticias_t6 |> 
  mutate(title_id = row_number()) |> 
  # No pasamos a minúscula ni eliminamos la puntuación para que se unan correctamente con el embedding
  unnest_tokens(word, texto, 
                to_lower = FALSE,
                strip_punct = FALSE)

```


### Embedding: de palabra a noticia

```{r union_embedding6}

# Unimos las noticias con el embedding, para que cada palabra de este conjunto de noticias tenga las 300 dimensiones
corpus_c_embedding <- corpus_noticias_t6 |>
        left_join(embedding) |>
        drop_na()

```

Agrupamos por cada noticia y calculamos el promedio para cada dimensión de cada palabra que forma parte de una noticia. Se agrupa por cada noticia (que tiene un diario específico, con una orientación específica) y calcula el promedio para cada dimensión de cada palabra que forma parte de una noticia. De esta forma, tenemos el valor promedio en cada dimensión de la noticia en su conjunto.

```{r promedio_x_dimension6}

noticias_c_embedding <- corpus_c_embedding %>%
  group_by(title_id, medio, orientacion) %>%
  summarise(across(V1:V300, ~mean(.x, na.rm=TRUE))) %>%
  ungroup()

```

### Balanceo manual

```{r conteo_medios_y_orientacion, eval=FALSE, include=FALSE}

# Contamos cuántas noticias hay referidas a ciertos medios y a ciertas orientaciones para garantizar balancearlos

noticias_c_embedding |> 
  count(orientacion) |> 
  mutate(porcentaje = round((n/sum(n)) * 100, digits = 2)) |> 
  View()

noticias_c_embedding |> 
  count(medio, orientacion) |> 
  mutate(porcentaje = round((n/sum(n)) * 100, digits = 2)) |> 
  View()

```

Es claro que no existe un balanceo de orientaciones: "conservador" y "neutro" poseen casi un 40% de noticias, mientras "progresista" sólo posee un 21%. Lo mismo puede decirse sobre la orientación de los diarios.  Con respecto a la categoría "conservador", Clarín tiene el cuádruple de casos que Infobae; lo mismo Perfil respecto a Crónica o Télam en "neutro"; y Página12 posee más del doble de noticias que Minuto1

Por ese motivo, es necesario un balanceo de medios y orientaciones antes de continuar con el análisis. Considerando que sólo existen 2 diarios de orientación "progresista" (mientras el resto de las orientaciones poseen 3 diarios distintos) y uno de ellos (Minuto1) sólo posee 60 noticias, utilizaremos ese valor como base. 

Para que cada orientación quede con un número divisible tanto por 3 como por 2 (ya que dos orientaciones tienen 3 diarios distintos cada una y la otra tiene 2), vamos a quedarnos con 60 noticias de Minuto1 y 60 noticias de Página12. De esta forma, la orientación "progresista" quedaría con 120 noticias.

Para tener 120 noticias de diarios de orientación "conservadora" y otras 120 de diarios de orientación "neutra", cada diario de esas orientaciones debería tener 40 noticias. En el siguiente código se hace una selección al azar de esa cantidad de noticias por diario y por orientación. 

```{r balanceo_medios_y_orientacion}

noticias_progresistas <- noticias_c_embedding |>
  filter(orientacion == "progresista") |> 
  group_by(medio) |> 
  sample_n(size = 60) |> 
  ungroup()

noticias_conservadoras_y_neutras <- noticias_c_embedding |>
  filter(orientacion == "conservador" | orientacion == "neutro") |> 
  group_by(medio) |> 
  sample_n(size = 40) |> 
  ungroup()

noticias_balanceadas <- noticias_progresistas |> 
  bind_rows(noticias_conservadoras_y_neutras)

rm(noticias_progresistas, noticias_conservadoras_y_neutras)

# Acá vemos que las noticias están balanceadas ahora por medio y por orientación (considerando que las "progresistas" provienen de 2 diarios y no de 3)
noticias_balanceadas |> 
  count(medio, orientacion) |> 
  mutate(porcentaje = round((n/sum(n)) * 100, digits = 2)) |> 
  View()

```


## Preparación del modelado (Prueba 6)

### Partición de los datos en entrenamiento (train) y prueba (test)

```{r spliteo6}

set.seed(1234)

noticias_split <- initial_split(noticias_balanceadas, 
                                strata = medio)

train_embed <- training(noticias_split)
test_embed <- testing(noticias_split)


table(train_embed$medio)

```


### Elaboración de la receta

```{r receta6}

# Se especifica la receta
receta <- train_embed |> 
  recipe(orientacion ~ .) %>%
  step_rm(medio) |> 
  update_role("title_id", new_role = "ID")
  #step_downsample(orientacion,
  #                under_ratio = 1)
  

# Se agrega al workflow
wf <- workflow() %>%
  add_recipe(receta)

```


### Tuneo

Los hiperparámetros a definir son:
      -`trees`: define el número de árboles que se van a establecer
      -`mtry`: cantidad de variables que se van a probar en cada iteración
      -`min_n`: mínima cantidad de observaciones que tiene que haber en cada nodo

```{r hiperparametros6}

# Establecimiento del modelo a tunear
modelo_a_tunear <- rand_forest(trees = 1000,
                               mtry = tune(),
                               min_n = tune()) %>%
  set_mode("classification") %>%
  set_engine("ranger")


# Se agrego al workflow
wf <- wf |> 
  add_model(modelo_a_tunear)

```

```{r cross_validation6}

set.seed(1234)

# Cross validation
embed_folds <- vfold_cv(train_embed, v = 5)

```

```{r combinaciones_hiperparametros6, eval=FALSE, include=FALSE}

tictoc::tic()

# Entrenamiento del modelo con distintas combinaciones de hiperparámetros
a_tunear_6 <- tune_grid(wf,
                        resamples = embed_folds,
                        grid = 30,
                        metrics = metric_set(precision, recall,
                                             roc_auc, f_meas))

write_rds(a_tunear_6, 'models/a_tunear_6.rds')

tictoc::toc()

```

```{r combinaciones_carga6}

a_tunear_6 <- read_rds('models/a_tunear_6.rds')

```


## Métricas y elección hiperparámetros

```{r métricas6}

# Muestra las métricas en una tibble
a_tunear_6 |> 
  collect_metrics() |> 
  print()

```

```{r autoplot6}

a_tunear_6 |> 
  autoplot() +
  theme_minimal()

```

```{r}

# Mostramos los hiperparámetros que dan la mejor curva ROC
show_best(a_tunear_6, "roc_auc")

```

Si bien no se muestra, probamos con los otros parámetros posibles por si los hiperparámetros pudiesen generar un problema de overfitting. Pero en el set de test, la mejor curva ROC corresponde simultáneamente a los hiperparámetros que producen la mejor curva ROC en el set de train

```{r parametros_finales6}

#best_ROC <- show_best(a_tunear_6, "roc_auc") |> 
#  filter(mtry == 74 &
#         min_n == 30)

best_ROC <- select_best(a_tunear_6,
                        "roc_auc")


# Finalizamos el modelo con los hiperparámetros que dan la mejor curva ROC
final_rf <- finalize_model(modelo_a_tunear,
                           best_ROC)

# Modelo final
final_rf

```


## Entrenamiento modelo final

```{r fit_final6}

# Actualizamos al modelo final
fit_final <- wf |> 
  update_model(final_rf) |>
  # Fiteamos a los datos de entrenamiento
  fit(train_embed)

```

## Evaluación sobre test

```{r fit_en_test6}

# Crear un nuevo flujo de trabajo, agregar la receta y el modelo, y ajustar al conjunto de datos de entrenamiento en una sola línea
tree_fit <- workflow() %>%
  add_recipe(receta) %>%
  add_model(final_rf) %>%
  fit(data = train_embed)

```


```{r prediccion6}

preds_embed <- test_embed %>%
        select(orientacion) %>%
        bind_cols(predict(tree_fit, test_embed, type="prob")) %>%
        bind_cols(predict(tree_fit, test_embed, type="class"))

print(preds_embed)

```


```{r metricas6_test}

metricas_6 <- roc_auc(preds_embed, orientacion, c(.pred_conservador, .pred_neutro, .pred_progresista)) %>%
  bind_rows(accuracy(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(precision(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(recall(preds_embed, orientacion, .pred_class)) %>%
  bind_rows(f_meas(preds_embed, orientacion, .pred_class)) |> 
  mutate(modelo = "modelo_6")

metricas_6

```


## Elimina objetos previos

```{r}

# Elimina todos los objetos excepto las métricas. A propósito le dejé el "#", así se genera un error si uno pone "run all" y así uno decide, en el momento, si quiere eliminar todos los objetos y hacer las métricas o modificar algo de alguno de los objetos anteriores

todos_los_objetos <- ls()

objetos_a_no_eliminar <- c("metricas_1", "metricas_2", "metricas_3","metricas_4", "metricas_5", "metricas_6")

objetos_a_eliminar <- setdiff(todos_los_objetos, objetos_a_no_eliminar)

rm(list = objetos_a_eliminar)

rm("objetos_a_eliminar", "objetos_a_no_eliminar", "todos_los_objetos")

```




# GRÁFICO 8: COMPARANDO MÉTRICAS DE LOS MODELOS PROBADOS (RANDOM FOREST Y REGRESIÓN LOGÍSTICA REGULARIZADA POR LASSO)


```{r grafico_metricas_modelos}

metricas_modelos <- metricas_1 |> 
  bind_rows(metricas_2) |> 
  bind_rows(metricas_3) |> 
  bind_rows(metricas_4) |> 
  bind_rows(metricas_5) |> 
  bind_rows(metricas_6)
  

grafico8 <- metricas_modelos |> 
  mutate(.metric = case_when(
    .metric == "accuracy" ~ "Accuracy",
    .metric == "roc_auc" ~ "Curva ROC",
    .metric == "precision" ~ "Precision",
    .metric == "recall" ~ "Recall",
    .metric == "f_meas" ~ "F_meas",
    TRUE ~ as.character(.metric))) |> 
  mutate(modelo = case_when(
    modelo == "modelo_1" ~ "Prueba 1",
    modelo == "modelo_2" ~ "Prueba 2",
    modelo == "modelo_3" ~ "Prueba 3",
    modelo == "modelo_4" ~ "Prueba 4",
    modelo == "modelo_5" ~ "Prueba 5",
    modelo == "modelo_6" ~ "Prueba 6",
    TRUE ~ as.character(modelo))) |> 
  ggplot(aes(x = .metric, y = .estimate, fill = modelo)) +
  geom_col(position = "dodge") +
  scale_fill_viridis_d() +
  labs(title = "Principales métricas según modelo", 
       caption = "Gráfico 8",
       plot.title = element_text(size = 10),
       x = "Métricas", 
       y = "Estimado") +
  guides(fill = guide_legend(title = "Prueba")) +
  theme_minimal()


print(grafico8)

# Guardar el gráfico como un archivo
ggsave(filename = "Graficos/Grafico8.png", 
       plot = grafico8, 
       width = 8, height = 6)

```