martes, 28 de mayo de 2024

Análisis de cluster

Tagore. Clasificación de los versos de Gitanyalí usando análisis de cluster (Método: Agnes)

Pre-procesamientos

Clasificar los poemas comienza con el proceso de tokenizado y de separación de la identificación de los poemas del cuerpo del texto. En esa oportnidad seguiré el procedimiento que describo a continuación:

#extraigo el texto que me interesa
tagore_clasificacion <- tagore$text[c(5:36, 39:69,
                  72:102, 105:138, 141:169,
                  172:203, 206:232, 235:266,
                  269:299, 302:332, 335:370,
                  373:408, 411:447, 450:485,
                  488:528, 531:569, 572:601,
                  604:635, 638:674, 677:710,
                  713:746, 749:779, 782:809,
                  812:845, 848:876, 879:911,
                  914:946, 949:976, 979:1012,
                  1015:1045, 1048:1074)]

# creo la variable  "poem_number"

tagore_clasificacion %>% 
      mutate(poem_number = str_extrac(text,
                                      "\\d+")) %>% 
      fill(poem_number) %>% 
      filter(text = str_extrac(text, "[a-zA-Z]+"))
head(tagore_clasificacion)
##                                                                                   text
## 1                                                                                     
## 2     Fue tu voluntad hacerme infinito. Este frágil vaso mío tú lo derramas una y otra
## 3                                           vez, y lo vuelves a llenar con nueva vida.
## 4    Tú has llevado por valles y colinas esta flautilla de caña, y has silbado en ella
## 5                                                         melodías eternamente nuevas.
## 6 Al contacto inmortal de tus manos, mi corazoncito se dilata sin fin en la alegría, y
##   poem_number
## 1           1
## 2           1
## 3           1
## 4           1
## 5           1
## 6           1

Procedo a tokenizar. No es necesario extraer las palabras funcionales. Este análisis lo reservo para el momento de extraer las palabras más frecuentes en cada cluster

takore_tokens <- tagore_clasificacion %>% 
      unnest_tokens(palabras, text)

Análisis de cluster jerárquico. Agnes

El df tokenizado debe convertirse en matriz, insumo para el análisis de cluster

#llevo los caracteres a nombre de filas

tagore_wider_2 <- data.frame(tagore_wider_2,
      row.names = tagore_wider_2$poem_number)

Ya tengo adelantado el cálculo de la matriz de distancias, asíc como el méthodo de aglomeración. Seguiré con la visualiación del dendrograma, el análisis de la cualidad de la aglomeración y, si ésta es mayor a 0.75, procederá a curtar el dendrograma, y a visualizarlo.

fviz_dend(tagore_hcl, cex = 0.5)

Verifico la calidad de la aglomeración

tagore_coph <- cophenetic(tagore_hcl) 

cor(tagore1_dist, tagore_coph)
## [1] 0.8555866

El resultado anterior indica que el resultado de la aglomeración refleja la data de la distancia bastante bien. Corto entonces el dendrograma para encontrar el número de cluster. Voy a pedir, al azar, sin ningún criterio firme para esta decisión, 6 grupos

tagore_grp <- cutree(tagore_hcl, k = 6)

# miembros de cada grupo

table(tagore_grp)
## tagore_grp
##  1  2  3  4  5  6 
## 92  4  2  1  1  1
tagore_grp <- cutree(tagore_hcl, k = 4)

# miembros de cada grupo

table(tagore_grp)
## tagore_grp
##  1  2  3  4 
## 92  7  1  1

Seis conglomerados construye muchos grupos con un sólo elemento, y dos con cuatro y tres elementos respectivamente. Por otra parte, cuatro conglomerados parece ofrecerme una mejor partición. El resultado refleja lo que ya veía en el grafo textual: un enorme componente gigante, con algunos poemas que tienen un contenido muy particular. y por tanto, se separan de ese gran componente en el que los poemas comparten similitudes entre sus contenidos.

Voy a examinar los miembros de los grupos con menos elementos

# nombre de los miembros del grupo 2
rownames(tagore_wider_2)[tagore_grp == 2]
## [1] "27" "41" "47" "48" "52" "60" "64"
rownames(tagore_wider_2)[tagore_grp == 3]
## [1] "51"
rownames(tagore_wider_2)[tagore_grp == 4]
## [1] "77"

Los elementos que no están en estos tres grupos forman parte del conglomerado 1.

Visualización

Con la función fviz_dend puedo obtener la visualización. Esta función corre de manera automática un PCA si el número de variables es mayor a 2, con lo cual se obtiene un número reducido de dimensiones, con lo que se facilita tanto la visulización como la interpretación

Preparo las paletas

turpial<- c("#1a1414", "#ba7212", "#6a2e0b","#963200", "#dfd7ca", "#707272",
            "#bcc4c1", "#dbd3ae")

treducido <- c("#2C0D1D", "#7B1F36", "#551126", "#601A3C",
              "#DD7898",  "#FBA6B9",  "#F6BDDD")

delLibro <- c("#2e9fdf", "#ddafbb", "#e7b800", "#fc4ed7")
fviz_dend(tagore_hcl,k = 4,
             k_colors =  delLibro,
          color_labels_by_k = TRUE,
              repel = TRUE, 
          rect = TRUE
)

visualizo como scatterplot

fviz_cluster( list(data = tagore_wider_2, cluster = tagore_grp),
             palette = delLibro,
              repel = TRUE, 
             ellipse.type = "convex",
             show.clust.cent = FALSE,
             ggtheme = theme_minimal()
)

Visualización de los tópicos de los clusters y las palabras que los separan

Creo un marco de datos con los clusters

dd<- data.frame(poema = names( tagore_grp),
                cluster = tagore_grp)
rownames(dd) <- NULL 
akore_tokensC<-dd %>% 
      inner_join(takore_tokens,
                 by=c("poema" = "poem_number"))
akore_tokensC %>% 
      filter(cluster == "1") %>% 
      count(palabras, sort = TRUE) %>% 
       mutate(prob = n/sum(n)) %>% 
      filter(prob >= 0.03) 
##   palabras   n       prob
## 1       de 409 0.04587773
## 2        y 330 0.03701626
## 3       la 289 0.03241727
## 4       en 281 0.03151991
akore_tokensC %>% 
      filter(cluster == "2") %>% 
      count(palabras, sort = TRUE) %>% 
       mutate(prob = n/sum(n)) %>% 
      filter(prob >= 0.03) 
##   palabras  n       prob
## 1       la 71 0.04528061
## 2       de 63 0.04017857
## 3        y 57 0.03635204
akore_tokensC %>% 
      filter(cluster == "3") %>% 
      count(palabras, sort = TRUE) %>% 
       mutate(prob = n/sum(n)) %>% 
      filter(prob >= 0.03) 
##   palabras  n       prob
## 1        y 17 0.06415094
## 2       el 15 0.05660377
## 3       de 11 0.04150943
## 4       la 11 0.04150943
## 5      las 10 0.03773585
## 6      que 10 0.03773585
akore_tokensC %>% 
      filter(cluster == "4") %>% 
      count(palabras, sort = TRUE) %>% 
       mutate(prob = n/sum(n)) %>% 
      filter(prob >= 0.03) 
##   palabras n       prob
## 1       mi 6 0.05128205
## 2       no 6 0.05128205
## 3     como 5 0.04273504
## 4        y 5 0.04273504
## 5        a 4 0.03418803
## 6       me 4 0.03418803
## 7       te 4 0.03418803
load("D:/funcionesSentimientos.RData")
akore_tokensC %>% 
      filter(cluster == "1", 
             !palabras %in% lex$palabras) %>% 
      count(palabras, sort = TRUE)%>% 
  with(wordcloud(palabras, n, 
               random.order = FALSE,random.color = FALSE,
               color=brewer.pal(8, "Dark2")))

akore_tokensC %>% 
      filter(cluster == "2", 
             !palabras %in% lex$palabras) %>% 
      count(palabras, sort = TRUE)%>% 
  with(wordcloud(palabras, n, 
               random.order = FALSE,random.color = FALSE,
               color=brewer.pal(8, "Dark2")))

akore_tokensC %>% 
      filter(cluster == "3", 
             !palabras %in% lex$palabras) %>% 
      count(palabras, sort = TRUE)%>% 
  with(wordcloud(palabras, n, 
               random.order = FALSE,random.color = FALSE,
               color=brewer.pal(8, "Dark2")))

akore_tokensC %>% 
      filter(cluster == "4", 
             !palabras %in% lex$palabras) %>% 
      count(palabras, sort = TRUE)%>% 
  with(wordcloud(palabras, n, 
               random.order = FALSE,random.color = FALSE,
               color=brewer.pal(8, "Dark2")))

No hay comentarios.: