---
title: "Relatório Técnico-Estatístico: 3ª Etapa — Validação Clínica"
subtitle: "Modelagem da Estrutura Latente dos Fatores de Risco via TRI (Modelo 2PL) e Análise de Classes Latentes (LCA)"
date: today
lang: pt-BR
format:
html:
theme: cosmo
toc: true
toc-depth: 3
toc-title: "Sumário Executivo"
number-sections: true
code-fold: show
code-tools: true
df-print: paged
execute:
echo: true
warning: false
message: false
---
## Introdução e Escopo Metodológico
Este documento apresenta os resultados da validação clínica baseada na estrutura latente do bloco **III — Fatores de Risco** ($n = 215$ participantes; 24 itens avaliados do número 19 ao 41), na ausência de um padrão-ouro externo. O protocolo analítico estrutura-se em três etapas:
1. **Consistência Interna e Polaridade Semântica:** Avaliação pelo coeficiente **KR-20 (Kuder-Richardson)** e **Ômega de McDonald ($\omega$)** sobre matriz tetracórica, corrigindo a direção dos itens protetores.
2. **Teoria de Resposta ao Item (TRI — Modelo Logístico de 2 Parâmetros [2PL]):** Estimação do poder discriminativo ($a_j$) e do limiar de gravidade/dificuldade ($b_j$) de cada fator ao longo do traço latente contínuo de vulnerabilidade ocupacional ($\theta$).
3. **Análise de Classes Latentes (LCA) e Acurácia Diagnóstica:** Identificação de agrupamentos diagnósticos naturais ($K = 2$ e $K = 3$ classes) via algoritmo *Expectation-Maximization* (EM) para extrair **Sensibilidade ($Se$)**, **Especificidade ($Es$)**, **Valor Preditivo Positivo ($VPP$)**, **Valor Preditivo Negativo ($VPN$)** e **Índice $J$ de Youden**, seguida de comparação inferencial entre classes via `gtsummary`.
```{r}
#| label: setup-ambiente
# Instalação automática de pacotes ausentes
pacotes <- c("readxl", "dplyr", "tidyr", "stringr", "ggplot2", "purrr",
"psych", "mirt", "poLCA", "flextable", "gtsummary")
novos_pacotes <- pacotes[!(pacotes %in% installed.packages()[, "Package"])]
if (length(novos_pacotes) > 0) install.packages(novos_pacotes)
library(readxl)
library(dplyr)
library(tidyr)
library(stringr)
library(ggplot2)
library(purrr)
library(psych)
library(mirt)
library(poLCA)
library(flextable)
library(gtsummary)
# Configuração global de idioma e formatação decimal (vírgula) no gtsummary
theme_gtsummary_language(language = "pt", decimal.mark = ",", big.mark = ".")
theme_gtsummary_compact()
# Configuração global do flextable para renderização em HTML
set_flextable_defaults(
font.family = "Arial",
font.size = 10,
theme_fun = theme_booktabs,
padding.top = 5,
padding.bottom = 5,
padding.left = 6,
padding.right = 6,
decimal.mark = ",",
big.mark = ".",
na_str = "—"
)
# Função auxiliar para formatar tabelas flextable em HTML
formatar_ft_html <- function(ft, titulo = NULL, nota_rodape = NULL) {
ft <- ft %>%
theme_booktabs() %>%
bold(part = "header") %>%
valign(valign = "center", part = "all") %>%
autofit()
if (!is.null(titulo)) {
ft <- set_caption(ft, caption = titulo)
}
if (!is.null(nota_rodape)) {
ft <- add_footer_lines(ft, values = nota_rodape) %>%
fontsize(size = 9, part = "footer") %>%
italic(part = "footer")
}
return(ft)
}
theme_set(theme_minimal(base_size = 12))
```
---
## Auditoria de Dados e Tratamento de Polaridade
```{r}
#| label: limpeza-e-tab1
# 1. Leitura da planilha (cabeçalho na linha 2) e remoção de espaços extras nos nomes das colunas
df_bruto <- read_excel("COLETA_DADOS_ETAPA_3.xlsx", sheet = "III-FATORES RISCO", skip = 1) %>%
rename_with(str_trim)
# 2. Tabela 1: Auditoria de pulo lógico (Itens 21 e 21.1) via gtsummary -> flextable
df_pulo <- df_bruto %>%
transmute(
turno_noturno = factor(str_trim(`21. TRABALHA TURNO NOTURNO`), levels = c("SIM", "NÃO")),
afeta_descanso = factor(str_trim(`21.1 AFETA DESCANSO`), levels = c("SIM", "NÃO", "NÃO SE APLICA"))
)
tbl_pulo <- df_pulo %>%
tbl_cross(
row = turno_noturno,
col = afeta_descanso,
percent = "row",
label = list(
turno_noturno ~ "21. Trabalha em turno noturno",
afeta_descanso ~ "21.1. O turno noturno afeta o descanso?"
),
margin_text = "Total"
) %>%
bold_labels() %>%
as_flex_table() %>%
formatar_ft_html(
titulo = "Tabela 1. Auditoria de consistência e pulo lógico entre o trabalho em turno noturno (item 21) e o prejuízo no descanso (item 21.1) (n = 215).",
nota_rodape = "Nota: Valores expressos em frequência absoluta (n) e percentual na linha (%). Observam-se 3 casos com resposta preenchida no item 21.1 entre não trabalhadores noturnos."
)
tbl_pulo
# 3. Codificação binária (SIM = 1, NÃO = 0) nos 23 itens independentes
df_bin <- df_bruto %>%
select(-ORDEM, -`21.1 AFETA DESCANSO`) %>%
mutate(across(everything(), ~ ifelse(str_trim(.) == "SIM", 1, 0)))
# 4. Inversão dos 4 itens de formulação protetora (1 = Presença de Fator de Risco)
itens_protetores <- c(
"22. FUXO TRABALHO",
"29.AUTONOMIA PROFISSIONAL",
"32.APOIO CHEFIA",
"33.APOIO DOS COLEGAS"
)
df_risco <- df_bin %>%
mutate(across(all_of(itens_protetores), ~ 1 - .))
# Dicionário de rótulos padronizados
rotulos_itens <- c(
"19. SENTE DIFICULDADE TOMAR DECISÕES" = "19. Dificuldade em tomar decisões",
"20.PRESSÕES EMOCIONAIS" = "20. Pressões emocionais",
"21. TRABALHA TURNO NOTURNO" = "21. Trabalha em turno noturno",
"22. FUXO TRABALHO" = "22. Fluxo de trabalho inadequado*",
"23. DESORGANIZAÇÃO ROTINA AMBIENTE TRABALHO" = "23. Desorganização da rotina",
"24.TRATAMENTO DIFERENTE GÊNERO" = "24. Tratamento diferente por gênero",
"25.QUANTIDADE TAREFAS" = "25. Excesso de tarefas",
"26.TEMPO ATUAÇÃO < 5 ANOS" = "26. Tempo de atuação < 5 anos",
"27.FALTA DE CLAREZA" = "27. Falta de clareza nas atribuições",
"28.VIOLÊNCIA FÍSICA OU VERBAL" = "28. Violência física ou verbal",
"29.AUTONOMIA PROFISSIONAL" = "29. Falta de autonomia profissional*",
"30.DESENTENDIMENTOS COLEGAS" = "30. Desentendimentos com colegas",
"31.PRESSÃO NO TRABALHO" = "31. Pressão no trabalho",
"32.APOIO CHEFIA" = "32. Falta de apoio da chefia*",
"33.APOIO DOS COLEGAS" = "33. Falta de apoio dos colegas*",
"34.FALTA CAPACITAÇÃO" = "34. Falta de capacitação",
"35.AMBIENTE INSALUBRE" = "35. Ambiente insalubre",
"36.PACIENTES ESTADO CRÍTICO" = "36. Assistência a pacientes críticos",
"37.FALTA DE MATERIAIS" = "37. Falta de materiais",
"38.FALTA RECURSOS HUMANOS" = "38. Falta de recursos humanos",
"39.SISTEMAS DIGITAIS" = "39. Dificuldades com sistemas digitais",
"40.INJUSTIÇA NO TRABALHO" = "40. Injustiça no trabalho",
"41.FALHAS COMUNICAÇÃO" = "41. Falhas na comunicação"
)
```
### Interpretação da Qualidade dos Dados
* **Pulo Lógico Condicional (Itens 21 e 21.1):** Dos $93$ participantes que trabalham em turno noturno ($43,26\%$), **$70,97\%$ ($n = 66$)** relataram prejuízo no descanso. Como o item 21.1 é estruturalmente dependente do item 21, sua inclusão simultânea nos modelos de TRI e LCA violaria o pressuposto de **independência condicional local** (gerando um *doublet* artificial). Por isso, os modelos multivariados são estimados sobre os **23 fatores independentes**, reportando-se o item 21.1 como indicador condicional específico do subgrupo noturno.
* **Efeito Teto (*Ceiling Effect*):** Os fatores **38. Falta de recursos humanos** ($95,35\%$, $\text{DP} = 0,2111$) e **41. Falhas na comunicação** ($93,49\%$, $\text{DP} = 0,2473$) são quase onipresentes na amostra, configurando estressores estruturais basais do ambiente avaliado.
---
## Estatísticas Descritivas e Consistência Interna (KR-20)
```{r}
#| label: tab2-consistencia
escore_bruto <- rowSums(df_bin)
escore_risco <- rowSums(df_risco)
k <- ncol(df_risco)
kr20_bruto <- (k / (k - 1)) * (1 - sum(apply(df_bin, 2, var)) / var(escore_bruto))
kr20_risco <- (k / (k - 1)) * (1 - sum(apply(df_risco, 2, var)) / var(escore_risco))
resumo_escores <- tibble(
Configuracao = c("Matriz Original (Sem Inversão)", "Matriz Corrigida (Itens 22, 29, 32 e 33 Invertidos)"),
N = c(nrow(df_bin), nrow(df_risco)),
KR_20 = c(kr20_bruto, kr20_risco),
Media_DP = c(sprintf("%.2f (%.2f)", mean(escore_bruto), sd(escore_bruto)),
sprintf("%.2f (%.2f)", mean(escore_risco), sd(escore_risco))),
Mediana_IIQ = c(sprintf("%.1f (%.1f)", median(escore_bruto), IQR(escore_bruto)),
sprintf("%.1f (%.1f)", median(escore_risco), IQR(escore_risco))),
Min_Max = c(sprintf("%d – %d", min(escore_bruto), max(escore_bruto)),
sprintf("%d – %d", min(escore_risco), max(escore_risco)))
) %>%
mutate(across(c(Media_DP, Mediana_IIQ), ~ str_replace_all(., "\\.", ",")))
ft_tab2 <- flextable(resumo_escores) %>%
set_header_labels(
Configuracao = "Parametrização da Escala",
N = "n",
KR_20 = "KR-20",
Media_DP = "Média (DP)",
Mediana_IIQ = "Mediana (IIQ)",
Min_Max = "Mín – Máx"
) %>%
colformat_double(j = "KR_20", digits = 4, decimal.mark = ",") %>%
align(j = 2:6, align = "center", part = "all") %>%
formatar_ft_html(
titulo = "Tabela 2. Comparação da consistência interna (Kuder-Richardson KR-20) e distribuição do escore total antes e após a inversão dos itens protetores (n = 215).",
nota_rodape = "Legenda: KR-20 = Coeficiente de Kuder-Richardson de 20 itens; DP = Desvio-Padrão; IIQ = Intervalo Interquartil."
)
ft_tab2
```
```{r}
#| label: tab3-descritiva-itens
tab_desc_itens <- tibble(
Variavel = names(df_risco),
Item = unname(rotulos_itens[names(df_risco)]),
n_Risco = colSums(df_risco),
Prev_Pct = colMeans(df_risco) * 100,
Media = colMeans(df_risco),
DP = apply(df_risco, 2, sd),
Mediana = apply(df_risco, 2, median),
Min_Max = "0 – 1",
r_item_resto = map_dbl(names(df_risco), ~ cor(df_risco[[.x]], rowSums(df_risco[, setdiff(names(df_risco), .x)])))
) %>%
arrange(desc(Prev_Pct)) %>%
select(-Variavel)
ft_tab3 <- flextable(tab_desc_itens) %>%
set_header_labels(
Item = "Fator de Risco Avaliado",
n_Risco = "n",
Prev_Pct = "Prevalência (%)",
Media = "Média",
DP = "DP",
Mediana = "Mediana",
Min_Max = "Mín–Máx",
r_item_resto = "r item-resto"
) %>%
colformat_double(j = "Prev_Pct", digits = 2, decimal.mark = ",") %>%
colformat_double(j = c("Media", "DP"), digits = 4, decimal.mark = ",") %>%
colformat_double(j = "Mediana", digits = 1, decimal.mark = ",") %>%
colformat_double(j = "r_item_resto", digits = 3, decimal.mark = ",") %>%
align(j = 2:8, align = "center", part = "all") %>%
formatar_ft_html(
titulo = "Tabela 3. Estatísticas descritivas e correlações item-total corrigidas (r item-resto) dos 23 fatores de risco (n = 215).",
nota_rodape = "*Nota: Itens 22, 29, 32 e 33 codificados de forma invertida (NÃO = 1 [presença do fator de risco por ausência do fator protetor]). DP = Desvio-Padrão."
)
ft_tab3
```
### Interpretação da Consistência Interna
* Na codificação original, os itens **22. Fluxo de trabalho** ($r_{it} = -0,369$), **32. Apoio da chefia** ($r_{it} = -0,338$), **29. Autonomia profissional** ($r_{it} = -0,295$) e **33. Apoio dos colegas** ($r_{it} = -0,133$) apresentavam correlações negativas com o escore total porque medem condições protetoras.
* Após a inversão semântica desses quatro itens, o coeficiente **KR-20 eleva-se de 0,5192 para 0,7555**, superando o ponto de corte psicométrico de $0,70$ e demonstrando consistência interna satisfatória (Escore de Risco Corrigido: $\text{Média} = 12,48 \pm 3,92$; $\text{Mediana} = 13,0$; $\text{IIQ} = 5,0$; $\text{Mín} = 2$; $\text{Máx} = 21$).
---
## Calibração Psicométrica via Teoria de Resposta ao Item (TRI — 2PL)
```{r}
#| label: tab4-tri
mod_2pl <- mirt(df_risco, model = 1, itemtype = "2PL", SE = TRUE, verbose = FALSE)
params_tri <- as.data.frame(coef(mod_2pl, IRTpars = TRUE, simplify = TRUE)$items) %>%
mutate(
Variavel = rownames(.),
Item = unname(rotulos_itens[Variavel]),
Prev_Risco = colMeans(df_risco) * 100,
Classificacao_a = case_when(
a >= 1.35 ~ "Muito Alta (a ≥ 1,35)",
a >= 1.00 ~ "Alta (1,00 ≤ a < 1,35)",
a >= 0.65 ~ "Moderada (0,65 ≤ a < 1,00)",
TRUE ~ "Baixa (a < 0,65)"
)
) %>%
select(Item, Prev_Risco, a, b, Classificacao_a) %>%
arrange(desc(a))
ft_tab4 <- flextable(params_tri) %>%
set_header_labels(
Item = "Fator de Risco",
Prev_Risco = "Prevalência (%)",
a = "Discriminação (a)",
b = "Gravidade / Limiar (b)",
Classificacao_a = "Classificação Discriminativa (Baker)"
) %>%
colformat_double(j = "Prev_Risco", digits = 2, decimal.mark = ",") %>%
colformat_double(j = c("a", "b"), digits = 3, decimal.mark = ",") %>%
align(j = 2:5, align = "center", part = "all") %>%
bold(i = ~ a >= 1.00, j = c("Item", "a")) %>%
formatar_ft_html(
titulo = "Tabela 4. Parâmetros de discriminação (a) e gravidade/limiar clínico (b) estimados via Modelo Logístico de 2 Parâmetros (2PL) da TRI (n = 215).",
nota_rodape = "Nota: Calibração por Máxima Verossimilhança Marginal (MML). Classificação de Baker (2001): Muito alta (a >= 1,35); Alta (1,00 a 1,34); Moderada (0,65 a 0,99); Baixa (< 0,65). Itens em negrito possuem alta capacidade de discriminação (a >= 1,00)."
)
ft_tab4
# Extração do escore latente individual (Theta EAP)
escores_eap <- as.numeric(fscores(mod_2pl, method = "EAP"))
```
```{r}
#| label: fig1-mapa-tri
#| fig-width: 9
#| fig-height: 6
ggplot(params_tri, aes(x = b, y = a, color = Classificacao_a)) +
geom_hline(yintercept = 1.00, linetype = "dashed", color = "#1b9e77", alpha = 0.8) +
geom_hline(yintercept = 0.65, linetype = "dotted", color = "#d95f02", alpha = 0.8) +
geom_vline(xintercept = 0.00, linetype = "solid", color = "gray70") +
geom_point(size = 3.5, alpha = 0.9) +
geom_text(aes(label = Item), hjust = -0.05, vjust = 0.4, size = 3, show.legend = FALSE, check_overlap = TRUE) +
scale_x_continuous(limits = c(-3.8, 4.8)) +
scale_color_brewer(palette = "Dark2") +
labs(
title = "Figura 1. Mapa de Calibração da TRI (Modelo Logístico 2PL)",
subtitle = "Limiar de Gravidade Clínica (b) versus Capacidade de Discriminação (a)",
x = "Parâmetro de Gravidade / Dificuldade (b) em desvios-padrão do traço latente (θ)",
y = "Parâmetro de Discriminação (a)",
color = "Nível de Discriminação"
) +
theme(legend.position = "bottom")
```
### Interpretação Clínica da TRI
1. **Capacidade Discriminativa ($a_j$):** Doze dos 23 itens apresentaram discriminação alta ou muito alta ($a \ge 1,00$), liderados por **20. Pressões emocionais** ($a = 1,922$), **32. Falta de apoio da chefia** ($a = 1,455$), **40. Injustiça no trabalho** ($a = 1,445$), **22. Fluxo de trabalho inadequado** ($a = 1,390$), **24. Tratamento diferente por gênero** ($a = 1,343$), **38. Falta de RH** ($a = 1,337$) e **31. Pressão no trabalho** ($a = 1,311$).
2. **Espectro de Gravidade Clínica ($b_j$):**
* **Estressores Estruturais Basais ($b < -2,0$):** *41. Falhas na comunicação* ($b = -3,412$), *38. Falta de RH* ($b = -2,820$), *35. Ambiente insalubre* ($b = -2,284$) e *37. Falta de materiais* ($b = -2,147$) ocorrem mesmo em níveis muito baixos de vulnerabilidade latente.
* **Estressores Intermediários / Progressivos ($-1,3 < b < +0,3$):** *20. Pressões emocionais* ($b = -1,296$), *28. Violência* ($b = -0,988$), *40. Injustiça* ($b = -0,986$), *27. Falta de clareza* ($b = -0,867$), *25. Excesso de tarefas* ($b = -0,681$), *23. Desorganização da rotina* ($b = -0,096$) e *31. Pressão no trabalho* ($b = +0,200$) demarcam a transição clínica para o adoecimento/sobrecarga.
* **Marcadores de Descompensação Grave ($b > +1,0$):** *29. Falta de autonomia* ($b = +1,031$), *32. Falta de apoio da chefia* ($b = +1,121$), *24. Tratamento diferente por gênero* ($b = +1,199$), *22. Fluxo de trabalho inadequado* ($b = +1,276$), *19. Dificuldade em tomar decisões* ($b = +1,884$) e *33. Falta de apoio dos colegas* ($b = +3,809$) exigem níveis severos do traço latente ($\theta > +1,0\text{ DP}$) para se manifestarem.
---
## Análise de Classes Latentes (LCA) e Acurácia Diagnóstica
```{r}
#| label: tab5-ajuste-lca
df_lca <- df_risco %>%
mutate(across(everything(), ~ as.integer(. + 1))) %>%
rename_with(~ paste0("I", seq_along(.)))
formula_lca <- as.formula(paste("cbind(", paste(names(df_lca), collapse = ", "), ") ~ 1"))
ajustar_lca <- function(k, seed = 2026) {
set.seed(seed)
mod <- poLCA(formula_lca, data = df_lca, nclass = k, nrep = 40, maxiter = 3000, verbose = FALSE)
n <- nrow(df_lca)
p <- mod$npar
ll <- mod$llik
sabic <- -2 * ll + log((n + 2) / 24) * p
if (k > 1) {
post <- pmax(mod$posterior, 1e-10)
entropia <- 1 - (-sum(post * log(post))) / (n * log(k))
} else {
entropia <- 1.000
}
ordem <- if (k > 1) order(rowMeans(sapply(mod$probs, function(m) m[, 2]))) else 1
props_txt <- paste(sprintf("%.1f%%", mod$P[ordem] * 100), collapse = " | ") %>%
str_replace_all("\\.", ",")
list(modelo = mod, ordem = ordem, resumo = tibble(
Classes_K = paste0(k, " Classe(s)"),
LogLik = ll,
Parametros = p,
AIC = mod$aic,
BIC = mod$bic,
SABIC = sabic,
Entropia = entropia,
Proporcoes = props_txt
))
}
res_k1 <- ajustar_lca(1)
res_k2 <- ajustar_lca(2)
res_k3 <- ajustar_lca(3)
res_k4 <- ajustar_lca(4)
tab_ajuste_lca <- bind_rows(res_k1$resumo, res_k2$resumo, res_k3$resumo, res_k4$resumo)
ft_tab5 <- flextable(tab_ajuste_lca) %>%
set_header_labels(
Classes_K = "Modelo (K)",
LogLik = "Log-Verossimilhança",
Parametros = "Parâmetros",
AIC = "AIC",
BIC = "BIC",
SABIC = "SABIC",
Entropia = "Entropia (E)",
Proporcoes = "Distribuição das Classes (%)"
) %>%
colformat_double(j = c("LogLik", "AIC", "BIC", "SABIC"), digits = 2, decimal.mark = ",") %>%
colformat_double(j = "Entropia", digits = 4, decimal.mark = ",") %>%
align(j = 2:8, align = "center", part = "all") %>%
bold(i = c(2, 3)) %>%
formatar_ft_html(
titulo = "Tabela 5. Critérios de informação e qualidade de classificação (Entropia) para seleção do número ótimo de classes latentes (n = 215).",
nota_rodape = "Legenda: AIC = Critério de Informação de Akaike; BIC = Critério de Informação Bayesiano; SABIC = BIC ajustado pelo tamanho amostral. Modelos de 2 classes (menor BIC) e 3 classes (menor SABIC e Entropia > 0,80) destacados em negrito."
)
ft_tab5
```
```{r}
#| label: tab6-acuracia-k2
mod_k2 <- res_k2$modelo
prob_k2 <- sapply(mod_k2$probs, function(mat) mat[, 2])
ordem_k2 <- res_k2$ordem # [1] = Baixo Risco, [2] = Alto Risco
pi_baixo <- mod_k2$P[ordem_k2[1]]
pi_alto <- mod_k2$P[ordem_k2[2]]
se_vec <- prob_k2[ordem_k2[2], ]
es_vec <- 1 - prob_k2[ordem_k2[1], ]
vpp_vec <- (se_vec * pi_alto) / (se_vec * pi_alto + (1 - es_vec) * pi_baixo)
vpn_vec <- (es_vec * pi_baixo) / (es_vec * pi_baixo + (1 - se_vec) * pi_alto)
youden <- se_vec + es_vec - 1
n_alto <- nrow(df_risco) * pi_alto
n_baixo <- nrow(df_risco) * pi_baixo
se_ic_inf <- pmax(0, se_vec - 1.96 * sqrt(se_vec * (1 - se_vec) / n_alto))
se_ic_sup <- pmin(1, se_vec + 1.96 * sqrt(se_vec * (1 - se_vec) / n_alto))
es_ic_inf <- pmax(0, es_vec - 1.96 * sqrt(es_vec * (1 - es_vec) / n_baixo))
es_ic_sup <- pmin(1, es_vec + 1.96 * sqrt(es_vec * (1 - es_vec) / n_baixo))
tab_acuracia <- tibble(
Item = unname(rotulos_itens[names(df_risco)]),
Se_Txt = str_replace_all(sprintf("%.2f (%.1f–%.1f)", se_vec * 100, se_ic_inf * 100, se_ic_sup * 100), "\\.", ","),
Es_Txt = str_replace_all(sprintf("%.2f (%.1f–%.1f)", es_vec * 100, es_ic_inf * 100, es_ic_sup * 100), "\\.", ","),
VPP_Pct = vpp_vec * 100,
VPN_Pct = vpn_vec * 100,
J_Youden = youden
) %>%
arrange(desc(J_Youden))
ft_tab6 <- flextable(tab_acuracia) %>%
set_header_labels(
Item = "Fator de Risco Clínico",
Se_Txt = "Sensibilidade % (IC 95%)",
Es_Txt = "Especificidade % (IC 95%)",
VPP_Pct = "VPP (%)",
VPN_Pct = "VPN (%)",
J_Youden = "Índice J de Youden"
) %>%
colformat_double(j = c("VPP_Pct", "VPN_Pct"), digits = 2, decimal.mark = ",") %>%
colformat_double(j = "J_Youden", digits = 3, decimal.mark = ",") %>%
align(j = 2:6, align = "center", part = "all") %>%
bold(i = ~ J_Youden >= 0.300, j = c("Item", "J_Youden")) %>%
formatar_ft_html(
titulo = "Tabela 6. Medidas de acurácia diagnóstica clínica dos 23 fatores de risco estimadas via Análise de Classes Latentes (K = 2 classes; n = 215).",
nota_rodape = "Legenda: IC 95% = Intervalo de Confiança de 95%; VPP = Valor Preditivo Positivo; VPN = Valor Preditivo Negativo; Índice J de Youden = Se + Es - 1. Prevalência da classe latente de Alto Risco Clínico = 56,3%."
)
ft_tab6
```
---
## Comparação Inferencial entre os Estratos Clínicos Latentes via `gtsummary`
```{r}
#| label: tab7-gtsummary-classes
mod_k3 <- res_k3$modelo
ordem_k3 <- res_k3$ordem
mapa_k3 <- match(mod_k3$predclass, ordem_k3)
classe_k3_fator <- factor(
mapa_k3,
levels = 1:3,
labels = c("Classe 1: Baixo Risco", "Classe 2: Risco Moderado", "Classe 3: Alto Risco (Grave)")
)
df_gts <- df_risco %>%
rename_with(~ unname(rotulos_itens[.])) %>%
mutate(
`Escore Total de Fatores de Risco (0–23)` = escore_risco,
`Traço Latente θ (Escore EAP - TRI)` = escores_eap,
Classe_Latente = classe_k3_fator
)
tbl_comparativa <- df_gts %>%
tbl_summary(
by = Classe_Latente,
type = list(
all_dichotomous() ~ "dichotomous",
c(`Escore Total de Fatores de Risco (0–23)`, `Traço Latente θ (Escore EAP - TRI)`) ~ "continuous2"
),
statistic = list(
all_dichotomous() ~ "{n} ({p}%)",
all_continuous2() ~ c("{mean} ({sd})", "{median} ({p25}–{p75})", "{min} – {max}")
),
digits = list(
all_dichotomous() ~ c(0, 1),
all_continuous2() ~ 2
)
) %>%
add_overall(last = FALSE, col_label = "**Total (n = 215)**") %>%
add_p(
test = list(
all_continuous() ~ "kruskal.test",
c("38. Falta de recursos humanos", "41. Falhas na comunicação") ~ "fisher.test"
),
pvalue_fun = ~ style_pvalue(.x, digits = 3)
) %>%
bold_labels() %>%
bold_p(t = 0.05) %>%
modify_header(label = "**Variável / Fator de Risco**") %>%
as_flex_table() %>%
formatar_ft_html(
titulo = "Tabela 7. Distribuição comparativa dos fatores de risco, escore soma total e traço latente (θ) segundo a estratificação da Análise de Classes Latentes (K = 3 classes; n = 215).",
nota_rodape = "Nota: Variáveis categóricas expressas em n (%) e comparadas pelo teste Qui-Quadrado de Pearson ou Teste Exato de Fisher (itens 38 e 41). Variáveis contínuas expressas em Média (DP), Mediana (IIQ) e Mín–Máx, comparadas pelo teste de Kruskal-Wallis."
)
tbl_comparativa
```
### Síntese Interpretativa para a Seção de Discussão
1. **Hierarquia Diagnóstica (Acurácia Clínica via LCA — Tabela 6):**
* **Indicadores de Equilíbrio Diagnóstico (Maiores Índices $J$ de Youden):** Os fatores **31. Pressão no trabalho** ($J = 0,490$; $Se = 66,54\%$; $Es = 82,49\%$), **25. Excesso de tarefas** ($J = 0,421$; $Se = 84,44\%$; $Es = 57,66\%$), **23. Desorganização da rotina** ($J = 0,412$; $Se = 70,08\%$; $Es = 71,08\%$), **40. Injustiça no trabalho** ($J = 0,388$; $Se = 90,93\%$) e **28. Violência física ou verbal** ($J = 0,354$; $Se = 87,09\%$) apresentam a melhor performance global para discriminar profissionais em alto risco clínico.
* **Indicadores de Triagem (Alta Sensibilidade e Alto VPN):** **38. Falta de RH** ($Se = 98,36\%$), **35. Ambiente insalubre** ($Se = 96,65\%$; $VPN = 85,52\%$), **41. Falhas na comunicação** ($Se = 96,61\%$) e **20. Pressões emocionais** ($Se = 96,30\%$; $VPN = 87,57\%$). A ausência de pressões emocionais possui elevado poder de exclusão diagnóstica ($VPN = 87,57\%$).
* **Indicadores Confirmatórios de Gravidade (Alta Especificidade e Alto VPP):** A perda dos fatores protetores — **22. Fluxo de trabalho inadequado** ($Es = 95,61\%$; $VPP = 90,83\%$), **32. Falta de apoio da chefia** ($Es = 95,00\%$; $VPP = 90,60\%$), **33. Falta de apoio dos colegas** ($Es = 92,49\%$) e **29. Falta de autonomia profissional** ($Es = 89,59\%$; $VPP = 83,43\%$) — ao lado de **24. Tratamento diferente por gênero** ($Es = 92,25\%$; $VPP = 85,13\%$), atuam como marcadores altamente específicos de descompensação clínica.
2. **Validação Discriminante entre os 3 Estratos Clínicos (Tabela 7):**
* O teste de Kruskal-Wallis confirma diferença altamente significativa ($p < 0,001$) tanto no **Escore Total de Fatores de Risco** quanto no **Traço Latente $\theta$ (TRI)** entre as três classes:
* **Classe 1 — Baixo Risco ($n = 32$):** Média de $6,41 \pm 1,95$ fatores (Mediana $= 7,0$; $\text{IIQ} = 2,25$; $\text{Mín–Máx} = 2\text{–}10$) e $\theta = -1,41 \pm 0,41$.
* **Classe 2 — Risco Moderado ($n = 127$):** Média de $11,96 \pm 2,04$ fatores (Mediana $= 12,0$; $\text{IIQ} = 3,00$; $\text{Mín–Máx} = 7\text{–}16$) e $\theta = -0,12 \pm 0,42$.
* **Classe 3 — Alto Risco / Grave ($n = 56$):** Média de $17,13 \pm 2,00$ fatores (Mediana $= 17,0$; $\text{IIQ} = 3,00$; $\text{Mín–Máx} = 14\text{–}21$) e $\theta = +1,07 \pm 0,47$.
