M4A1_Módulo4_Tarea1

Text Mining: Aladdin

Introducción

La actividad corresponde en comparar dos guiones de película, uno es de Aladdin de 1992 y el otro es de Aladdin de 2019. El primero es una versión animada, por lo cual se pretende analizar el nivel de modernización del nuevo guión y si sigue siendo fiel a su antecesor.

Librerías

library(tm)
library(pdftools)
library(SnowballC)

1. Creación de Corpus

library(tm)

# Establecer el directorio de trabajo donde se encuentran los archivos
setwd("C:\\Users\\AVRIL\\Documents\\Text Mining")

# Obtener la lista de archivos en el directorio
archivos <- list.files(pattern = ".pdf")

library(pdftools)

# Función para extraer texto de un archivo PDF
extraer_texto <- function(archivo) {
  texto <- pdf_text(archivo)
  return(texto)
}

# Crear una lista de corpus
corpus_list <- lapply(archivos, function(archivo) {
  texto <- extraer_texto(archivo)
  corpus <- Corpus(VectorSource(texto))
  return(corpus)
})

2. Limpieza de Corpus

stopwords("en")

##   [1] "i"          "me"         "my"         "myself"     "we"        
##   [6] "our"        "ours"       "ourselves"  "you"        "your"      
##  [11] "yours"      "yourself"   "yourselves" "he"         "him"       
##  [16] "his"        "himself"    "she"        "her"        "hers"      
##  [21] "herself"    "it"         "its"        "itself"     "they"      
##  [26] "them"       "their"      "theirs"     "themselves" "what"      
##  [31] "which"      "who"        "whom"       "this"       "that"      
##  [36] "these"      "those"      "am"         "is"         "are"       
##  [41] "was"        "were"       "be"         "been"       "being"     
##  [46] "have"       "has"        "had"        "having"     "do"        
##  [51] "does"       "did"        "doing"      "would"      "should"    
##  [56] "could"      "ought"      "i'm"        "you're"     "he's"      
##  [61] "she's"      "it's"       "we're"      "they're"    "i've"      
##  [66] "you've"     "we've"      "they've"    "i'd"        "you'd"     
##  [71] "he'd"       "she'd"      "we'd"       "they'd"     "i'll"      
##  [76] "you'll"     "he'll"      "she'll"     "we'll"      "they'll"   
##  [81] "isn't"      "aren't"     "wasn't"     "weren't"    "hasn't"    
##  [86] "haven't"    "hadn't"     "doesn't"    "don't"      "didn't"    
##  [91] "won't"      "wouldn't"   "shan't"     "shouldn't"  "can't"     
##  [96] "cannot"     "couldn't"   "mustn't"    "let's"      "that's"    
## [101] "who's"      "what's"     "here's"     "there's"    "when's"    
## [106] "where's"    "why's"      "how's"      "a"          "an"        
## [111] "the"        "and"        "but"        "if"         "or"        
## [116] "because"    "as"         "until"      "while"      "of"        
## [121] "at"         "by"         "for"        "with"       "about"     
## [126] "against"    "between"    "into"       "through"    "during"    
## [131] "before"     "after"      "above"      "below"      "to"        
## [136] "from"       "up"         "down"       "in"         "out"       
## [141] "on"         "off"        "over"       "under"      "again"     
## [146] "further"    "then"       "once"       "here"       "there"     
## [151] "when"       "where"      "why"        "how"        "all"       
## [156] "any"        "both"       "each"       "few"        "more"      
## [161] "most"       "other"      "some"       "such"       "no"        
## [166] "nor"        "not"        "only"       "own"        "same"      
## [171] "so"         "than"       "too"        "very"

# Limpieza de los corpus
procesar_corpus <- function(corpus) {
  # Preprocesamiento
  corpus <- tm_map(corpus, content_transformer(tolower))
  corpus <- tm_map(corpus, removePunctuation)
  corpus <- tm_map(corpus, removeNumbers)
  corpus <- tm_map(corpus, removeWords, c(stopwords("english"), "page", "disney", "copyright"))
  corpus <- tm_map(corpus, stripWhitespace)
  
  # Crear matriz de términos
  tdm <- TermDocumentMatrix(corpus)
  
  return(tdm)
}

# Obtener la matriz de términos de cada corpus
tdm_list <- lapply(corpus_list, procesar_corpus)

3. Frecuencia de términos

Se observa que algunos de los términos del guión original tienen menos frecuencia en el nuevo guión hasta el punto en que no son parte del top, como “Abu”, “Iago” y “alfombra”, lo que implica cierta reducción del nivel de importancia de estos personajes en comparación con el primer guión. Asimismo, se muestra una disminución en la frecuencia de términos como “sultan” lo que determina que sigue siendo un persona con un rol relevante para el desarrollo tanto de la historia como de los personajes lo que refleja cierta fidelización con el guión de 1992.

terminos_frecuentes_list <- lapply(tdm_list, function(tdm) {
  # Convertir la matriz de términos a una matriz de términos-frecuencia
  m <- as.matrix(tdm)
  # Calcular la frecuencia de términos en cada documento
  term_freq <- rowSums(m)
  # Ordenar términos por frecuencia descendente
  sorted_terms <- sort(term_freq, decreasing = TRUE)
  # Seleccionar los términos más frecuentes (por ejemplo, los primeros 10)
  top_terms <- head(sorted_terms, 10)
  return(top_terms)
})

# Imprimir los términos frecuentes de cada corpus
for (i in seq_along(terminos_frecuentes_list)) {
  cat("Términos frecuentes en el corpus", i, ":\n")
  print(names(terminos_frecuentes_list[[i]]))
  cat("\n")
}

## Términos frecuentes en el corpus 1 :
##  [1] "aladdin" "jafar"   "jasmine" "abu"     "genie"   "sultan"  "iago"   
##  [8] "carpet"  "back"    "prince" 
## 
## Términos frecuentes en el corpus 2 :
##  [1] "aladdin" "genie"   "jasmine" "prince"  "jafar"   "dont"    "like"   
##  [8] "will"    "ali"     "sultan"

4. Esparcimiento / Dispersión

El nuevo guión tiene una menor esparcidad que el guión original, lo que indica una mayor concentración de términos, es decir, que utiliza un lenguaje más preciso y conciso. Asimismo, la diferencia en la esparcidad es relativamente pequeña, por lo que no se considera significativa lo que implica que la historia original se mantiene fiel en el nuevo guión.

calcular_esparsidad <- function(corpus_list) {
  # Obtener la matriz término-documento
  dtm <- DocumentTermMatrix(corpus_list)
  
 # Calcular la cantidad de términos únicos
  total_terms <- sum(as.matrix(dtm) > 0)
  
  # Calcular el tamaño total del vocabulario
  total_vocab <- length(unique(as.vector(dtm$dimnames$Terms)))
  
  # Calcular la esparsidad
  sparsity <- 1 - (total_terms / (length(dtm$dimnames$Docs) * total_vocab))
  
  return(sparsity)
}

# Crear una lista para almacenar la esparsidad de cada corpus
esparsidad_lista <- vector("numeric", length(corpus_list))

# Calcular la esparsidad de cada corpus en la lista
for (i in 1:length(corpus_list)) {
  esparsidad_lista[i] <- calcular_esparsidad(corpus_list[[i]])
}

# Imprimir la esparsidad de cada corpus
for (i in 1:length(corpus_list)) {
  cat("Esparsidad del Corpus", i, ":", esparsidad_lista[i], "\n")
}

## Esparsidad del Corpus 1 : 0.955889 
## Esparsidad del Corpus 2 : 0.9476435

5. Asociaciones

El nuevo guión presenta una menor asociación de términos con “GENIE” pero, sin perder su propósito principal que es su poder para conceder los deseos a los personajes, tanto a Aladdin como a Jafar, y el énfasis en poder determina la relevancia para el final y/o reoslución del nudo para convencer a Jafar de ser un genio. A diferencia del primer guión donde se da un mayor contexto del poder del genio alrededor de la historia, implicando también su relevancia para la resolución del conflicto.

library(tm)

assoc_results <- list()

# Iterar sobre cada corpus
for (i in seq_along(corpus_list)) {
  # Obtener la matriz término-documento actual
  dtm <- tdm_list[[i]]
  
  # Obtener los términos asociados a "jafar" con un umbral de correlación de 0.5
  associations <- findAssocs(dtm, term = "genie", corlimit = 0.5)
  
  # Almacenar los resultados en la lista
  assoc_results[[i]] <- associations
}

assoc_results

## [[1]]
## [[1]]$genie
##       wish      bitty     cosmic       itty     living phenomenal     powers 
##       0.71       0.58       0.58       0.58       0.58       0.58       0.58 
##     genies     master      space      third       poof 
##       0.53       0.53       0.53       0.53       0.50 
## 
## 
## [[2]]
## [[2]]$genie
## wishes  heavy 
##   0.53   0.50

6. Creación de Redes de Palabras

Se determina que el guión de 1992 tiene mayores redes por descripciones de los escenarios por palabras como “commonplace” lo que determina la importancia para el desarrollo de la historia. Mientras que, el guión de 2019 presenta redes por personajes (jasmine, aladdin y carpet) pero sigue manteniendo la relevancia de los escenarios desérticos y cultura ficcional para el desarrollo de las acicones de los personajes.

library(igraph)
crear_red_palabras <- function(tdm) {
  # Convertir la matriz término-documento a una matriz de términos
  tdm_matrix <- as.matrix(tdm)
  
  # Calcular la matriz de correlación entre los términos
  correlacion <- cor(tdm_matrix)
  
  # Convertir la matriz de correlación en una matriz de adyacencia para la red
  matriz_adyacencia <- as.matrix(correlacion > 0.9) 
  
  # Crear red
  red <- graph.adjacency(matriz_adyacencia, mode = "undirected", weighted = TRUE, diag = FALSE)
  
  return(red)
}

# Crear y visualizar la red de palabras para cada corpus
for (i in 1:length(tdm_list)) {
  # Crear la red de palabras
  red_palabras <- crear_red_palabras(tdm_list[[i]])
  for (j in 1:length(V(red_palabras))) {
  V(red_palabras)[j]$label <- rownames(tdm_list[[i]])[j]
}

  # Visualizar la red
  plot(red_palabras, main = archivos[i], vertex.label.dist = 0.5, vertex.size = 5)
}

7. Análisis de Sentimientos

Se visualiza que existe una fidelidad a la historia de 1992 puesto que la confianza/amistad, sigue siendo el sentimiento principal; mientras que el valor que se experimenta en menor medida en ambas obas es el disgusto. No obstante, se percibe que hubo un cambio en la sucesión de hechos y/o emociones debido a que se muestra que el clímax en el primer guión en un monto de 65 en el tiempo narrativo con un ligero pico al inicio, a diferencia del segundo guión que solamente muestra un pico en un monto de 45 en el tiempo narrativo.

library(tm)
library(fpc)   
library(ggplot2)
library(textTinyR)
library(tidytext)
library(pdftools)
library(tokenizers)

# Lee el texto del PDF
#texto_pdf <- pdf_text("C:\\Users\\AVRIL\\Documents\\Text Mining\\Aladdin_1992.pdf")

# Convierte a una lista de palabras
#texto_palabras <- get_tokens(texto_pdf)# Análisis de Sentimientos
#emociones_df <- get_nrc_sentiment(texto_palabras, language = "english")
#emociones_prop <- colSums(prop.table(emociones_df[1:8]))
#emociones_df_g1 <- data.frame(Emocion = names(emociones_prop), Proporcion = emociones_prop)
#ggplot(emociones_df_g1, aes(x = Emocion, y = Proporcion, fill = Emocion)) +
#  geom_bar(stat = "identity") +
#  labs(title = "Distribución de emociones en Aladdin - Película Animada",
#       x = "Emoción",
#       y = "Proporción") +
#  theme_minimal() +  # Estilo minimalista
#  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=12),
#        plot.title = element_text(face = "bold"))

# Emociones negativas vs positivas a lo largo de la película
#sentimientos <- (emociones_df$negative*-1) + emociones_df$positive
#simple_plot(sentimientos)

# Lee el texto del PDF
#texto_pdf2 <- pdf_text("C:\\Users\\AVRIL\\Documents\\Text Mining\\Aladdin_2019.pdf")

# Convierte a una lista de palabras
#texto_palabras2 <- get_tokens(texto_pdf2)# Análisis de Sentimientos
#emociones_df2 <- get_nrc_sentiment(texto_palabras2, language = "english")
#emociones_prop2 <- colSums(prop.table(emociones_df2[1:8]))
#emociones_df_g2 <- data.frame(Emocion = names(emociones_prop2), Proporcion = emociones_prop2)
#ggplot(emociones_df_g2, aes(x = Emocion, y = Proporcion, fill = Emocion)) +
#  geom_bar(stat = "identity") +
#  labs(title = "Distribución de emociones en Aladdin - Película Animada",
#       x = "Emoción",
#       y = "Proporción") +
#  theme_minimal() +  # Estilo minimalista
#  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=12),
#        plot.title = element_text(face = "bold"))

# Emociones negativas vs positivas a lo largo de la película
#sentimientos2 <- (emociones_df2$negative*-1) + emociones_df2$positive
#simple_plot(sentimientos2)

Hallazgos

Al realizar la comparación de los dos guiones de la película “Aladdín”, uno de 1992 y el otro de 2019. Se determina que sí existe cierto nivel de modernización del nuevo guión y sí sigue siendo fiel a su antecesor, puesto que en la frecuencia de términos se muestra que el top 10 sigue manteniendo las palabras clave para el desarrollo de la historia como “aladdin”, “jafar” y “genie” pero difieren en el nivel de frecuencia lo que alude a los cambios en relevancia del elementopara el desarrollo de la historia. Asimismo, la dispersidad entre guiones tiene una ligera diferencia lo que denota que el guión de 2019 es fiel a la historia pero emplea un lenguaje más preciso y conciso. Inclusive, esto se visualiza con la asociación de palabras con “genie” donde se muestra un mayor número de palabras asociadas lo cual da mayor contexto o detalle de dicho personaje. De igual manera, las redes de palabras de cada guión a pesar de tener cierta diversificación en relación a los palabras escénicas sigue existiendo una correlación con los elementos relevantes de la historia como “aladdin”, “carpet” y “lamp”. Por último, el análisis de sentimientos nos muestra que hay fidelidad en el guión de 2019 en relación a la jerarquía y emociones presentadas; pero difieren en el tiempo narrativa en que estas se perciben lo que lude a cambios en el climax o nudo de la historia.