Rotatividade em supermercados: consultoria estatística para um TCC

Do arquivo do Google Forms às tabelas do trabalho, com cada decisão explicada.

Caso fictício de consultoria para um TCC: do questionário às tabelas do trabalho, com toda a análise em R.

Dados fictícios. O aluno, os supermercados e as 230 respostas não existem. Os dados foram simulados em R com padrões programados, para fins de demonstração, e receberam de propósito problemas comuns em questionários online. Os resultados mostram o método de trabalho; não são uma descoberta sobre supermercados reais.

Baixar as respostas brutas (CSV) · Baixar o dicionário das perguntas (CSV)

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 <- "."
res <- readRDS(file.path(caso, "resultados/analise.rds"))
source(file.path(caso, "scripts/rotulos.R"))
source(file.path(caso, "scripts/apresentacao.R"))
tx <- rotulos("pt")
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"]]))

O pedido

Um aluno de Administração estava terminando o TCC Liderança, reconhecimento e intenção de rotatividade em funcionários de supermercados do Centro-Oeste mineiro. Ele aplicou um questionário pelo Google Forms em lojas da região: perguntas de perfil e 20 frases para responder de 1 (discordo totalmente) a 5 (concordo totalmente), em cinco blocos.

Bloco	Itens	Exemplo de frase
Liderança	5	“Meu supervisor me trata com respeito.”
Reconhecimento	4	“Recebo elogios pelo meu trabalho.”
Remuneração percebida	4	“Meu salário é justo pelo trabalho que faço.”
Equilíbrio trabalho e vida	4	“Consigo planejar minhas folgas com antecedência.”
Intenção de rotatividade	3	“Pretendo procurar outro emprego nos próximos 12 meses.”

O projeto tinha quatro hipóteses:

• H1. Uma liderança mais bem avaliada reduz a intenção de sair.
• H2. Mais reconhecimento reduz a intenção de sair.
• H3. Uma remuneração mais bem avaliada reduz a intenção de sair, com efeito menor que H1 e H2.
• H4. Mais equilíbrio entre trabalho e vida reduz a intenção de sair.

Ele tinha a planilha exportada do Forms e a orientação de “fazer a parte estatística”. Precisava saber o que rodar, em que ordem, como conferir se podia confiar nos resultados e como relatar tudo no trabalho.

O que eu fiz

1. Limpeza

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))))

Das 230 respostas recebidas, 212 seguiram para a análise. Cada exclusão tem um motivo que pode ser escrito no método do TCC:

Tabela 1: Da exportação do Forms às respostas válidas

Etapa	Excluídas	Restam
Respostas recebidas		230
Sem aceite do termo de consentimento	6	224
Mais de 20% dos itens em branco	7	217
Mesma resposta em todos os itens	5	212
Respostas válidas		212

Quem responde tudo igual, inclusive o item invertido da liderança (“Meu supervisor raramente me dá retorno”), está dizendo ao mesmo tempo que o supervisor dá e não dá retorno: sinal de que não leu as frases.

Nas respostas válidas sobraram 87 itens em branco espalhados (2,1% das células). A regra foi simples e está escrita no relatório: o escore de cada bloco é a média dos itens respondidos, desde que haja no máximo 1 item em branco por bloco. Duas pessoas deixaram 2 itens de Equilíbrio em branco e ficaram sem esse escore.

A faixa etária era um campo de texto livre, e cada pessoa escreveu de um jeito. Uma regra de texto juntou as grafias:

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))

Tabela 2: Faixa etária: grafias encontradas e categoria final

Padronizada	Como foi escrita	Pessoas
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 ou mais	“45 anos ou mais”, “45 ou mais”, “45+”, “Mais de 45”	23

2. Perfil da amostra

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()
}

Tabela 3: Perfil das respostas válidas

Característica	n (%)
Sexo
Feminino	112 (53%)
Masculino	94 (44%)
Prefiro não informar	6 (2,8%)
Faixa etária
18 a 24	58 (27%)
25 a 34	83 (39%)
35 a 44	48 (23%)
45 ou mais	23 (11%)
Escolaridade
Ensino fundamental	26 (12%)
Ensino médio	130 (61%)
Superior incompleto	31 (15%)
Superior completo	25 (12%)
Função
Açougue e padaria	33 (16%)
Atendimento	33 (16%)
Depósito	33 (16%)
Operador(a) de caixa	55 (26%)
Repositor(a)	58 (27%)
Turno
Manhã	74 (35%)
Tarde	76 (36%)
Noite	62 (29%)
Tempo de casa
Até 1 ano	67 (32%)
De 1 a 3 anos	68 (32%)
De 3 a 5 anos	39 (18%)
Mais de 5 anos	38 (18%)

3. Confiabilidade das escalas

Antes de somar frases num escore, é preciso mostrar que elas medem a mesma coisa. Usei dois indicadores: o alfa de Cronbach, que o orientador e a banca esperam ver, e o ômega, que é mais adequado quando as frases não pesam todas igual no construto. Acima de 0,70 é o patamar usual.

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

Tabela 4: Alfa de Cronbach e ômega de cada bloco

Bloco	Itens	Alfa	Ômega
Liderança	5	0,83	0,83
Reconhecimento	4	0,85	0,85
Remuneração percebida	4	0,68	0,73
Remuneração percebida, sem REM4	3	0,82	0,83
Equilíbrio trabalho e vida	4	0,81	0,81
Intenção de rotatividade	3	0,84	0,84

Quatro blocos passaram com folga. Remuneração ficou em 0,68 por causa de um item: “Recebo o vale-transporte em dia” (REM4) quase não acompanha os outros três (correlação de 0,09 com o total deles, contra 0,58 ou mais nos demais). Faz sentido: ele mede a pontualidade de um benefício, não se o salário parece justo. Sem ele, o alfa sobe para 0,82. REM4 saiu do escore de Remuneração, e o TCC registra essa decisão e o motivo.

4. Análise fatorial exploratória

A fatorial confere se as 20 frases se agrupam nos cinco blocos que o questionário previa. Como as respostas são ordinais (1 a 5), usei a correlação policórica, que trata cada resposta como uma faixa de uma escala contínua e não supõe que a distância entre “1” e “2” seja igual à distância entre “4” e “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", ]))

O KMO foi 0,84 (acima de 0,80 é considerado muito bom) e o teste de Bartlett deu χ²(190) = 2.198,0, p < 0,001: as correlações entre as frases são fortes o bastante para uma fatorial. Com cinco fatores e rotação oblíqua (os construtos podem se correlacionar), cada frase carregou no seu bloco, com uma exceção já conhecida: REM4 não carregou em nenhum fator (maior carga de 0,14), confirmando a decisão da confiabilidade.

Tabela 5: Cargas fatoriais (correlação policórica, rotação oblimin); cargas abaixo de 0,30 omitidas

Item	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. Escores e comparações 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))

Escores de escalas Likert costumam ser assimétricos e com valores repetidos, então comparei a intenção de sair entre grupos com testes não paramétricos, sempre com o tamanho de efeito, que diz se a diferença é grande ou só estatisticamente detectável.

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. Quem trabalha à noite tem intenção de sair maior (Mann-Whitney, p < 0,001, r = 0,25, efeito pequeno).
• Tempo de casa. As faixas diferem (Kruskal-Wallis, H(3) = 10,1, p = 0,018, ε² = 0,034, efeito pequeno). Nas comparações dois a dois (Dunn, com correção de Holm), a diferença que se sustenta é entre “até 1 ano” e “de 1 a 3 anos”; as demais comparações não foram significativas.

Tabela 6: Intenção de rotatividade (escore de 1 a 5) por turno e por tempo de casa

Grupo	n	Mediana	Intervalo interquartil
Diurno	150	2,67	2,33 a 3,67
Noturno	62	3,58	2,67 a 4,00
Até 1 ano	67	3,33	2,67 a 4,00
De 1 a 3 anos	68	2,67	2,00 a 3,38
De 3 a 5 anos	39	3,00	2,42 a 3,83
Mais de 5 anos	38	3,00	2,08 a 3,67

6. Correlações

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")]

A correlação de Spearman (adequada para escores ordinais) mostra os quatro blocos associados à intenção de sair, todos no sentido esperado (p = 0,002 ou menor). Os próprios blocos também se correlacionam entre si, o que importa para o próximo passo.

Tabela 7: Correlações de Spearman entre os escores (N varia de 210 a 212 conforme os brancos)

Bloco	Lid.	Rec.	Rem.	Equ.	Int.
Liderança
Reconhecimento	0,48
Remuneração percebida	0,13	0,27
Equilíbrio trabalho e vida	0,34	0,35	0,14
Intenção de rotatividade	-0,49	-0,51	-0,31	-0,22

7. Regressão múltipla

A correlação olha um fator por vez. Para testar as hipóteses, a pergunta é outra: quanto cada fator pesa quando os outros estão no mesmo modelo? Usei regressão linear múltipla com os quatro escores padronizados (para que os efeitos fiquem comparáveis) e três controles: turno noturno, até 1 ano de casa e 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 ler os coeficientes, chequei os pressupostos:

• Multicolinearidade: maior VIF de 1,47, longe do limite usual de 5. Os blocos se correlacionam, mas não a ponto de se confundirem.
• Variância dos resíduos: teste de Breusch-Pagan com p = 0,713. Sem sinal forte de variância não constante; mesmo assim os testes usam erros-padrão robustos (HC3), que custam pouco e protegem o resultado.
• Normalidade dos resíduos: Shapiro-Wilk com p = 0,049. Com mais de 200 casos, um desvio leve não compromete os testes dos coeficientes.
• Casos influentes: maior distância de Cook de 0,04, bem abaixo de 1. Nenhuma resposta sozinha muda o resultado.

O modelo explica 43% da variação da intenção de sair (R² ajustado = 0,41, N = 210).

A H3 diz que o efeito da remuneração é menor que os de liderança e reconhecimento. Olhar os β não basta: é preciso testar se a diferença entre eles é real. O teste de igualdade de coeficientes (com a mesma correção HC3) não confirmou a diferença: F(1, 202) = 3,02, p = 0,084 contra liderança e F(1, 202) = 1,92, p = 0,167 contra reconhecimento.

O que os dados mostraram

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: Distribuição das respostas aos 20 itens, como foram dadas (LID3 ainda não recodificado)

• Remuneração é o ponto mais mal avaliado. O REM4 destoa dos outros três itens do bloco, o mesmo padrão que a confiabilidade e a fatorial apontaram.
• O item invertido funciona: LID3 tem o padrão oposto ao dos outros itens de liderança, como deveria.

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: Intenção de rotatividade por turno e por tempo de casa

• A noite e o primeiro ano pesam. Quem trabalha à noite e quem tem até 1 ano de casa pensa mais em sair, e os dois efeitos continuam no modelo de regressão, mesmo com os outros fatores 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: Efeito de cada fator na intenção de sair, com os demais fatores fixos (β e intervalo de confiança de 95% com erros robustos)

• Liderança e reconhecimento são os dois fatores mais fortes (β = -0,31 e -0,30). Remuneração também reduz a intenção (β = -0,16). A estimativa é menor, mas o teste não confirmou a diferença: com esta amostra, não dá para afirmar que remuneração pesa menos.
• Equilíbrio entre trabalho e vida é o resultado que mais ensina. Na correlação simples ele aparece associado à intenção de sair (ρ = -0,22), mas no modelo o efeito vai a zero (β = 0,04, p = 0,468). Equilíbrio anda junto com liderança e reconhecimento: onde o supervisor é bom, as folgas costumam ser planejadas. Sozinho, ele “pega emprestado” o efeito dos outros.

Tabela 8: Teste das hipóteses (regressão múltipla, erros-padrão robustos HC3)

Hipótese	β	IC 95%	p	Resultado
H1. Liderança reduz a intenção	-0,31	[-0,45; -0,18]	< 0,001	Suportada
H2. Reconhecimento reduz a intenção	-0,30	[-0,44; -0,16]	< 0,001	Suportada
H3. Remuneração reduz, com efeito menor	-0,16	[-0,27; -0,05]	0,004	Parcialmente suportada
H4. Equilíbrio reduz a intenção	0,04	[-0,07; 0,15]	0,468	Não suportada

Como isso entra no TCC

O aluno recebe as tabelas no formato da APA, que a maioria dos cursos aceita, e um exemplo de como relatar os números. A tabela abaixo é a que vai para o capítulo de resultados:

Tabela 9: Regressão linear múltipla da intenção de rotatividade

Preditor	β	EP	IC 95%	p
Liderança	-0,31	0,07	[-0,45; -0,18]	< 0,001
Reconhecimento	-0,30	0,07	[-0,44; -0,16]	< 0,001
Remuneração percebida	-0,16	0,06	[-0,27; -0,05]	0,004
Equilíbrio trabalho e vida	0,04	0,06	[-0,07; 0,15]	0,468
Turno noturno	0,45	0,12	[0,22; 0,68]	< 0,001
Até 1 ano de casa	0,40	0,12	[0,16; 0,64]	0,001
Sexo feminino	0,12	0,11	[-0,10; 0,33]	0,280

Nota. N = 210. Escores e variável dependente padronizados; turno noturno, até 1 ano de casa e sexo feminino codificados como 0 ou 1. EP: erro-padrão robusto (HC3). R² = 0,43; R² ajustado = 0,41; F(7, 202) = 21,9, p < 0,001.

Exemplo de relato. Este parágrafo mostra quais números entram e em que ordem. A redação do TCC, a discussão dos resultados e as conclusões são do aluno.

Para testar as hipóteses, estimou-se uma regressão linear múltipla com erros-padrão robustos (HC3), tendo a intenção de rotatividade como variável dependente. O modelo explicou 43% da variância (R² ajustado = 0,41). A percepção de liderança (β = -0,31, p < 0,001) e o reconhecimento (β = -0,30, p < 0,001) associaram-se negativamente à intenção, sustentando H1 e H2. A remuneração percebida também apresentou associação negativa (β = -0,16, p = 0,004). Embora a estimativa seja menor que as de liderança e reconhecimento, testes de igualdade de coeficientes não indicaram diferença significativa (F(1, 202) = 3,02, p = 0,084 e F(1, 202) = 1,92, p = 0,167, respectivamente); assim, H3 foi parcialmente suportada. O equilíbrio entre trabalho e vida não apresentou associação após o controle das demais variáveis (β = 0,04, p = 0,468); H4 não foi suportada.

O que o aluno recebe

• O relatório completo em Quarto, com o código e as saídas de cada passo. Se a base mudar (por exemplo, respostas que chegam depois), basta rodar de novo.
• O script R comentado e a base limpa, para o aluno e o orientador conferirem.
• As tabelas no formato da APA, prontas para colar no Word.
• Uma explicação em linguagem simples de cada teste: por que foi escolhido, o que o resultado quer dizer e quais são os limites. Serve para escrever o método e para a defesa.
• Uma reunião para repassar os resultados e as perguntas que a banca costuma fazer sobre a parte estatística.

O trabalho é do aluno. Eu faço a análise e explico; a redação, a interpretação e as conclusões são dele.

Tem um questionário para analisar?

Pode ser TCC, dissertação ou pesquisa interna da empresa. Me mande o projeto e a planilha das respostas, e eu digo o que dá para fazer e como.

Fale comigo