“INCLUSIÓN SOCIAL LABORAL EN EL GRUPO EMPRESARIAL WILLCORP PERÚ S.A.C. 2024

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, fig.width = 12, fig.height = 8)

if (!require("pacman")) install.packages("pacman")

## Loading required package: pacman

## Warning: package 'pacman' was built under R version 4.3.1

pacman::p_load(
  tidyverse, tm, pdftools, tidytext, textstem, SnowballC, widyr, 
  igraph, ggraph, stopwords, wordcloud, lubridate, gridExtra, 
  quanteda, syuzhet, ggrepel, viridis, ggwordcloud, stringi,
  ggcorrplot, factoextra, cluster, ggdendro, RColorBrewer, 
  scales, ggpubr, grid, patchwork, lexicon
)

# Cambiar según tu directorio de trabajo
setwd("C:/Users/HP/Desktop/RA")
cat("Directorio actual:", getwd(), "\n")

## Directorio actual: C:/Users/HP/Desktop/RA

pdf_files <- list.files(pattern = "\\.pdf$", full.names = TRUE)

# Crear estructura base de datos
datos_texto <- tibble(
  documento = basename(pdf_files),
  rol = str_remove(documento, "\\.pdf$") %>% 
    str_replace("OP CO", "Operario Cocina ") %>%
    str_replace("JE ", "Jefe "),
  texto = map_chr(pdf_files, ~ paste(pdf_text(.), collapse = " "))
)



limpiar_texto <- function(texto) {
  texto <- tolower(texto) %>%
    str_remove_all("\\d+") %>%
    str_replace_all("[[:punct:]]", " ") %>%
    str_replace_all("\\s+", " ") %>%
    str_trim()
  return(texto)
}

extraer_preguntas_respuestas <- function(texto) {
  secciones <- str_split(texto, "Pregunta\\s*\\d+\\.\\s*")[[1]]
  secciones <- secciones[secciones != ""]
  
  respuestas <- map_chr(secciones, ~ {
    pos <- str_locate(.x, "\\s\\-\\s")[1]
    ifelse(!is.na(pos), str_sub(.x, pos + 3), .x)
  })
  
  preguntas <- map_chr(secciones, ~ {
    if (str_detect(.x, "\\s\\-\\s")) {
      str_match(.x, "(.*?)\\s\\-\\s")[1,2] %>% 
        str_trim() %>% 
        str_replace_all("\\n", " ")
    } else {
      "Pregunta sin formato"
    }
  })
  
  return(tibble(pregunta = preguntas, respuesta = respuestas))
}


# Extraer Q&A
datos_separados <- datos_texto %>%
  mutate(secciones = map(texto, extraer_preguntas_respuestas)) %>%
  unnest(secciones) %>%
  group_by(documento) %>%
  mutate(pregunta_id = row_number()) %>%
  ungroup()

# Filtrar preguntas relevantes
datos_separados <- datos_separados %>%
  filter(pregunta_id >= 2) %>%
  mutate(pregunta_id = pregunta_id - 1)

# Mapeo dimensiones
mapeo_preguntas <- tibble(
  pregunta_id = 1:9,
  dimension = rep(c("Motivación", "Supervisión", "Autoeficiencia"), each = 3),
  pregunta_nombre = c(
    "Valoración y reconocimiento", "Motivación para desempeño", "Interés por desarrollo",
    "Supervisión equitativa", "Indicaciones claras", "Trato equitativo",
    "Herramientas desarrollo", "Capacidad resolución", "Contribución metas"
  )
)

datos_respuestas <- datos_separados %>%
  left_join(mapeo_preguntas, by = "pregunta_id") %>%
  filter(!is.na(dimension))

# Limpieza de tokens
datos_procesados <- datos_respuestas %>%
  mutate(texto_limpio = map_chr(respuesta, limpiar_texto)) %>%
  unnest_tokens(palabra, texto_limpio) %>%
  mutate(palabra_stem = wordStem(palabra, language = "spanish")) %>%
  anti_join(tibble(palabra = stopwords("es", source = "stopwords-iso")), by = "palabra") %>%
  filter(nchar(palabra_stem) > 3)



frecuencias_rol <- datos_procesados %>%
  count(rol, palabra_stem, sort = TRUE) %>%
  group_by(rol) %>%
  mutate(proporcion = n / sum(n)) %>%
  ungroup()

# Paleta de colores
num_roles <- length(unique(frecuencias_rol$rol))
colores <- viridis_pal(option = "C")(num_roles)

# Gráfico de frecuencias
frecuencias_rol %>% 
  group_by(rol) %>% 
  slice_max(n, n = 8, with_ties = FALSE) %>%
  ungroup() %>%
  ggplot(aes(reorder_within(palabra_stem, n, rol), n, fill = rol)) +
  geom_col(alpha = 0.85, show.legend = FALSE) +
  geom_text(aes(label = n), hjust = -0.1, size = 3.5) +
  facet_wrap(~ rol, scales = "free", ncol = 2, labeller = label_wrap_gen(width = 15)) +
  coord_flip() +
  scale_x_reordered() +
  labs(title = "TÉRMINOS MÁS FRECUENTES POR ROL LABORAL",
       x = "Palabra (raíz)", y = "Frecuencia") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(face = "bold", size = 18, hjust = 0.5),
        strip.text = element_text(face = "bold", size = 12)) +
  scale_fill_manual(values = colores)

# Diccionario personalizado
diccionario_sentimientos <- tibble(
  palabra = c(
    # Palabras positivas (30)
    "motiv", "apreci", "valor", "reconoc", "crec", "apoy", "confi", "feliz", 
    "satisf", "logr", "equit", "facil", "eficaz", "capac", "aprend", "gust", 
    "favor", "correct", "respet", "clar", "excel", "orgull", "content", 
    "agradec", "entusiasm", "proactiv", "exitos", "alegr", "benef", "optim",
    # Palabras negativas (30)
    "problem", "dificult", "falt", "presion", "aburr", "deber", "neg", 
    "confus", "ambigu", "diferenc", "olvid", "perd", "mal", "error", "deficien", 
    "limit", "restric", "prohib", "dificil", "neglig", "critic", "insatisf", 
    "frustr", "estres", "molest", "quej", "descontent", "cans", "preocup", "decepcion",
    # Sugerencias (14)
    "suger", "propuest", "cambi", "evolucion", "innov", "potencial", "oportun", 
    "futur", "desarroll", "progres", "recomend", "ide", "iniciat", "altern"
  ),
  sentimiento = c(rep("positivo", 30), rep("negativo", 30), rep("sugerencia", 14))
) %>%
  mutate(palabra_stem = wordStem(palabra, language = "spanish")) %>%
  distinct(palabra_stem, .keep_all = TRUE)

# Cálculo de sentimientos
sentimientos_respuestas <- datos_respuestas %>%
  mutate(texto_limpio = map_chr(respuesta, limpiar_texto)) %>%
  unnest_tokens(palabra, texto_limpio) %>%
  mutate(palabra_stem = wordStem(palabra, language = "spanish")) %>%
  inner_join(diccionario_sentimientos, by = "palabra_stem") %>%
  count(documento, rol, dimension, pregunta_nombre, sentimiento) %>%
  pivot_wider(names_from = sentimiento, values_from = n, values_fill = 0) %>%
  mutate(balance = positivo - negativo)

# Gráfico de balance emocional
sentimientos_agregados <- sentimientos_respuestas %>%
  group_by(rol, dimension) %>%
  summarise(balance_promedio = mean(balance), .groups = "drop")

ggplot(sentimientos_agregados, aes(dimension, balance_promedio, fill = rol)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.7, alpha = 0.9) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red", size = 1) +
  geom_text(aes(label = round(balance_promedio, 1)), 
            position = position_dodge(width = 0.8), vjust = -0.8, size = 5) +
  labs(title = "BALANCE EMOCIONAL POR DIMENSIÓN Y ROL",
       y = "Balance (Positivo - Negativo)") +
  theme_minimal(base_size = 14) +
  scale_fill_manual(values = colores) +
  theme(plot.title = element_text(face = "bold", size = 20, hjust = 0.5))

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# Bigramas
datos_bigramas <- datos_respuestas %>%
  mutate(texto_limpio = map_chr(respuesta, limpiar_texto)) %>%
  unnest_tokens(bigrama, texto_limpio, token = "ngrams", n = 2) %>%
  separate(bigrama, c("palabra1", "palabra2"), sep = " ") %>%
  filter(!palabra1 %in% stopwords("es"),
         !palabra2 %in% stopwords("es"),
         nchar(palabra1) > 3,
         nchar(palabra2) > 3) %>%
  unite(bigrama, palabra1, palabra2, sep = " ") %>%
  count(rol, bigrama, sort = TRUE) %>%
  group_by(rol) %>%
  slice_max(n, n = 5) %>%
  ungroup()

# Heatmap de términos clave
terminos_clave <- c("motiv", "desarroll", "supervis", "equip", "herramient", 
                    "problem", "solucion", "clar", "aprend", "capac", "equit", "respet")
datos_terminos <- datos_procesados %>%
  filter(palabra_stem %in% terminos_clave) %>%
  count(rol, palabra_stem) %>%
  complete(rol, palabra_stem, fill = list(n = 0)) %>%
  mutate(palabra = recode_factor(palabra_stem,
                                 "motiv" = "Motivación",
                                 "desarroll" = "Desarrollo",
                                 "supervis" = "Supervisión",
                                 "equip" = "Equipo",
                                 "herramient" = "Herramientas",
                                 "problem" = "Problemas",
                                 "solucion" = "Soluciones",
                                 "clar" = "Claridad",
                                 "aprend" = "Aprendizaje",
                                 "capac" = "Capacidad",
                                 "equit" = "Equidad",
                                 "respet" = "Respeto"))

# Dendrograma
tdm <- datos_procesados %>% 
  count(documento, palabra_stem) %>% 
  cast_tdm(palabra_stem, documento, n)
distancia_docs <- dist(t(as.matrix(tdm)), method = "euclidean")
hc <- hclust(distancia_docs, method = "ward.D2")

# Combinar gráficos
grid.arrange(
  # Gráfico de bigramas
  ggplot(datos_bigramas, aes(reorder_within(bigrama, n, rol), n, fill = rol)) +
    geom_col() + facet_wrap(~rol, scales = "free_y") + coord_flip() + theme_minimal(),
  
  # Heatmap
  ggplot(datos_terminos, aes(palabra, rol, fill = n)) + geom_tile() + 
    scale_fill_gradient(low = "white", high = "steelblue") + theme_minimal(),
  
  # Dendrograma
  ggdendrogram(hc, rotate = TRUE) + theme_minimal(),
  ncol = 2
)