NLP Pronaces
Metodología
Se hizo un modelado de tópico para 192 propuestas hechas al Conahcyt para el programa de Proyectos Nacionales Estratégigo. Para replicarlo es importante que las librerías de NLP y modelado de tópicos (Grün & Hornik, 2011; Silge & Robinson, 2016; Wijffels, 2023) sean las mismas versiones.
Grün, B., & Hornik, K. (2011). topicmodels: An R Package for Fitting Topic Models. Journal of Statistical Software, 40(13), 1-30.
Silge, J., & Robinson, D. (2016). tidytext: Text Mining and Analysis Using Tidy Data Principles in R. JOSS, 1(3). The Open Journal. Recuperado a partir de http://dx.doi.org/10.21105/joss.00037
Código
library(topicmodels)
library(doParallel)
library(fuzzyjoin)
library(patchwork)
library(tidytext)
library(ggsankey)
library(stringr)
library(ggplot2)
library(foreach)
library(forcats)
library(janitor)
library(readxl)
library(udpipe)
library(ggbump)
library(dplyr)
library(ggsci)
library(tidyr)
library(vegan)
library(tm)
library(sf)
sessionInfo()R version 4.4.1 (2024-06-14)
Platform: x86_64-pc-linux-gnu
Running under: Ubuntu 24.04.1 LTS
Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.12.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0
locale:
[1] LC_CTYPE=es_ES.UTF-8 LC_NUMERIC=C
[3] LC_TIME=es_ES.UTF-8 LC_COLLATE=es_ES.UTF-8
[5] LC_MONETARY=es_ES.UTF-8 LC_MESSAGES=es_ES.UTF-8
[7] LC_PAPER=es_ES.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C
time zone: America/Mexico_City
tzcode source: system (glibc)
attached base packages:
[1] parallel stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] sf_1.0-15 tm_0.7-11 NLP_0.3-0 vegan_2.6-8
[5] lattice_0.22-5 permute_0.9-7 tidyr_1.3.1 ggsci_3.0.1
[9] dplyr_1.1.4 ggbump_0.1.0 udpipe_0.8.11 readxl_1.4.3
[13] janitor_2.2.0 forcats_1.0.0 ggplot2_3.5.1 stringr_1.5.1
[17] ggsankey_0.0.99999 tidytext_0.4.2 patchwork_1.2.0 fuzzyjoin_0.1.6
[21] doParallel_1.0.17 iterators_1.0.14 foreach_1.5.2 topicmodels_0.2-17
loaded via a namespace (and not attached):
[1] gtable_0.3.4 xfun_0.47 htmlwidgets_1.6.4 vctrs_0.6.5
[5] tools_4.4.1 generics_0.1.3 stats4_4.4.1 proxy_0.4-27
[9] tibble_3.2.1 fansi_1.0.5 cluster_2.1.6 janeaustenr_1.0.0
[13] pkgconfig_2.0.3 tokenizers_0.3.0 KernSmooth_2.23-24 Matrix_1.7-0
[17] data.table_1.15.4 lifecycle_1.0.4 compiler_4.4.1 munsell_0.5.0
[21] codetools_0.2-20 snakecase_0.11.0 class_7.3-22 SnowballC_0.7.1
[25] htmltools_0.5.7 yaml_2.3.8 pillar_1.9.0 MASS_7.3-61
[29] classInt_0.4-10 nlme_3.1-165 tidyselect_1.2.0 digest_0.6.34
[33] stringi_1.8.3 slam_0.1-50 purrr_1.0.2 splines_4.4.1
[37] fastmap_1.1.1 grid_4.4.1 colorspace_2.1-0 cli_3.6.2
[41] magrittr_2.0.3 utf8_1.2.4 e1071_1.7-14 withr_3.0.1
[45] scales_1.3.0 lubridate_1.9.3 timechange_0.3.0 rmarkdown_2.25
[49] cellranger_1.1.0 modeltools_0.2-23 evaluate_0.23 knitr_1.45
[53] mgcv_1.9-1 rlang_1.1.4 Rcpp_1.0.13 DBI_1.2.2
[57] glue_1.7.0 xml2_1.3.6 rstudioapi_0.15.0 jsonlite_1.8.8
[61] R6_2.5.1 units_0.8-5 Utilizamos la columna resumen para hacer el modelado de tópicos, ejemplificado con una sola propuesta en la Tabla 1
Código
k = 8
columna = "resumen" # resumen, justificación, objetivo.general
mex = read_sf("~/geospatial/mex_simple.gpkg") |> dplyr::select(NAME_1)
x = udpipe::udpipe_load_model("~/oh_my_gits/pronaces/spanish-gsd-ud-2.5-191206.udpipe")
url = "https://raw.githubusercontent.com/stopwords-iso/stopwords-es/master/stopwords-es.txt"
stop_words = readr::read_csv(url) %>% magrittr::set_names("word")
datos = read.csv("~/oh_my_gits/pronaces/Datos_completos_propuestas.csv", strip.white = TRUE) |>
as_tibble() |>
mutate(documento = sprintf("%03d", row_number())) |>
mutate(título = tolower(título))
datos_eval = read_excel("~/oh_my_gits/pronaces/datos_eval_2021.xlsx") |>
janitor::clean_names() |>
mutate(descripcion = tolower(descripcion))
datos_libro = read_excel("~/oh_my_gits/pronaces/Confirmaciones y seguimiento_ LIBRO-PROYECTOS SEMILLA.xlsx") |>
janitor::clean_names() |> dplyr::select(2:7) |>
dplyr::filter(!is.na(resumen)) |>
mutate(nombre_del_texto = tolower(nombre_del_texto))
secciones_docs = read.csv("~/oh_my_gits/pronaces/docs_por_seccion.csv") |> as_tibble() |>
mutate(titulo = tolower(titulo))
datos |> slice(1) |> select(1:4) |> knitr::kable()| num.solicitud | institución | título | resumen |
|---|---|---|---|
| 305073 | Centro de Investigación en Ciencias de Información Geoespacial, A.C. | diseño de un proyecto transdisciplinario para fortalecer la implementación y la evaluación continuadel programa sembrando vida en distintos contextos socioecológicos | El Programa Sembrando Vida (PSV) es una respuesta del gobierno federal ante el abandono que ha sufrido del campo mexicano en las últimas décadas, se inserta dentro de las políticas públicas encaminadas a construir y fortalecer el tejido social en el espacio rural para contribuir al bienestar de la población, erradicar la pobreza, mejorar la distribución de la riqueza y preservar el capital natural del país. Impacta directamente a 400,000 personas beneficiaras y cubre un millón de hectáreas, sin embargo sus alcances desbordan a las comunidades de implementación y a los espacios contiguos tanto geográficos como funcionales y culturales, y comprender las posibles sinergias con otros programas estratégicos, como en el caso del Tren Maya donde el 45% del PSV coincide en la mismas regiones. El éxito del PSV es fundamental para la transformación social y requiere, además de un gran esfuerzo operativo y convicciones firmes, de la generación de conocimiento mediante un sistema de evaluación continua y mecanismos que fortalezcan la implementación del programa, a los cuales busca aportar el presente proyecto a través de una metodología basada en la investigación acción participativa para la generación de conocimiento e intercambios de saberes en distintos contextos socioecológicos. Con el fin de detectar los obstáculos del PSV desde sus inicios, comprenderlos, evaluar los resultados en etapas tempranas y acordar acciones de mejora que permitan redirigir los esfuerzos. La base que permitirá construir dichos procesos, es la consolidación de un Colectivo de Investigación e Incidencia (CII) formado por investigadores y actores claves en el PSV, bajo un carácter transdisciplinario, interinstitucional y transectorial. Teniendo como base integradora el enfoque de sistemas socioecológicos, los estudios territoriales para políticas públicas y el apoyo de las ciencias de la información geoespacial. Las personas que integran el núcleo del CII cuentan con conocimiento y experiencia en diversas áreas: manejo de agroecosistemas, producción sostenible de alimentos, manejo de cuencas, conservación de recursos naturales, participación local, diversificación productiva y resiliencia, percepción remota, procesamiento de imágenes, minería de datos, sistemas de información geográfica, cartografía participativa, geoestadística, modelación geoespacial de sistemas productivos y cambio de uso de suelo, y servicios de información para la gestión territorial. Han participado y conducido proyectos disciplinarios y transdisciplinarios enfocados a la evaluación de políticas públicas (como el Pago por Servicios Ambientales), en procesos específicos de gestión territorial para el desarrollo rural sustentable y en esquemas para el fortalecimiento de cadenas productivas en zonas de alta biodiversidad. El enfoque territorial, local y regional de los distintos grupos de trabajo dentro del CII les ha permitido construir relaciones de largo tiempo con actores locales como organizaciones de la sociedad civil y comunidades campesinas. Algunos miembros destacan por su anterior participación como funcionarios públicos y su vinculación con autoridades de diferentes instituciones y niveles, hecho que se ha visto reflejado en la cercana colaboración, desde el inicio del PSV, con la Secretaría de Bienestar tanto con directivos, coordinadores, facilitadores y técnicos, como con beneficiarios y becarios en los territorios de Chiapas, Tabasco y la Península de Yucatán. Finalmente, la propuesta presentada en esta primera fase, busca reforzar y ampliar las conversaciones sociales necesarias (talleres, entrevistas, diálogos presenciales y a distancia) para concretar el proyecto de investigación e incidencia en los próximos cinco años, sobre la base de un colectivo que ya ha venido colaborado con el PSV desde diciembre de 2018. |
Antes del modelado de tópicos, hacemos una anotación con la librería udpipe (Wijffels, 2023) para extraer los lemmas del texto, esto lo hicimos para tokens de palabras sueltas así como para grupos de dos palabras (bi-grams) para capturar frases como “cambio climático”. Esto lo hacemos distribuyendo el trabajo entre los núcleos de la computadora para mayor velocidad. Después le pegamos el valor de tf_idf (frecuencia de término, frecuencia inversa de documento) que es un número que representa qué tan valiosa es una palabra para un documento (en este caso para el resumen de una propuesta) en comparación con lo valiosa que es para todos los documentos.
Wijffels, J. (2023). udpipe: Tokenization, Parts of Speech Tagging, Lemmatization and Dependency Parsing with the ’UDPipe’ ’NLP’ Toolkit. Recuperado a partir de https://CRAN.R-project.org/package=udpipe
Código
registerDoParallel(3)
anotados = foreach(i = 1:nrow(datos), .combine = rbind) %dopar% {
temp = udpipe_annotate(x, datos[[columna]][i],
tagger = "default", # para POS tagging
parser = "default") |> # para dependency parsing
as.data.frame() |>
#dplyr::filter(upos %in% c("ADV", "ADJ", "NOUN", "VERB")) |>
#dplyr::select(lemma) |>
dplyr::mutate(documento = sprintf("%03d", i))
return(temp)
}
anotados = anotados |> as_tibble()
datos_lema = left_join(anotados, datos) |>
anti_join(stop_words, by = c("lemma" = "word"))
datos_lema = datos_lema |>
dplyr::filter(upos %in% c("ADV", "ADJ", "NOUN", "VERB"))
datos_tok_monogram = datos_lema |>
group_by(documento) |>
count(lemma)
total_words = datos_tok_monogram |> group_by(documento) |> summarise(total = sum(n))
# bigrams
datos_ngrams = tidytext::unnest_tokens(datos, lemma, get(columna), token = "ngrams", n = 2) |>
dplyr::filter(!is.na(lemma))
datos_tok_ngrams = datos_ngrams |>
group_by(documento) |>
count(lemma)
total_words_ngrams = datos_tok_ngrams |> group_by(documento) |> summarise(total = sum(n))
datos_tok_ngrams = datos_tok_ngrams |> slice_max(n, n = 10) |>
tidyr::separate(lemma, c("word1", "word2"), sep = " " ) |>
dplyr::filter(!word1 %in% stop_words$word) |>
dplyr::filter(!word2 %in% stop_words$word) |>
tidyr::unite(lemma, word1, word2, sep = " ")
datos_tok_ngrams = datos_tok_ngrams |>
left_join(total_words) #|>
# rbind monograms y bigrams --------------
datos_tok = datos_tok_monogram |>
left_join(total_words) |>
rbind(datos_tok_ngrams) |>
bind_tf_idf(lemma, documento, n)
datos_tok = datos_tok |>
dplyr::filter(!grepl("[[:punct:][:digit:]¿]", lemma, perl = TRUE)) |>
dplyr::filter(!grepl("^pro", lemma))
datos_tok$lemma = tolower(datos_tok$lemma)
df_dtm <- datos_tok %>% cast_dtm(documento, lemma, n)Después usamos la función LDA que es la “colocación latente de Dirichlet”, el cual, a partir del uso de palabras de cada propuesta, las agrupara en un número determinado de tópicos. Para ajustar el número de tópicos se hicieron varias corridas del modelo LDA, dividiendo todo el grupo de textos en desde 5 hasta 15 tópicos; en los números pequeños de tópicos (5,6 y 7), los conceptos eran muy generales; en cambio en los grupos grandes, muchas palabras clave aparecían en distintos tópicos, tales como “agrícola” que aparecía en 5 tópicos, o “comunidad” que aparecía en 8 tópicos. Encontramos 8 como el número de tópicos ideal, que no sobre-generalizaba ni sobre-dividía los tópicos.
Código
df_lda = topicmodels::LDA(df_dtm, k = k, control = list(seed = 1234))
# probabilidad por-palabra-por-tópico
df_topics <- tidy(df_lda, matrix = "beta")
# probabilidad por-documento-por-tópico
df_doc_topics <- tidy(df_lda, matrix = "gamma" )
df_top_terms <- df_topics %>%
group_by(topic) %>%
top_n(15, beta) %>%
ungroup() %>%
arrange(topic, -beta)
tops = df_top_terms |> count(term) |> dplyr::filter(n >= k/2)
docbytopic = df_doc_topics |>
group_by(document) |>
top_n(3, gamma) |> ungroup() |> arrange(document) |> filter(gamma > 1e-1)
df_topics %>%
group_by(topic) %>%
top_n(15, beta) %>%
arrange(beta) |>
ungroup() |>
arrange(topic) |>
mutate(id = rep(seq(1,15), k) ) |> select(-beta) |>
pivot_wider(names_from = topic, values_from = term) |> select(-id) |>
knitr::kable()| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 |
|---|---|---|---|---|---|---|---|
| social | gestión | permitir | práctica | pesquería | estudio | tradicional | recurso |
| urbano | actor | sustentable | área | estrategia | desarrollar | aprovechamiento | natural |
| humano | participación | ecológico | actividad | comunidad | contribuir | zona | investigación |
| estudio | acción | ambiental | estrategia | natural | conservación | importancia | permitir |
| comunidad | organización | estrategia | local | capacidad | impacto | área | social |
| zona | zona | agrícola | cultivo | nivel | investigación | alto | estrategia |
| sistema | investigación | conservación | nivel | investigación | ambiental | municipio | actividad |
| población | sistema | control | zona | desarrollo | especie | forestal | región |
| permitir | económico | cultivo | social | social | permitir | hongo | alto |
| área | permitir | investigación | desarrollo | resiliencia | suelo | sustentable | estudio |
| ecosistema | comunidad | social | comunidad | socioecológico | social | bosque | suelo |
| agua | actividad | región | rural | cambio climático | comunidad | sistema | ecosistema |
| ambiental | desarrollo | conocimiento | ambiental | climático | región | especie | comunidad |
| salud | ambiental | desarrollo | agua | cambio | desarrollo | comunidad | desarrollo |
| desarrollo | social | sistema | sistema | sistema | sistema | región | zona |
En Tabla 2 vemos las palabras más importantes para cada uno de los 8 tópicos en los que fueron agrupadas las propuestas. Ahora le damos un nombre más entendible a cada tópico, tomando en cuenta las palabras más importantes para cada uno podríamos llamarlas como:
- Ecosistemas urbanos y población
- Gestión participativa y proyectos productivos
- Agroecología y conservación
- Comunidades rurales y agua
- Resiliencia y cambio climático
- Conservación de especies y suelos
- Saberes tradicionales, forestales y alimentarios
- Estudios ecosistémicos generales
Representamos ahora visualmente el valor beta obtenido en la LDA que nos indica qué tan importante es un término para un tópico, en la Figura 1.
Código
# MANUALMENTE -----------------------------
topicos = list("Ecosistemas urbanos y población",
"Gestión participativa y proyectos productivos",
"Agroecología y conservación",
"Comunidades rurales y agua",
"Resiliencia y cambio climático",
"Conservación de especies y suelos",
"Saberes tradicionales, forestales y alimentarios",
"Estudios ecosistémicos generales")
names(topicos) = sprintf("%02d", 1:k)
topicos_df = data.frame(topic = 1:k, topico = unlist(topicos))
df_top_terms |>
mutate(term = reorder(term, beta)) |>
dplyr::filter(!term %in% tops$term) |>
left_join(topicos_df) |>
mutate(term = tidytext::reorder_within(term, beta, topic)) |>
ggplot(aes(term, beta)) +
geom_col(show.legend = FALSE, fill = "indianred") + theme_minimal() +
facet_wrap(~ topico, scales = "free_y") +
scale_x_reordered() +
coord_flip() +
labs(title = "Términos más frecuentes por tópico", x = "Término",
subtitle = paste0("De acuerdo a la columna '", columna, "'"))
El LDA como lo configuramos nos da grupos de distinto tamaño para cada tópico, (Figura 2)
Código
#df_top_terms |>
# ggplot(aes(topic, term, size = beta)) + geom_point(alpha = 0.5, color = "indianred")
docbytopic |>
left_join(topicos_df) |>
count(topico) |>
ggplot(aes(fct_reorder(stringr::str_wrap(topico,20), n), n ) ) +
geom_col(fill = "indianred") +
geom_text(aes(label = n) ) +
coord_flip() + labs(x = "Tópicos", y = "Número de propuestas")
docsmax = docbytopic |>
group_by(document) |>
dplyr::filter(gamma == max(gamma)) |>
ungroup()
La base de datos contaba con un etiquetado manual de los estados de la república donde se llevarían a cabo los proyectos, esto lo visualizamos en la Figura 3
Código
docs_edos = datos |>
dplyr::select(documento, estados) |>
tidyr::separate_longer_delim(estados, delim = ",")
gs = vector(mode = "list", length = k)
topicos_estados = docsmax |>
left_join(docs_edos, by = c("document" = "documento")) |>
count(estados, topic, name = "total") |>
dplyr::filter(estados != "")
for(i in 1:k) {
p = topicos_estados |>
dplyr::filter(topic == i) |>
right_join(mex, by = c("estados" = "NAME_1")) |>
st_as_sf() |>
ggplot(aes(fill = total)) +
geom_sf() +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
title = element_text(size = 6)) +
scale_fill_viridis_b(option = "D", name = "Núm. de\npropuestas",
limits = c(0, max(topicos_estados$total))) +
labs(title = stringr::str_wrap(paste0(i, ": ", topicos[[sprintf("%02d", i)]]), 25) )
gs[[i]] = p
}
eval(
parse(
text = paste(
paste0("gs[[", 1:8, "]] ", collapse = " + "),
"+ guide_area() + patchwork::plot_layout(ncol = 3, guides = 'collect')")
)
)
La segunda fase de la convocatoria fue la aprobación de las propuestas, a las que le ajustamos el LDA que creamos al principio, con la función topicmodels::posterior y hacemos una visualización tipo “termite plot” en la Figura 5. Pero antes presentamos un agrupamiento de tópicos en Figura 4
Código
topics_tokens = datos_tok_monogram |>
dplyr::select(documento, lemma, n) |>
dplyr::filter(!grepl("documento", lemma)) |>
left_join(docsmax[,c("document", "topic")], by = c("documento" = "document")) |>
left_join(topicos_df, by = "topic")
topics_dtm = cast_dtm(topics_tokens, topico, lemma, n)
topicos_dtm = removeSparseTerms(topics_dtm, 0.8)
terms_mat <- as.matrix(topics_dtm)
termsdist <- dist(scale(terms_mat))
termsclust <- hclust(termsdist, method = "complete")
plot(termsclust)
Código
datos_eval = datos_eval |>
select(id_proy, descripcion,
aprovechamiento_restauracion_o_conservacion_de_ecosistemas:diseno_de_instrumentos_de_planeacion)
datos_aprobadas = topics_tokens |>
left_join(datos[,c("título", "documento", "num.solicitud")]) |>
stringdist_left_join(datos_eval, by = c("título" = "descripcion")) |>
dplyr::filter(!is.na(aprovechamiento_restauracion_o_conservacion_de_ecosistemas)) |>
ungroup()
aprobadas_tok = datos_tok |>
left_join(datos[,c("num.solicitud", "documento")], by = c("documento")) |>
dplyr::filter(num.solicitud %in% unique(datos_aprobadas$num.solicitud)) |>
dplyr::select(documento, lemma, n)
aprobadas_dtm = cast_dtm(aprobadas_tok, documento, lemma, n)
aprobadas_lda = topicmodels::posterior(df_lda, aprobadas_dtm)
# plot geom col y termite propuestas aprobadas -------------------------
aprobadas_gamma = datos_tok[,1:3] |>
left_join(docbytopic, by = c("documento" = "document"), relationship = "many-to-many") |>
group_by(documento, lemma) |>
dplyr::filter(gamma == max(gamma) & n == max(n)) |>
dplyr::filter(documento %in% unique(datos_aprobadas$documento)) |>
ungroup()
left_join(aprobadas_gamma, df_top_terms,
by = c("lemma" = "term", "topic" = "topic")) |>
filter(!is.na(beta)) |>
dplyr::filter(!lemma %in% tops$term) |>
left_join(topicos_df) |>
# mutate(lemma = tidytext::reorder_within(lemma, beta, topico)) |>
group_by(lemma, topico) |>
filter(documento == min(documento)) |> # es que se repetían en dos documentos
ggplot(aes(stringr::str_wrap(topico, 18),
fct_rev(lemma), size = beta,
label = round(beta, 3))) +
geom_point(aes(size = beta), color = "indianred", alpha = 0.6) +
geom_text(hjust = -.1, vjust = -.1, size = 3) +
scale_x_discrete(position = "top") +
scale_size_continuous(range = c(2,12)) +
labs(x = "Tópicos del modelo LDA", y = "Término") +
theme(axis.text.y = element_text(size = 10), legend.position = "none") 
Después de la aprobación las propuestas pasaron por un proceso extenso de revisión, corrección, ajuste, redacción, por lo cual los resúmenes fueron fuertemente modificados; finalmente los proyectos fueron ubicados en 5 secciones de un libro. Podemos hacer una visualización de la ruta de tópicos que siguió cada propuesta, con el paso final de la sección del libro en la que quedaron, en la Figura 6 creada con el paquete ggsankey (Sjoberg, 2024). La figura fue modificada y se retiró la leyenda para no ser igual a la presentada en el libro, para cuidar los derechos de autoría.
Sjoberg, D. (2024). ggsankey: Sankey, Alluvial and Sankey Bump Plots. Recuperado a partir de https://github.com/davidsjoberg/ggsankey
Código
datos_libro = datos_libro |>
mutate(no_solicitud = as.integer(no_solicitud)) |>
left_join(datos[,c("num.solicitud", "documento")], by = c("no_solicitud" = "num.solicitud"))
datos_libro = datos_libro |>
stringdist_left_join(secciones_docs, by = c("nombre_del_texto" = "titulo"), max_dist = 5) |>
dplyr::filter(name != "NV_R1__David_Delgado") # este tenía el mismo id que otro
datos_libro_tok = unnest_tokens(datos_libro, lemma, resumen) |>
anti_join(stop_words, by = c("lemma" = "word")) |>
count(documento, lemma)
datos_libro_dtm = cast_dtm(datos_libro_tok, documento, lemma, n)
datos_libro_lda = topicmodels::posterior(df_lda, datos_libro_dtm)
docsmax = docsmax |> mutate(topic = as.character(topic))
aprobadasmax = aprobadas_lda$topics |>
as.data.frame() |>
mutate(document = rownames(aprobadas_lda$topics)) |>
pivot_longer(cols = 1:8, names_to = "topic", values_to = "gamma") |>
group_by(document) |>
dplyr::filter(gamma == max(gamma))
libromax = datos_libro_lda$topics |>
as.data.frame() |>
mutate(document = rownames(datos_libro_lda$topics)) |>
pivot_longer(cols = 1:8, names_to = "topic", values_to = "gamma") |>
group_by(document) |>
dplyr::filter(gamma == max(gamma))
secciones = c("Uso sustentable, restauración y conservación",
"Coproducción de prácticas sustentables en sistemas alimentarios",
"Salud ambiental y humana y degradación de socioecosistemas",
"Coconstrucción de prácticas que reducen conflictos socioecológicos",
"Generación de escenarios socioecológicos futuros")
topicos_fases = bind_rows(docsmax, aprobadasmax, libromax, .id = "fase", ) |>
dplyr::select(-gamma) |>
left_join(topicos_df |>
mutate(topic = as.character(topic)))
topicos_capitulo = topicos_fases[topicos_fases$fase == 3, c("fase", "document", "topic")]
names(topicos_capitulo) = c("fase", "document", "topic", "topico")
topicos_capitulo$fase = "4"
topicos_capitulo = topicos_capitulo |>
left_join(datos_libro, by = c("document" = "documento")) |>
select(fase, document, topic, topico = seccion)
bind_rows(topicos_fases, topicos_capitulo) |>
mutate(topico = str_wrap(topico, 40)) |>
dplyr::select(-topic) |>
pivot_wider(names_from = fase, values_from = topico ) |>
dplyr::filter(!(is.na(`2`) & !is.na(`3`)) ) |>
magrittr::set_names(c("document", "Propuesta", "Aceptación", "Publicación", "Demanda")) |>
#dplyr::select(-Propuesta) |>
dplyr::filter(across(1:2, ~ !is.na(.x))) |>
make_long(Propuesta,
Aceptación, Publicación, Demanda) |>
ggplot(aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = factor(fct_rev(node)),
label = node)) +
geom_sankey( na.rm = TRUE) +
scale_x_discrete(label = c("Propuesta\n(193)", "Aceptación\n(36)", "Capítulo\n(41)",
"Secciones\n(41)")) +
scale_fill_viridis_d(name = "Tópicos modelados Demandas",
na.translate = FALSE) +
theme_sankey(base_size = 12) +
labs(x = "", y = "") + theme(legend.position = "none")