Tutorial Text Mining
Daiana Emili
12 de agosto de 2019
Analisis de Text Mining
Esta semana en #Datosdemiercoles proponen analizar los subtítulos de la serie La casa de papel.
Preprocesamiento de datos
# install_packages("readr")
#Levanto la base
df <- readr::read_csv("https://raw.githubusercontent.com/cienciadedatos/datos-de-miercoles/master/datos/2019/2019-07-31/la_casa_de_papel.csv")
#Creo una nueva variable para tener las etiquetas de las temporadas, no es necesario pero a mi me gusta trabajarlo asi
df$temporada_label<-0
df$temporada_label[df$temporada==1]<- "Temporada 1"
df$temporada_label[df$temporada==2]<- "Temporada 2"
df$temporada_label[df$temporada==3]<- "Temporada 3"
df$temporada_label<-as.factor(df$temporada_label)
# Creo un vector con los nombres de las temporadas y un vector con los colores que le quiero dar a las temporadas. Esto yo lo hago al principio para usarlo en todo el documento pero tmb se puede escribir el nombre de los colores cuando escribo las sentencias para hacer el grafico
colores<- c("lightblue", "orange", "lightgreen" )
temporadas<- c("Temporada 1", "Temporada 2", "Temporada 3" )
#Corro librerias de las cuales voy a usar algunas funciones
library(dplyr)
library(tidytext)
library(wordcloud)
library(tidyr)
library(igraph)
library(ggraph)
set.seed(2017)
library(ggplot2)
library(RColorBrewer)
library(stringr)
library(purrr)
library(plotly)
#Defino una funcion para limpiar y tokenizar los datos
limpiar_df <- function(texto){
# El orden de la limpieza no es arbitrario
# Se convierte todo el texto a minúsculas
nuevo_texto <- tolower(texto)
# Eliminación de páginas web (palabras que empiezan por "http." seguidas
# de cualquier cosa que no sea un espacio)
nuevo_texto <- str_replace_all(nuevo_texto,"http\\S*", "")
# Eliminación de signos de puntuación
nuevo_texto <- str_replace_all(nuevo_texto,"[[:punct:]]", " ")
#Elimino tildes en las letras
nuevo_texto<-stringi::stri_trans_general(nuevo_texto,"Latin-ASCII")
# Eliminación de números
nuevo_texto <- str_replace_all(nuevo_texto,"[[:digit:]]", " ")
# Eliminación de espacios en blanco múltiples
nuevo_texto <- str_replace_all(nuevo_texto,"[\\s]+", " ")
# Tokenización por palabras individuales
nuevo_texto <- str_split(nuevo_texto, " ")[[1]]
# Eliminación de tokens con una longitud < 2
nuevo_texto <- keep(.x = nuevo_texto, .p = function(x){str_length(x) > 1})
return(nuevo_texto)
}
#limpio y tokenizo mis datos
df <- df %>% mutate(texto_tokenizado = map(.x = texto,
.f = limpiar_df))
##creo un nuevo data set ordenado, donde tengo una fila por palabra
data_tidy <- df %>% select(-texto) %>% unnest()
data_tidy <- data_tidy %>% rename(token = texto_tokenizado)- STOP WORDS
voy a crear un conjunto con todas las palabras que no me sirven parael análisis: generalmente este conjunto esta integrado por articulos, preposiciones, etc. Yo agregué otras palabras que se repetían con frecuencia y A MI CRITERIO no resultaban de interés para este análisis.
stop_word_1 <- c("la", "las", "el", "los", "a", "ante", "bajo", "cabe", "con", "contra", "de",
"desde", "durante", "en", "entre", "hacia", "hasta", "mediante", "para", "por",
"según", "sin", "so", "sobre", "tras", "versus","vía", "b", "c", "d", "e",
"f", "g", "h", "i", "j", "k", "l", "m", "n", "ñ", "o", "p", "q", "r", "s", "t",
"u", "v", "w", "x", "y", "z", "del", "al","n°", "etc", "que", "un", "lo", "es",
"me", "se", "una", "te", "esta", "tu", "pero", "yo", "como", "ya", "mi",
"aqui","le", "no", "si", "ha", "mas", "su", "nos", "hay", "he","no","si","ha",
"eso","mas","todo","su","nos","hay","he","va","voy","porque","eh","nada",
"muy","ahi","asi","todos","estas","favor", "hacer", "pues", "esto","cuando",
"este", "soy", "ni", "tengo", "donde" ,"dos","has","ese", "estan",
"han" ,"algo", "ser", "esa", "vamos", "bien", "estoy", "tiene", "quiero",
"estoy", "era","solo", "les", "eres","tiene", "ud", "ahora", "tenemos","mm",
"estamos", "pasa","otra", "hace", "da", "gracias", "cualquier", "otro", "ti", "ah",
"son")
# Se filtran las stopwords
data_tidy <- data_tidy %>% filter(!(token %in% stop_word_1))La primera vez que corrí el análisis me di cuenta que aparecían de manera diferenciada los términos “cantan bella ciao”, “cantan bella chao”, “canta bella ciao” y “canta bella chao”.
Voy a corregir esto para unificar esos términos a “cantan bella chao”. (Estas cosas surgen a mediados o final del análisis y hay que volver y corregirlo al inicio del analisis.)
data_tidy$token[data_tidy$token=="canta"]<-"cantan"
data_tidy$token[data_tidy$token=="ciao"]<-"chao"
Primeros pasos
En una primera instancia se proporciona un breve resumen descriptivo sobre:
- cantidad de subtítulos utilizados por temporadas
- cantidad de subtítulos utilizados por episodios
Primero voy a armar la tabla
resumen<-as.data.frame.matrix(xtabs(~data_tidy$temporada_label+data_tidy$episodio))
resumen$Total<-apply(resumen,1, FUN = sum)
Promedio<-resumen$Total/c(9,6,8)
resumen<-cbind(resumen, Promedio)
total_col<-apply(resumen,2, FUN=sum)
resumen<-t(resumen)
resumen<-cbind(resumen, total_col)
resumen<-as.data.frame(resumen)
resumen[11,4]<-sum(resumen[11,1:3])/3
colnames(resumen)<- c(temporadas, "Total")Ahora le pongo formato lindo
library(data.table)
resumen<-as.data.table(resumen)
library(formattable)
formattable( resumen,list(
area(row =c(1,2,3,4,5,6,7,8,9), `Temporada 1`)~ normalize_bar(c("lightblue"),0.1),
area(row =c(1,2,3,4,5,6,7,8,9), `Temporada 2`)~ normalize_bar(c("orange"),0.1),
area(row =c(1,2,3,4,5,6,7,8,9), `Temporada 3`)~ normalize_bar(c("lightgreen"),0.1),
area(row =11)~ normalize_bar(c("#ef3b2c"),0.40)
))| Temporada 1 | Temporada 2 | Temporada 3 | Total |
|---|---|---|---|
| 1762 | 2358 | 1370 | 5490.000 |
| 1828 | 1890 | 1483 | 5201.000 |
| 2110 | 1375 | 1789 | 5274.000 |
| 2316 | 2010 | 1964 | 6290.000 |
| 1700 | 1924 | 2074 | 5698.000 |
| 1821 | 2183 | 1833 | 5837.000 |
| 1594 | 0 | 1624 | 3218.000 |
| 1774 | 0 | 2116 | 3890.000 |
| 1534 | 0 | 0 | 1534.000 |
| 16439.000 | 11740.000 | 14253.000 | 42432.000 |
| 1826.556 | 1956.667 | 1781.625 | 1854.949 |
Grafico la cantidad de terminos empleados por episodio y temporada
library(plotly) #Voy a usar plotly pero tranquilamente se puede hacer con ggplot2
df_graf<-as.data.frame(resumen[1:9,])
df_graf<-cbind(rownames(df_graf),df_graf)
df_graf$`Temporada 2`<-ifelse(df_graf$`Temporada 2`==0,NA,df_graf$`Temporada 2`)
df_graf$`Temporada 3`<-ifelse(df_graf$`Temporada 3`==0,NA,df_graf$`Temporada 3`)
colnames(df_graf)[1]<- "Episodios"
df_graf$Episodios<-as.numeric(as.character(df_graf$Episodios))
p <- plot_ly(df_graf, x = ~Episodios) %>%
add_trace(y = ~`Temporada 1`, name = 'Temporada 1',mode = 'lines+markers') %>%
add_trace(y = ~`Temporada 2`, name = 'Temporada 2', mode = 'lines+markers',connectgaps = TRUE) %>%
add_trace(y = ~`Temporada 3`, name = 'Temporada 3', mode = 'lines+markers',connectgaps = TRUE) %>%
layout(title = "Cantidad de subítulos por episodios según Temporadas",
legend = list(orientation = 'h', x=0.2,y = -0.3))
pEn promedio se utilizan 1863 subtítulos por temporada.
Mención de personajes
Se ordenan los personajes de acuerdo a la cantidad de subtítulos en los que aparecen mencionados
personajes<- c("profesor", "tokio", "rio","helsinki", "nairobi", "berlin", "oslo", "raquel", "monica", "denver", "palermo")
for(i in 1:length(personajes)){
df$nuevo<- unlist(lapply(df$texto_tokenizado,
function(x){
k<-0
if(length(x)>0){k<-ifelse(personajes[i] %in% unlist(x),1,0)}
return(k)
}))
colnames(df)[ncol(df)]<-personajes[i]}
Profesor<-sum(df["profesor"])
tokio<-sum(df["tokio"])
rio<-sum(df["rio"])
helsinki<-sum(df["helsinki"])
nairobi<-sum(df["nairobi"])
berlin<-sum(df["berlin"])
oslo<-sum(df["oslo"])
raquel<-sum(df["raquel"])
monica<-sum(df["monica"])
denver<- sum(df["denver"])
palermo<-sum(df["palermo"])
numeros<- c(Profesor, tokio, rio,helsinki,nairobi,berlin, oslo,raquel,monica,denver,palermo)
p_personajes<-as.data.frame(cbind(personajes,numeros))
p_personajes$numeros<-as.numeric(as.character(p_personajes$numeros))
p_personajes<-p_personajes[order(p_personajes$numeros,decreasing = TRUE),]
p_personajes<-as.data.table(p_personajes)
formattable( p_personajes,list(
area(col =2)~ normalize_bar(c("#ef3b2c"),0.1)
))| personajes | numeros |
|---|---|
| raquel | 191 |
| profesor | 175 |
| denver | 141 |
| berlin | 140 |
| rio | 126 |
| nairobi | 104 |
| tokio | 99 |
| helsinki | 95 |
| monica | 58 |
| palermo | 34 |
| oslo | 21 |
Palabras más frecuentes
Inicialmente se eliminan las palabras que pertenecen al conjunto de Stop Words. Dicho conjunto contiene las palabras que no son relevantes para el análisis como preposiciones, artículos, letras sueltas, etc.
Luego se realiza el recuento de palabras más frecuentes por episodio en cada temporada.
#freq_words<-function(temporada,color)
data_tidy %>%
group_by(temporada_label,episodio,token) %>%
filter(temporada_label=="Temporada 1")%>%
summarise(n=n()) %>%
top_n(3, n) %>%
ggplot() +
geom_col(aes(x = reorder(token,-n),
y = n, fill = temporada_label)) +
scale_fill_manual(values=colores[1])+
theme_bw() +
labs(y = "", x = "") +
theme(legend.position = "none") +
coord_flip() +
facet_wrap(temporada_label~episodio,scales = "free", ncol =3, drop = TRUE)
Análogamente para temporadas 2 y 3 
Word Clouds
Para cada temporada se presenta la nube de palabras más frecuentes.
#defino la funcion que crea los graficos
wordcloud_custom <- function(grupo, df){
print(grupo)
wordcloud(words = df$token, freq = df$frecuencia,
max.words = 500, random.order = FALSE, rot.per = 0.30,
colors = brewer.pal(8, "Dark2"))
}
df_grouped <- data_tidy %>% group_by( temporada_label, token) %>% count(token) %>%
group_by(temporada_label) %>% mutate(frecuencia = n / n()) %>%
arrange(temporada_label, desc(frecuencia)) %>% nest()
walk2(.x = df_grouped$temporada_label, .y = df_grouped$data, .f = wordcloud_custom)## [1] Temporada 1
## Levels: Temporada 1 Temporada 2 Temporada 3
## [1] Temporada 2
## Levels: Temporada 1 Temporada 2 Temporada 3
## [1] Temporada 3
## Levels: Temporada 1 Temporada 2 Temporada 3
Comparación en el uso de palabras
A continuación, se estudia que palabras se utilizan de forma más diferenciada por temporada, es decir, palabras que se utilizan mucho en una temporada y que no se utilizan en otra.
Una forma de hacer este análisis es mediante el log of odds ratio de las frecuencias. Esta comparación se hace por pares.
- Temporada 1 vs Temporada 2
# Pivotaje y despivotaje
data_spread <- data_tidy %>% group_by(temporada_label, token) %>% count(token) %>%
spread(key = temporada_label, value = n, fill = 0, drop = TRUE)
data_unpivot <- data_spread %>% gather(key = "temporada_label", value = "n", -token)
# Selección de los autores elonmusk y mayoredlee
data_unpivot <- data_unpivot %>% filter(temporada_label %in% c("Temporada 1",
"Temporada 2"))
# Se añade el total de palabras de cada autor
data_unpivot <- data_unpivot %>% left_join(data_tidy %>%
group_by(temporada_label) %>%
summarise(N = n()),
by = "temporada_label")
# Cálculo de odds y log of odds de cada palabra
data_logOdds <- data_unpivot %>% mutate(odds = (n + 1) / (N + 1))
data_logOdds <- data_logOdds %>% select(temporada_label, token, odds) %>%
spread(key = temporada_label, value = odds)
data_logOdds <- data_logOdds %>% mutate(log_odds = log(`Temporada 1`/`Temporada 2`),
abs_log_odds = abs(log_odds))
# Si el logaritmo de odds es mayor que cero, significa que es una palabra con
# mayor probabilidad de ser de Elon Musk. Esto es así porque el ratio sea ha
# calculado como elonmusk/mayoredlee.
data_logOdds <- data_logOdds %>%
mutate(temporadas = if_else(log_odds > 0,
"Temporada 1",
"Temporada 2"))
#data_logOdds %>% arrange(desc(abs_log_odds)) %>% head()
data_logOdds %>% group_by(temporadas) %>% top_n(5, abs_log_odds) %>%
ggplot(aes(x = reorder(token, log_odds), y = log_odds, fill=temporadas))+
geom_col() +
scale_fill_manual(values=c(colores[1],colores[2]))+
labs(x = "palabra", y = "log odds ratio (Temporada 1 / Temporada 2)") +
coord_flip() +
theme_bw()+
theme(legend.position=c(0.2,0.80))
Se repite para Temporada 2 vs Temporada 3 y Temporada 1 vs Temporada 3.
- Temporada 2 vs Temporada 3
Se observa que “gobernador” y “palermo”, entre otras, son palabras que se usan en la temporada 3 y no se utilizan en la temporada 2. Lo cual tiene sentido ya que son nuevos personajes de la serie que se incorporaron en dicha temporada.
Análogamente, “Alison” es una de las palabras que se utiliza mucho en la temporada 2 y no se utiliza en la temporada 3. Lo cual tiene sentido ya que es el nombre de un personaje que desaparece de la serie.
- Temporada 1 vs Temporada 3
Bigramas más frecuentes
Un bigrama representa un conjunto de dos palabras. A continuación se procede a analizar los “bigramas” más frecuentes por temporada, sin tener en cuenta los episodios en los cuales se mencionan los mismos.
- Por temporadas
df_2<-df[c(1,4,5,7)]
limpiar_df_2 <- function(texto){
# El orden de la limpieza no es arbitrario
# Se convierte todo el texto a minúsculas
nuevo_texto <- tolower(texto)
# Eliminación de páginas web (palabras que empiezan por "http." seguidas
# de cualquier cosa que no sea un espacio)
nuevo_texto <- str_replace_all(nuevo_texto,"http\\S*", "")
# Eliminación de signos de puntuación
nuevo_texto <- str_replace_all(nuevo_texto,"[[:punct:]]", " ")
#Elimino tildes en las letras
nuevo_texto<-stringi::stri_trans_general(nuevo_texto,"Latin-ASCII")
# Eliminación de números
nuevo_texto <- str_replace_all(nuevo_texto,"[[:digit:]]", " ")
# Eliminación de espacios en blanco múltiples
nuevo_texto <- str_replace_all(nuevo_texto,"[\\s]+", " ")
return(nuevo_texto)
}
#limpio y tokenizo mis datos
df_2 <- df_2 %>% mutate(texto = map(.x = texto, .f = limpiar_df_2))
df_2$text<- unlist(df_2$texto)
df_2$texto<-NULL
###############
df_bigrams <- df_2 %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2)
### voy separando
bigrams_separated <- df_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_separated$word1[bigrams_separated$word1=="canta"]<-"cantan"
bigrams_separated$word2[bigrams_separated$word2=="canta"]<-"cantan"
bigrams_separated$word1[bigrams_separated$word1=="ciao"]<-"chao"
bigrams_separated$word2[bigrams_separated$word2=="ciao"]<-"chao"
bigrams_filtered <- bigrams_separated %>%
filter(!word1 %in% stop_word_1) %>%
filter(!word2 %in% stop_word_1)
bigram_counts <- bigrams_filtered %>%
count(word1, word2, sort = TRUE)
### bigrams unidos
bigrams_united <- bigram_counts %>%
unite(bigram, word1, word2, sep = " ")
bigrams_interes <- subset(df_bigrams, df_bigrams$bigram %in% bigrams_united$bigram)Grafico los bigramas mas utilizados por temporadas.
#Grafico de bigramas mas usados por temporadas
g<- bigrams_interes%>%filter(temporada_label=="Temporada 1") %>%
count(bigram, sort = TRUE) %>%
top_n(8, n) %>%
mutate(bigram = reorder(bigram, n)) %>% ##tienen que ser los nombres de las vbes en words_interes
ggplot(aes(bigram, n)) +
geom_col() +
xlab(NULL) +
coord_flip()
g <- g + geom_bar(stat="identity", col="white", fill=colores[1])
g <- g + theme(axis.text.x=element_text(angle=45, hjust=1, size=12))
g <- g + labs (x=" ",y="Frecuencia")
g <- g + ggtitle (paste("Palabras más usadas por en ", temporadas[1], sep= " "))
g <- g + theme ( plot.title = element_text(size=16, face="bold", vjust=1, lineheight=0.7),
legend.title = element_text(size=11, face="bold"),
panel.background = element_rect(fill = 'grey95'))
g <- g + theme(panel.background = element_rect(fill = "white"),
strip.background = element_rect(fill="orange"),
plot.title = element_text(hjust = 0.5))
plot(g)
Comparación de bigramas
- Temporada 1 vs Temporada 2
data_spread <- bigrams_interes %>% group_by(temporada_label, bigram) %>% count(bigram) %>%
spread(key = temporada_label, value = n, fill = 0, drop = TRUE)
data_unpivot <- data_spread %>% gather(key = "temporada_label", value = "n", -bigram)
# Selección de las temporadas
data_unpivot <- data_unpivot %>% filter(temporada_label %in% c("Temporada 1",
"Temporada 2"))
# Se añade el total de palabras por temporadas
data_unpivot <- data_unpivot %>% left_join(bigrams_interes %>%
group_by(temporada_label) %>%
summarise(N = n()),
by = "temporada_label")
# Cálculo de odds y log of odds de cada palabra
data_logOdds <- data_unpivot %>% mutate(odds = (n + 1) / (N + 1))
data_logOdds <- data_logOdds %>% select(temporada_label, bigram, odds) %>%
spread(key = temporada_label, value = odds)
data_logOdds <- data_logOdds %>% mutate(log_odds = log(`Temporada 1`/`Temporada 2`),
abs_log_odds = abs(log_odds))
# Si el logaritmo de odds es mayor que cero, significa que es una palabra con
# mayor probabilidad de ser de Elon Musk. Esto es así porque el ratio sea ha
# calculado como elonmusk/mayoredlee.
data_logOdds <- data_logOdds %>%
mutate(temporadas = if_else(log_odds > 0,
"Temporada 1",
"Temporada 2"))
data_logOdds %>% group_by(temporadas) %>% top_n(5, abs_log_odds) %>%
ggplot(aes(x = reorder(bigram, log_odds), y = log_odds, fill=temporadas))+
geom_col() +
scale_fill_manual(values=c(colores[1], colores[2]))+
labs(x = "Bigrams", y = "log odds ratio (Temporada 1 / Temporada 2)") +
coord_flip() +
theme_bw()+
theme(legend.position=c(0.2,0.85))
- Temporada 2 vs Temporada 3
- Temporada 1 vs Temporada 3
Correlación entre temporadas
Se analiza la correlación entre temporadas por palabras más frecuentes.
Una forma de cuantificar la similitud entre los subtítulos dos temporadas es calculando la correlación en el uso de palabras.
- Temporada 1 vs Temporada 2
##
## Pearson's product-moment correlation
##
## data: Temporada 1 and Temporada 2
## t = 68.205, df = 2031, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.8206097 0.8470688
## sample estimates:
## cor
## 0.8343191
## [1] "El número de palabras comunes entre ambas temporadas es 2033 palabras, de un total de 7096 palabras."- Temporada 2 vs Temporada 3
##
## Pearson's product-moment correlation
##
## data: Temporada 2 and Temporada 3
## t = 44.879, df = 1812, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.7029925 0.7466338
## sample estimates:
## cor
## 0.7255418
## [1] "El número de palabras comunes entre ambas temporadas es 1814 palabras, de un total de 7200 palabras."- Temporada 1 vs Temporada 3
##
## Pearson's product-moment correlation
##
## data: Temporada 1 and Temporada 3
## t = 54.199, df = 2099, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.7452823 0.7809646
## sample estimates:
## cor
## 0.7637061
## [1] "El número de palabras comunes entre ambas temporadas es 2101 palabras, de un total de 8034 palabras."
NETWORKS
Una forma más visual e informativa de analizar las relaciones entre palabras es mediante el uso de networks.
