Rotación en supermercados: consultoría estadística para una tesis de grado

Del archivo de Google Forms a las tablas de la tesis, con cada decisión explicada.

Caso ficticio de consultoría para una tesis de grado: del cuestionario a las tablas de la tesis, con todo el análisis en R.

Datos ficticios. El estudiante, los supermercados y las 230 respuestas no existen. Los datos se simularon en R con patrones programados, con fines de demostración, y recibieron a propósito problemas comunes en cuestionarios en línea. Los resultados muestran el método de trabajo; no son un hallazgo sobre supermercados reales.

Descargar las respuestas brutas (CSV) · Descargar el diccionario de preguntas (CSV)

El cuestionario, los archivos CSV y los comentarios del código R están en portugués, el idioma original del caso.

library(tidyverse)
library(gtsummary)
library(patchwork)
library(knitr)

# A análise roda uma vez, em scripts/analise.R, e grava os resultados que as
# versões em português, espanhol e inglês desta página leem.
caso <- "../../../projetos/caso-tcc-rotatividade"
res <- readRDS(file.path(caso, "resultados/analise.rds"))
source(file.path(caso, "scripts/rotulos.R"))
source(file.path(caso, "scripts/apresentacao.R"))
tx <- rotulos("es")
preparar(tx)

# Os trechos de código abaixo são os de scripts/analise.R e scripts/apresentacao.R.
read_chunk(file.path(caso, "scripts/analise.R"))
read_chunk(file.path(caso, "scripts/apresentacao.R"))

b <- setNames(res$resultado$beta, res$resultado$termo)
pv <- setNames(res$resultado$p, res$resultado$termo)
alfa <- setNames(res$conf$alfa, res$conf$bloco)
teste_f <- function(h) paste0("F(", h[["gl1"]], ", ", h[["gl2"]], ") = ", tx$num(h[["F"]]), ", ", tx$p_txt(h[["p"]]))

El pedido

Un estudiante de Administración estaba terminando su tesis de grado Liderazgo, reconocimiento e intención de rotación en empleados de supermercados del centro-oeste de Minas Gerais. Aplicó un cuestionario con Google Forms en tiendas de la región: preguntas de perfil y 20 afirmaciones para responder de 1 (totalmente en desacuerdo) a 5 (totalmente de acuerdo), en cinco bloques.

Bloque	Ítems	Ejemplo de afirmación
Liderazgo	5	“Mi supervisor me trata con respeto.”
Reconocimiento	4	“Recibo elogios por mi trabajo.”
Remuneración percibida	4	“Mi salario es justo por el trabajo que hago.”
Equilibrio entre trabajo y vida	4	“Puedo planificar mis días libres con anticipación.”
Intención de rotación	3	“Tengo la intención de buscar otro empleo en los próximos 12 meses.”

El proyecto tenía cuatro hipótesis:

• H1. Un liderazgo mejor evaluado reduce la intención de irse.
• H2. Más reconocimiento reduce la intención de irse.
• H3. Una remuneración mejor evaluada reduce la intención de irse, con un efecto menor que H1 y H2.
• H4. Más equilibrio entre trabajo y vida reduce la intención de irse.

Tenía la hoja de cálculo exportada de Forms y la indicación de “hacer la parte estadística”. Necesitaba saber qué correr, en qué orden, cómo comprobar si podía confiar en los resultados y cómo reportarlo todo en la tesis.

Lo que hice

1. Limpieza

bruto <- read_csv("dados/respostas_brutas.csv", show_col_types = FALSE)
dic <- read_csv("dados/dicionario.csv", show_col_types = FALSE)

# O Forms exporta o texto inteiro da pergunta como nome da coluna;
# o dicionário troca cada um por um código curto (LID1, REC2...).
names(bruto) <- dic$codigo[match(names(bruto), dic$coluna)]
itens <- filter(dic, construto != "Perfil") |>
  mutate(enunciado = str_match(coluna, "\\[(.*)\\]$")[, 2])
cod <- itens$codigo
blocos <- split(cod, substr(cod, 1, 3))

brancos <- function(df) rowSums(is.na(select(df, all_of(cod))))
iguais <- function(df) apply(select(df, all_of(cod)), 1, sd, na.rm = TRUE) == 0

passo1 <- filter(bruto, aceite == "Sim")
passo2 <- filter(passo1, brancos(passo1) <= 4)      # até 20% dos 20 itens em branco
passo3 <- filter(passo2, !iguais(passo2))           # mesma resposta nos 20 itens

excluidas <- c(sem_aceite = nrow(bruto) - nrow(passo1), brancos = nrow(passo1) - nrow(passo2),
               iguais = nrow(passo2) - nrow(passo3))
celulas_brancas <- sum(is.na(select(passo3, all_of(cod))))

De las 230 respuestas recibidas, 212 pasaron al análisis. Cada exclusión tiene un motivo que se puede escribir en la metodología de la tesis:

Tabla 1: De la exportación de Forms a las respuestas válidas

Etapa	Excluidas	Quedan
Respuestas recibidas		230
Sin aceptación del consentimiento informado	6	224
Más del 20% de los ítems en blanco	7	217
La misma respuesta en todos los ítems	5	212
Respuestas válidas		212

Quien responde todo igual, incluso el ítem invertido de liderazgo (“Mi supervisor rara vez me da retroalimentación”), está diciendo al mismo tiempo que el supervisor da y no da retroalimentación: señal de que no leyó las afirmaciones.

En las respuestas válidas quedaron 87 ítems en blanco dispersos (2,1% de las celdas). La regla fue simple y está escrita en el informe: el puntaje de cada bloque es el promedio de los ítems respondidos, siempre que haya como máximo 1 ítem en blanco por bloque. Dos personas dejaron 2 ítems de Equilibrio en blanco y quedaron sin ese puntaje.

El rango de edad era un campo de texto libre, y cada persona lo escribió a su manera. Una regla de texto unificó las variantes (la columna del medio muestra los datos originales, en portugués):

padronizar_faixa <- function(x) {
  case_when(str_detect(x, "18") ~ "18 a 24",
            str_detect(x, "25") ~ "25 a 34",
            str_detect(x, "35") ~ "35 a 44",
            str_detect(x, "45") ~ "45 ou mais")
}
grafias <- passo3 |>
  mutate(padronizada = padronizar_faixa(faixa_etaria)) |>
  group_by(padronizada) |>
  summarise(escritas = list(sort(unique(faixa_etaria))), pessoas = n())

# Base final: faixa padronizada, item invertido recodificado (1 vira 5, 2 vira 4...).
d <- passo3 |>
  mutate(faixa_etaria = padronizar_faixa(faixa_etaria),
         LID3 = 6L - LID3,
         turno_grupo = if_else(turno == "Noite", "Noturno", "Diurno"),
         tempo_casa = factor(tempo_casa, c("Até 1 ano", "De 1 a 3 anos", "De 3 a 5 anos", "Mais de 5 anos")))
stopifnot(!anyNA(d$faixa_etaria))

Tabla 2: Rango de edad: variantes encontradas y categoría final

Categoría final	Cómo se escribió	Personas
18 a 24	“18-24”, “18 - 24 anos”, “18 a 24”, “18 a 24 anos”, “de 18 a 24”	58
25 a 34	“25-34”, “25 a 34”, “25 á 34”, “25 a 34 anos”, “De 25 a 34”	83
35 a 44	“35-44”, “35 a 44”, “35 A 44”, “35 a 44 anos”	48
45 o más	“45 anos ou mais”, “45 ou mais”, “45+”, “Mais de 45”	23

2. Perfil de la muestra

tabela_perfil <- function(res, tx) {
  res$d |>
    transmute(sexo = traduzir(sexo, tx$sexo),
              faixa = traduzir(faixa_etaria, tx$faixa),
              escolaridade = traduzir(escolaridade, tx$escolaridade, ordem = TRUE),
              funcao = traduzir(funcao, tx$funcao),
              turno = traduzir(turno, tx$turno, ordem = TRUE),
              tempo = traduzir(tempo_casa, tx$tempo, ordem = TRUE)) |>
    setNames(tx$perfil[c("sexo", "faixa", "escolaridade", "funcao", "turno", "tempo")]) |>
    tbl_summary(statistic = all_categorical() ~ "{n} ({p}%)") |>
    modify_header(label = tx$perfil[["titulo"]], stat_0 = tx$perfil[["n"]]) |>
    modify_footnote(everything() ~ NA) |>
    as_kable()
}

Tabla 3: Perfil de las respuestas válidas

Característica	n (%)
Sexo
Femenino	112 (53%)
Masculino	94 (44%)
Prefiero no informar	6 (2,8%)
Rango de edad
18 a 24	58 (27%)
25 a 34	83 (39%)
35 a 44	48 (23%)
45 o más	23 (11%)
Escolaridad
Educación básica	26 (12%)
Educación media	130 (61%)
Universitaria incompleta	31 (15%)
Universitaria completa	25 (12%)
Función
Carnicería y panadería	33 (16%)
Atención al cliente	33 (16%)
Almacén	33 (16%)
Cajero(a)	55 (26%)
Reponedor(a)	58 (27%)
Turno
Mañana	74 (35%)
Tarde	76 (36%)
Noche	62 (29%)
Antigüedad
Hasta 1 año	67 (32%)
De 1 a 3 años	68 (32%)
De 3 a 5 años	39 (18%)
Más de 5 años	38 (18%)

3. Confiabilidad de las escalas

Antes de sumar afirmaciones en un puntaje, hay que mostrar que miden lo mismo. Usé dos indicadores: el alfa de Cronbach, que el director de tesis y el jurado esperan ver, y el omega de McDonald, más adecuado cuando las afirmaciones no pesan todas igual en el constructo. Por encima de 0,70 es el umbral habitual.

confiab <- function(cols) {
  x <- select(d, all_of(cols))
  c(alfa = suppressWarnings(psych::alpha(x)$total$raw_alpha),
    omega = suppressMessages(suppressWarnings(psych::omega(x, nfactors = 1, plot = FALSE)$omega.tot)))
}
rem_sem4 <- c("REM1", "REM2", "REM3")
conf <- bind_rows(
  lapply(names(blocos), function(b) c(bloco = b, itens = length(blocos[[b]]), confiab(blocos[[b]]))),
  c(bloco = "REM_sem4", itens = 3, confiab(rem_sem4))
) |>
  mutate(across(c(itens, alfa, omega), as.numeric)) |>
  arrange(match(bloco, c("LID", "REC", "REM", "REM_sem4", "EQU", "INT")))

# Correlação de cada item de Remuneração com o total dos outros três.
r_rem <- psych::alpha(select(d, all_of(blocos$REM)))$item.stats$r.drop
names(r_rem) <- blocos$REM

Tabla 4: Alfa de Cronbach y omega de cada bloque

Bloque	Ítems	Alfa	Omega
Liderazgo	5	0,83	0,83
Reconocimiento	4	0,85	0,85
Remuneración percibida	4	0,68	0,73
Remuneración percibida, sin REM4	3	0,82	0,83
Equilibrio entre trabajo y vida	4	0,81	0,81
Intención de rotación	3	0,84	0,84

Cuatro bloques pasaron con holgura. Remuneración quedó en 0,68 por un ítem: “Recibo el subsidio de transporte a tiempo” (REM4) casi no acompaña a los otros tres (correlación de 0,09 con el total de ellos, frente a 0,58 o más en los demás). Tiene sentido: mide la puntualidad de un beneficio, no si el salario parece justo. Sin él, el alfa sube a 0,82. REM4 salió del puntaje de Remuneración, y la tesis registra esa decisión y el motivo.

4. Análisis factorial exploratorio

El análisis factorial comprueba si las 20 afirmaciones se agrupan en los cinco bloques que preveía el cuestionario. Como las respuestas son ordinales (1 a 5), usé la correlación policórica, que trata cada respuesta como un tramo de una escala continua y no supone que la distancia entre “1” y “2” sea igual a la distancia entre “4” y “5”.

x_itens <- select(d, all_of(cod))
pc <- suppressWarnings(polychoric(x_itens)$rho)
kmo <- KMO(pc)$MSA
bartlett <- cortest.bartlett(pc, n = nrow(d))
fe <- suppressWarnings(fa(x_itens, nfactors = 5, cor = "poly", rotate = "oblimin", fm = "minres"))

cargas <- unclass(fe$loadings)
# Dá a cada fator o código do bloco cujos itens carregam mais nele.
dominante <- sapply(seq_len(ncol(cargas)), function(f) {
  names(which.max(tapply(abs(cargas[, f]), substr(rownames(cargas), 1, 3), mean)))
})
colnames(cargas) <- dominante
cargas <- cargas[, c("LID", "REC", "REM", "EQU", "INT")]
carga_rem4 <- max(abs(cargas["REM4", ]))

El KMO fue 0,84 (por encima de 0,80 se considera muy bueno) y la prueba de Bartlett dio χ²(190) = 2.198,0, p < 0,001: las correlaciones entre las afirmaciones son lo bastante fuertes para un análisis factorial. Con cinco factores y rotación oblicua (los constructos pueden correlacionarse), cada afirmación cargó en su bloque, con una excepción ya conocida: REM4 no cargó en ningún factor (carga máxima de 0,14), lo que confirma la decisión de la confiabilidad.

Tabla 5: Cargas factoriales (correlación policórica, rotación oblimin); cargas menores que 0,30 omitidas

Ítem	Lid.	Rec.	Rem.	Equ.	Int.
LID1	0,76
LID2	0,63
LID3	0,84
LID4	0,66
LID5	0,59
REC1		0,81
REC2		0,70
REC3		0,79
REC4		0,73
REM1			0,83
REM2			0,83
REM3			0,77
REM4
EQU1				0,73
EQU2				0,86
EQU3				0,62
EQU4				0,72
INT1					0,74
INT2					0,83
INT3					0,79

5. Puntajes y comparaciones entre grupos

escore <- function(cols) {
  m <- as.matrix(select(d, all_of(cols)))
  if_else(rowSums(is.na(m)) <= 1, rowMeans(m, na.rm = TRUE), NA_real_)
}
d <- d |>
  mutate(LID = escore(blocos$LID), REC = escore(blocos$REC), REM = escore(rem_sem4),
         EQU = escore(blocos$EQU), INT = escore(blocos$INT))

Los puntajes de escalas Likert suelen ser asimétricos y con valores repetidos, así que comparé la intención de irse entre grupos con pruebas no paramétricas, siempre con el tamaño del efecto, que indica si la diferencia es grande o solo estadísticamente detectable.

mw <- wilcox_test(d, INT ~ turno_grupo)
mw_r <- wilcox_effsize(d, INT ~ turno_grupo)
kw <- kruskal_test(d, INT ~ tempo_casa)
kw_e <- kruskal_effsize(d, INT ~ tempo_casa)
dunn <- dunn_test(d, INT ~ tempo_casa, p.adjust.method = "holm")
dunn_novato <- filter(dunn, group1 == "Até 1 ano", p.adj < 0.05)

resumo_grupos <- function(var) {
  d |> group_by(grupo = as.character(.data[[var]])) |>
    summarise(n = n(), mediana = median(INT), q1 = quantile(INT, .25), q3 = quantile(INT, .75))
}
grupos <- bind_rows(resumo_grupos("turno_grupo"), resumo_grupos("tempo_casa"))

• Turno. Quien trabaja de noche tiene mayor intención de irse (Mann-Whitney, p < 0,001, r = 0,25, efecto pequeño).
• Antigüedad. Los rangos difieren (Kruskal-Wallis, H(3) = 10,1, p = 0,018, ε² = 0,034, efecto pequeño). En las comparaciones por pares (Dunn, con corrección de Holm), la diferencia que se sostiene es entre “hasta 1 año” y “de 1 a 3 años”; las demás comparaciones no fueron significativas.

Tabla 6: Intención de rotación (puntaje de 1 a 5) por turno y por antigüedad

Grupo	n	Mediana	Rango intercuartílico
Diurno	150	2,67	2,33 a 3,67
Nocturno	62	3,58	2,67 a 4,00
Hasta 1 año	67	3,33	2,67 a 4,00
De 1 a 3 años	68	2,67	2,00 a 3,38
De 3 a 5 años	39	3,00	2,42 a 3,83
Más de 5 años	38	3,00	2,08 a 3,67

6. Correlaciones

ct <- corr.test(select(d, LID, REC, REM, EQU, INT), method = "spearman", adjust = "none")
rho <- ct$r
p_int <- ct$p["INT", c("LID", "REC", "REM", "EQU")]

La correlación de Spearman (adecuada para puntajes ordinales) muestra los cuatro bloques asociados a la intención de irse, todos en el sentido esperado (p = 0,002 o menor). Los bloques también se correlacionan entre sí, lo que importa para el paso siguiente.

Tabla 7: Correlaciones de Spearman entre los puntajes (N varía de 210 a 212 según los blancos)

Bloque	Lid.	Rec.	Rem.	Equ.	Int.
Liderazgo
Reconocimiento	0,48
Remuneración percibida	0,13	0,27
Equilibrio entre trabajo y vida	0,34	0,35	0,14
Intención de rotación	-0,49	-0,51	-0,31	-0,22

7. Regresión múltiple

La correlación mira un factor a la vez. Para poner a prueba las hipótesis, la pregunta es otra: ¿cuánto pesa cada factor cuando los demás están en el mismo modelo? Usé regresión lineal múltiple con los cuatro puntajes estandarizados (para que los efectos sean comparables) y tres controles: turno nocturno, hasta 1 año en la empresa y sexo.

dm <- d |>
  transmute(INT = INT, LID = LID, REC = REC, REM = REM, EQU = EQU,
            noturno = as.numeric(turno == "Noite"),
            novato = as.numeric(tempo_casa == "Até 1 ano"),
            feminino = as.numeric(sexo == "Feminino")) |>
  drop_na() |>
  mutate(across(c(INT, LID, REC, REM, EQU), \(v) as.numeric(scale(v))))
modelo <- lm(INT ~ LID + REC + REM + EQU + noturno + novato + feminino, data = dm)

# Pressupostos
vifs <- vif(modelo)
bp <- bptest(modelo)
sw <- shapiro.test(residuals(modelo))
cook_max <- max(cooks.distance(modelo))

# Erros-padrão robustos (HC3): protegem os testes se a variância dos resíduos não for constante.
v_hc3 <- vcovHC(modelo, type = "HC3")
rob <- coeftest(modelo, vcov. = v_hc3)
ic <- coefci(modelo, vcov. = v_hc3)
resultado <- tibble(termo = rownames(rob), beta = rob[, 1], ep = rob[, 2], p = rob[, 4],
                    li = ic[, 1], ls = ic[, 2]) |>
  filter(termo != "(Intercept)")
ajuste <- summary(modelo)
# H3 diz que o efeito da remuneração é menor: testa se os coeficientes são iguais.
igual_lid <- linearHypothesis(modelo, "REM = LID", vcov. = v_hc3)
igual_rec <- linearHypothesis(modelo, "REM = REC", vcov. = v_hc3)
teste <- function(h) c(F = h$F[2], gl1 = h$Df[2], gl2 = h$Res.Df[2], p = h$`Pr(>F)`[2])
menor_confirmado <- igual_lid$`Pr(>F)`[2] < 0.05 && igual_rec$`Pr(>F)`[2] < 0.05
# O texto das páginas foi escrito para o caso em que a diferença não se confirma.
stopifnot(!menor_confirmado)

# H3 tem duas partes: reduz (testada pelo β) e com efeito menor (testada acima).
hipoteses <- tibble(termo = c("LID", "REC", "REM", "EQU")) |>
  left_join(resultado, by = "termo") |>
  mutate(decisao = case_when(!(beta < 0 & p < 0.05) ~ "nao",
                             termo == "REM" & !menor_confirmado ~ "parcial",
                             TRUE ~ "sim"))

Antes de leer los coeficientes, revisé los supuestos:

• Multicolinealidad: VIF máximo de 1,47, lejos del límite habitual de 5. Los bloques se correlacionan, pero no al punto de confundirse.
• Varianza de los residuos: prueba de Breusch-Pagan con p = 0,713. Sin señal fuerte de varianza no constante; aun así, las pruebas usan errores estándar robustos (HC3), que cuestan poco y protegen el resultado.
• Normalidad de los residuos: Shapiro-Wilk con p = 0,049. Con más de 200 casos, una desviación leve no compromete las pruebas de los coeficientes.
• Casos influyentes: distancia de Cook máxima de 0,04, muy por debajo de 1. Ninguna respuesta por sí sola cambia el resultado.

El modelo explica el 43% de la variación de la intención de irse (R² ajustado = 0,41, N = 210).

La H3 dice que el efecto de la remuneración es menor que los de liderazgo y reconocimiento. Mirar los β no alcanza: hay que probar si la diferencia entre ellos es real. La prueba de igualdad de coeficientes (con la misma corrección HC3) no confirmó la diferencia: F(1, 202) = 3,02, p = 0,084 frente a liderazgo y F(1, 202) = 1,92, p = 0,167 frente a reconocimiento.

Lo que mostraron los datos

grafico_likert <- function(res, tx) {
  enunciados <- if (is.null(tx$enunciados)) setNames(res$itens$enunciado, res$itens$codigo) else tx$enunciados
  cod <- res$itens$codigo
  inv <- if_else(res$itens$invertido == "sim", paste0(" (", tx$invertido, ")"), "")
  rotulos_itens <- setNames(paste0(cod, inv, ": ", enunciados[cod]), cod)
  cores_likert <- setNames(c("#6a4fa3", "#b9aee0", "#d9dbe1", "#9dbde8", cor[["azul"]]), tx$likert)

  # Barras divergentes: a resposta neutra fica metade de cada lado do zero.
  lik <- res$respostas |>
    pivot_longer(everything(), names_to = "codigo", values_to = "resposta") |>
    drop_na() |>
    count(codigo, resposta) |>
    group_by(codigo) |>
    complete(resposta = 1:5, fill = list(n = 0)) |>
    arrange(resposta, .by_group = TRUE) |>
    mutate(p = n / sum(n),
           inicio = -(p[1] + p[2] + p[3] / 2) + lag(cumsum(p), default = 0),
           fim = inicio + p, meio = (inicio + fim) / 2) |>
    ungroup() |>
    mutate(nivel = factor(tx$likert[resposta], tx$likert),
           bloco = factor(tx$blocos[substr(codigo, 1, 3)], tx$blocos),
           item = factor(rotulos_itens[codigo], rev(rotulos_itens)))
  totais <- lik |>
    group_by(item, bloco) |>
    summarise(discorda = sum(p[resposta <= 2]), concorda = sum(p[resposta >= 4]), .groups = "drop")
  rotulados <- filter(lik, p >= 0.12)

  ggplot(lik, aes(y = item)) +
    geom_segment(aes(x = inicio, xend = fim, yend = item, colour = nivel), linewidth = 7) +
    geom_vline(xintercept = 0, colour = "white", linewidth = 0.6) +
    geom_text(data = rotulados, aes(x = meio, label = tx$pct(p)), size = 3, family = "Montserrat",
              colour = if_else(rotulados$resposta %in% c(1, 5), "white", cor[["profundo"]])) +
    geom_text(data = totais, aes(x = -0.82, label = tx$pct(discorda)), hjust = 1, size = 2.8,
              family = "Montserrat", colour = cor[["cinza"]]) +
    geom_text(data = totais, aes(x = 0.82, label = tx$pct(concorda)), hjust = 0, size = 2.8,
              family = "Montserrat", colour = cor[["cinza"]]) +
    facet_grid(rows = vars(bloco), scales = "free_y", space = "free_y", labeller = label_wrap_gen(14)) +
    scale_colour_manual(values = cores_likert, drop = FALSE) +
    scale_x_continuous(limits = c(-0.92, 0.92), breaks = c(-0.5, 0, 0.5), labels = \(x) tx$pct(abs(x))) +
    scale_y_discrete(labels = label_wrap_gen(40)) +
    guides(colour = guide_legend(nrow = 2, byrow = TRUE, override.aes = list(linewidth = 4))) +
    labs(x = NULL, y = NULL, colour = NULL) +
    theme(strip.text.y = element_text(angle = 0, hjust = 0, face = "bold"),
          axis.text.y = element_text(size = 10, colour = cor[["profundo"]], lineheight = 0.95),
          legend.text = element_text(size = 10), legend.justification = "left", legend.location = "plot",
          panel.grid.major.y = element_blank(), panel.spacing.y = unit(10, "pt"))
}

Figura 1: Distribución de las respuestas a los 20 ítems, tal como se dieron (LID3 aún sin recodificar)

• La remuneración es el punto peor evaluado. El REM4 se aparta de los otros tres ítems del bloque, el mismo patrón que señalaron la confiabilidad y el análisis factorial.
• El ítem invertido funciona: LID3 tiene el patrón opuesto al de los otros ítems de liderazgo, como debía.

grafico_grupos <- function(res, tx) {
  d <- res$d |>
    mutate(turno_grupo = traduzir(turno_grupo, tx$turno_grupo, ordem = TRUE),
           tempo_casa = traduzir(tempo_casa, tx$tempo, ordem = TRUE))
  caixa <- function(var, destaque, titulo, subtitulo, eixo_y = tx$g_eixo_int) {
    ggplot(d, aes(x = .data[[var]], y = INT)) +
      geom_boxplot(aes(fill = .data[[var]] == destaque), width = 0.55, outlier.shape = NA,
                   colour = cor[["profundo"]], linewidth = 0.4, alpha = 0.85) +
      geom_jitter(width = 0.14, height = 0.06, size = 1.3, alpha = 0.35, colour = cor[["profundo"]]) +
      scale_fill_manual(values = c(`TRUE` = cor[["azul"]], `FALSE` = cor[["lavanda"]]), guide = "none") +
      scale_y_continuous(limits = c(0.85, 5.15), breaks = 1:5) +
      scale_x_discrete(labels = label_wrap_gen(10)) +
      labs(title = titulo, subtitle = subtitulo, x = NULL, y = eixo_y) +
      theme(plot.title = element_text(face = "bold", size = 12),
            plot.subtitle = element_text(size = 10, colour = cor[["cinza"]]),
            panel.grid.major.x = element_blank())
  }
  set.seed(1)  # mesmo espalhamento dos pontos nas três línguas
  caixa("turno_grupo", tx$turno_grupo[["Noturno"]], tx$g_turno,
        paste0("Mann-Whitney, ", tx$p_txt(res$mw[["p"]]), "; r = ", tx$num1(res$mw[["r"]]))) +
    caixa("tempo_casa", tx$tempo[["Até 1 ano"]], tx$g_tempo,
          paste0("Kruskal-Wallis, ", tx$p_txt(res$kw[["p"]]), "; ε² = ", tx$num1(res$kw[["eps2"]], 3)),
          eixo_y = NULL) +
    plot_layout(widths = c(1, 2))
}

Figura 2: Intención de rotación por turno y por antigüedad

• La noche y el primer año pesan. Quien trabaja de noche y quien tiene hasta 1 año en la empresa piensa más en irse, y ambos efectos se mantienen en el modelo de regresión, incluso con los demás factores controlados.

grafico_coef <- function(res, tx, base = 12, rotulo = 3.6) {
  res$resultado |>
    mutate(nome = factor(tx$termos[termo], rev(tx$termos[termo])),
           grupo = if_else(p < 0.05, tx$g_detectado, tx$g_sem_efeito)) |>
    ggplot(aes(x = beta, y = nome, colour = grupo)) +
    geom_vline(xintercept = 0, colour = cor[["cinza"]], linewidth = 0.5, linetype = "dashed") +
    geom_errorbar(aes(xmin = li, xmax = ls), width = 0, linewidth = 1.6) +
    geom_point(size = 3.6, shape = 21, fill = "white", stroke = 2) +
    geom_text(aes(label = tx$num(beta)), vjust = -1.1, size = rotulo, family = "Montserrat",
              colour = cor[["profundo"]], show.legend = FALSE) +
    scale_colour_manual(values = setNames(c(cor[["azul"]], cor[["medio"]]), c(tx$g_detectado, tx$g_sem_efeito))) +
    scale_x_continuous(labels = \(x) tx$num(x)) +
    labs(x = tx$g_eixo_coef, y = NULL, colour = NULL) +
    theme_minimal(base_family = "Montserrat", base_size = base) +
    theme(text = element_text(colour = cor[["profundo"]]),
          axis.text.y = element_text(colour = cor[["profundo"]]),
          panel.grid.minor = element_blank(), panel.grid.major.y = element_blank(),
          panel.grid.major.x = element_line(colour = cor[["grade"]], linewidth = 0.4),
          plot.background = element_blank(), panel.background = element_blank(),
          legend.position = "top", legend.justification = "left")
}

# Capa da página (listagem e compartilhamento), no estilo da capa do Radar:
# fundo azul profundo, logo, título, subtítulo e uma versão pequena do gráfico
# de coeficientes. A listagem mostra só a faixa do meio da imagem (cerca de
# 2/3 da altura), então título e gráfico ficam nessa faixa.
salvar_capa <- function(res, tx, arquivo = "img/capa.png", logo) {
  claro <- c(texto = "#ffffff", sub = "#cacfee", apoio = "#9aa3c7", linha = "#34344f",
             detectado = "#9dbde8", sem_efeito = "#6b7299")
  grafico <- res$resultado |>
    mutate(nome = factor(tx$termos[termo], rev(tx$termos[termo])),
           detectado = p < 0.05) |>
    ggplot(aes(x = beta, y = nome, colour = detectado)) +
    geom_vline(xintercept = 0, colour = claro[["apoio"]], linewidth = 0.5, linetype = "dashed") +
    geom_errorbar(aes(xmin = li, xmax = ls), width = 0, linewidth = 1.8) +
    geom_point(size = 3.8, shape = 21, fill = cor[["profundo"]], stroke = 2) +
    scale_colour_manual(values = c(`TRUE` = claro[["detectado"]], `FALSE` = claro[["sem_efeito"]]), guide = "none") +
    scale_x_continuous(labels = \(x) tx$num(x)) +
    labs(title = tx$capa_grafico, x = NULL, y = NULL) +
    theme_minimal(base_family = "Montserrat", base_size = 15) +
    theme(text = element_text(colour = claro[["sub"]]),
          axis.text.y = element_text(colour = claro[["sub"]], size = 14),
          axis.text.x = element_text(colour = claro[["apoio"]], size = 12),
          plot.title = element_text(colour = claro[["apoio"]], size = 14, margin = margin(b = 10)),
          plot.title.position = "plot",
          panel.grid.minor = element_blank(), panel.grid.major.y = element_blank(),
          panel.grid.major.x = element_line(colour = claro[["linha"]], linewidth = 0.5),
          plot.background = element_blank(), panel.background = element_blank())

  texto <- function(rotulo, y, tamanho, cor_texto, peso = "plain", altura = 1.15) {
    grid::grid.text(rotulo, x = grid::unit(72, "native"), y = grid::unit(675 - y, "native"),
                    just = c("left", "top"),
                    gp = grid::gpar(fontfamily = "Montserrat", fontface = peso, fontsize = tamanho,
                                    col = cor_texto, lineheight = altura),
                    vp = grid::viewport(xscale = c(0, 1200), yscale = c(0, 675)))
  }

  dir.create(dirname(arquivo), showWarnings = FALSE)
  ragg::agg_png(arquivo, width = 1200, height = 675, res = 72, background = cor[["profundo"]])
  on.exit(grDevices::dev.off())
  grid::grid.raster(png::readPNG(logo), x = grid::unit(72, "points"), y = grid::unit(675 - 48, "points"),
                    width = grid::unit(64, "points"), just = c("left", "top"))
  linhas <- function(x) lengths(strsplit(x, "\n"))
  y_titulo <- 175
  texto(tx$capa_titulo, y_titulo, 46, claro[["texto"]], "bold", 1.1)
  y_sub <- y_titulo + 51 * linhas(tx$capa_titulo) + 22
  texto(tx$capa_subtitulo, y_sub, 22, claro[["sub"]], altura = 1.25)
  y_frase <- y_sub + 28 * linhas(tx$capa_subtitulo) + 26
  texto(tx$capa_frase, y_frase, 17, claro[["apoio"]], altura = 1.4)
  texto(tx$capa_rodape, 630, 12, claro[["apoio"]])
  print(grafico, vp = grid::viewport(x = grid::unit(1150, "points"), y = grid::unit(675 / 2, "points"),
                                     width = grid::unit(500, "points"), height = grid::unit(410, "points"),
                                     just = c("right", "center")))
}

Figura 3: Efecto de cada factor en la intención de irse, con los demás factores fijos (β e intervalo de confianza del 95% con errores robustos)

• Liderazgo y reconocimiento son los dos factores más fuertes (β = -0,31 y -0,30). La remuneración también reduce la intención (β = -0,16). La estimación es menor, pero la prueba no confirmó la diferencia: con esta muestra, no se puede afirmar que la remuneración pese menos.
• El equilibrio entre trabajo y vida es el resultado que más enseña. En la correlación simple aparece asociado a la intención de irse (ρ = -0,22), pero en el modelo el efecto se va a cero (β = 0,04, p = 0,468). El equilibrio va de la mano del liderazgo y el reconocimiento: donde el supervisor es bueno, los días libres suelen planificarse. Por sí solo, “toma prestado” el efecto de los demás.

Tabla 8: Prueba de las hipótesis (regresión múltiple, errores estándar robustos HC3)

Hipótesis	β	IC 95%	p	Resultado
H1. El liderazgo reduce la intención	-0,31	[-0,45; -0,18]	< 0,001	Respaldada
H2. El reconocimiento reduce la intención	-0,30	[-0,44; -0,16]	< 0,001	Respaldada
H3. La remuneración la reduce, con un efecto menor	-0,16	[-0,27; -0,05]	0,004	Parcialmente respaldada
H4. El equilibrio reduce la intención	0,04	[-0,07; 0,15]	0,468	No respaldada

Cómo entra esto en la tesis

El estudiante recibe las tablas en formato APA, que la mayoría de las carreras acepta, y un ejemplo de cómo reportar los números. La tabla siguiente es la que va al capítulo de resultados:

Tabla 9: Regresión lineal múltiple de la intención de rotación

Predictor	β	EE	IC 95%	p
Liderazgo	-0,31	0,07	[-0,45; -0,18]	< 0,001
Reconocimiento	-0,30	0,07	[-0,44; -0,16]	< 0,001
Remuneración percibida	-0,16	0,06	[-0,27; -0,05]	0,004
Equilibrio entre trabajo y vida	0,04	0,06	[-0,07; 0,15]	0,468
Turno nocturno	0,45	0,12	[0,22; 0,68]	< 0,001
Hasta 1 año en la empresa	0,40	0,12	[0,16; 0,64]	0,001
Sexo femenino	0,12	0,11	[-0,10; 0,33]	0,280

Nota. N = 210. Puntajes y variable dependiente estandarizados; turno nocturno, hasta 1 año en la empresa y sexo femenino codificados como 0 o 1. EE: error estándar robusto (HC3). R² = 0,43; R² ajustado = 0,41; F(7, 202) = 21,9, p < 0,001.

Ejemplo de redacción. Este párrafo muestra qué números entran y en qué orden. La redacción de la tesis, la discusión de los resultados y las conclusiones son del estudiante.

Para poner a prueba las hipótesis, se estimó una regresión lineal múltiple con errores estándar robustos (HC3), con la intención de rotación como variable dependiente. El modelo explicó el 43% de la varianza (R² ajustado = 0,41). La percepción de liderazgo (β = -0,31, p < 0,001) y el reconocimiento (β = -0,30, p < 0,001) se asociaron negativamente con la intención, lo que respalda H1 y H2. La remuneración percibida también mostró una asociación negativa (β = -0,16, p = 0,004). Aunque la estimación es menor que las de liderazgo y reconocimiento, las pruebas de igualdad de coeficientes no indicaron una diferencia significativa (F(1, 202) = 3,02, p = 0,084 y F(1, 202) = 1,92, p = 0,167, respectivamente); por lo tanto, H3 fue parcialmente respaldada. El equilibrio entre trabajo y vida no mostró asociación tras controlar las demás variables (β = 0,04, p = 0,468); H4 no fue respaldada.

Lo que recibe el estudiante

• El informe completo en Quarto, con el código y los resultados de cada paso. Si la base cambia (por ejemplo, con respuestas que llegan después), basta con correrlo de nuevo.
• El script de R comentado y la base limpia, para que el estudiante y el director de tesis los revisen.
• Las tablas en formato APA, listas para pegar en Word.
• Una explicación en lenguaje sencillo de cada prueba: por qué se eligió, qué significa el resultado y cuáles son sus límites. Sirve para escribir la metodología y para la defensa.
• Una reunión para repasar los resultados y las preguntas que el jurado suele hacer sobre la parte estadística.

El trabajo es del estudiante. Yo hago el análisis y lo explico; la redacción, la interpretación y las conclusiones son suyas.

¿Tienes un cuestionario para analizar?

Puede ser una tesis de grado, de maestría o una encuesta interna de tu empresa. Envíame el proyecto y la hoja de cálculo con las respuestas, y te digo qué se puede hacer y cómo.

Escríbeme