Laboratorio 3
Para este laboratorio haremos el analisis de varios textos.
Attaching package: ‘igraph’
The following objects are masked from ‘package:stats’:
decompose, spectrum
The following object is masked from ‘package:base’:
union
Loading required package: NLP
Attaching package: ‘dplyr’
The following objects are masked from ‘package:igraph’:
as_data_frame, groups, union
The following objects are masked from ‘package:stats’:
filter, lag
The following objects are masked from ‘package:base’:
intersect, setdiff, setequal, union
Attaching package: ‘tidyr’
The following object is masked from ‘package:igraph’:
crossingPrimero iniciaremos graficando las aristas de lo que puede ser una cadena de markov
sites_edges <-
c("A","B",
"B","A",
"B","C",
"C","A",
"C","B",
"C","E",
"D","A",
"E","D",
"E","C",
"E","B")
net_sites <- graph(sites_edges)
plot(net_sites, layout=layout.circle)
Ahora cargaremos 3 archivos, don quijote, y la biblia, cargaremos todas las lineas y procederemos a remover los espacios, para quedarnos unicamente con un listado de palabras.
libro <- file("~/Downloads/quijote.txt")
libro_2 <- file("~/Downloads/biblia.txt")
libro_lines <- readLines(libro)
libro_lines_2 <- readLines(libro_2)
libro_words <- paste(libro_lines,collapse = " ")
libro_words_2 <- paste(libro_lines_2,collapse = " ")
libro_words <- strsplit(libro_words, split = " ") %>% unlist()
libro_words_2 <- strsplit(libro_words_2, split = " ") %>% unlist()Ahora procedemos a combinarlos en un solo arreglo
libro_words <- c(libro_words,libro_words_2)
length(unique(libro_words))[1] 28972Esto nos muestra que ambos libros tienen un total de 28,972 palabras unicas. Ahora procederemos a quitar los signos de puntuacion, quitar los espacios, quitar los numeros y quitar las llamadas “stopwords” que son ‘que’, ‘a’, etc.
libro_words <- sapply(libro_words,"removePunctuation",USE.NAMES = FALSE)
libro_words <- sapply(libro_words,"tolower",USE.NAMES = FALSE)
libro_words <- sapply(libro_words,"stripWhitespace",USE.NAMES = FALSE)
libro_words <- sapply(libro_words,"removeNumbers",USE.NAMES = FALSE)
libro_words <- sapply(libro_words,"removeWords",
words=stopwords('spanish'),
USE.NAMES = FALSE)
libro_words <- libro_words[libro_words!=""]
libro_words <- libro_words[libro_words!=" "]
length(unique(libro_words))[1] 16078Con esto nos quedan unicamente 16,708 palabras unicas. Ahora procedemos a generar los bigrams de los libros. Las cuales nos diran por cada palabra que palabras son las que las siguen y la ocurrencia de dichas palabras.
bigrams<-
lapply(ngrams(libro_words,2), paste, collapse=" ") %>% unlist()
bigrams<-
table(bigrams) %>% as.data.frame()
bigrams <- bigrams %>%
separate(bigrams,into=c("word1","word2"),sep=" ")Con los bigramas generados, vamos a filtrar unicamente aquellos que su frecuencia sea mayor de 50.
muestra_words <- bigrams %>% filter(Freq > 50)
libro_vertices<-
paste(muestra_words$word1,muestra_words$word2) %>%
strsplit(" ") %>%
unlist()Con las muestras generadas podemos finalmente graficar la cadena de markov.
g1<-
graph(libro_vertices)
plot(g1,edge.arrow.size = 0.3,
arrow.width = 0.1,
vertex.size = 5,
vertex.label.cex = 0.8)
Esto nos genera varias pequenas cadenas de secuencia de palabras, si bajaramos la frecuencia de la muestra, esta seria una grafica mucho mas poblada. Finalmente con esto podemos generar una funcion para predecir que dado una palabra, cual sera la siguiente, segun la frecuencia.
next_word <- function(palabra){
top_words<-
bigrams %>%
filter(word1 == palabra) %>%
arrange(desc(Freq)) %>%
mutate(total=sum(Freq),
prob=Freq/total)
sample(top_words$word2,size = 1,prob = top_words$prob) %>% return()
}
next_word("dulcinea")[1] "tocaba"Vemos que el resultado de la palabra dulcinea es toboso, siendo esta la palabra mas frecuente despues de dulcinea. Esto porque el algoritmo implementado busca aleatoriamente por la frecuencia, pero que sucede si implementamos un algoritmo “greedy” en el que siempre se escoja la palabra mas frecuento para que suceda a la palabra que seleccionamos.
next_word_greedy <- function(palabra){
top_words<-
bigrams %>%
filter(word1 == palabra) %>%
arrange(desc(Freq)) %>%
mutate(max_freq=max(Freq)) %>%
filter(Freq==max_freq)
top_words$word2 %>% return()
}
next_word_greedy("dulcinea")[1] "toboso"El resultado pareciera ser el mismo. Ahora bien con estos algoritmos podemos implementar una funcion adicional para generar frases. Que pasa si implementamos una basada en la version aleatoria y otra en la version “greedy”.
sentence <- function(seed="don",n=10){
oracion <- seed
for(i in 1:n){
oracion <- c( oracion,next_word(oracion[i]) )
}
paste(oracion,collapse = " ") %>% return()
}
sentence_greedy <- function(seed="don",n=10){
oracion <- seed
for(i in 1:n){
oracion <- c( oracion,next_word_greedy(oracion[i]) )
}
paste(oracion,collapse = " ") %>% return()
}Al probarlos
set.seed(123)
sentence("delante",n = 15)[1] "delante jehová defendido causa oído ue bien cualquiera diga jehová aquí cubre intestinos entrañas ninguna cosa"Como vemos el algoritmo aleatorio, genera una frase legible, que sucede ahora si probamos el algoritmo “greedy”
sentence_greedy("belen",n = 150)[1] "belen"En el codigo anterior procedemos a separar los bigramas. Y ahora procedemos a generar una cadena de markov.