1. Preparação e Organização dos Dados

Nesta etapa, realizamos a limpeza do banco de dados, garantindo que apenas os itens da escala sejam analisados e que a polaridade dos itens invertidos seja corrigida para manter a consistência teórica.

# 1. Selecionar apenas os itens (Coluna 2 até 21)
df_avareza <- resultado_avareza[, 2:21]

# 2. Garantir que todos os dados sejam numéricos
df_avareza[] <- lapply(df_avareza, as.numeric)

# 3. Inversão dos itens 11, 16 e 18 (Escala Likert 1-5)
itens_inv <- c("item11", "item16", "item18")
df_avareza[itens_inv] <- 6 - df_avareza[itens_inv]

2. Análise Descritiva

Calculamos as estatísticas descritivas básicas para identificar o comportamento da amostra e verificar possíveis efeitos de teto ou chão.

# Tabela de Estatísticas Descritivas
estatisticas <- describe(df_avareza)
print(estatisticas[, c("mean", "median", "sd", "skew", "kurtosis")])
##        mean median   sd  skew kurtosis
## item1  2.78    3.0 1.15  0.08    -0.96
## item2  4.02    4.0 1.06 -1.03     0.27
## item3  2.14    2.0 1.05  0.54    -0.59
## item4  2.69    3.0 1.34  0.15    -1.31
## item5  3.66    4.0 1.27 -0.77    -0.52
## item6  2.58    2.0 1.16  0.26    -0.92
## item7  2.25    2.0 1.21  0.61    -0.78
## item8  2.25    2.0 1.09  0.51    -0.76
## item9  3.02    3.0 1.27 -0.03    -1.11
## item10 1.17    1.0 0.51  4.35    25.39
## item11 2.27    2.0 0.99  0.52    -0.34
## item12 2.73    2.5 1.30  0.28    -1.10
## item13 2.02    2.0 1.18  0.99     0.01
## item14 2.91    3.0 1.17 -0.07    -0.87
## item15 3.11    3.0 1.37 -0.04    -1.33
## item16 2.99    3.0 1.22  0.12    -1.07
## item17 2.59    2.0 1.28  0.32    -1.07
## item18 2.98    3.0 1.27  0.17    -1.10
## item19 2.39    2.0 1.30  0.49    -1.03
## item20 2.11    2.0 1.11  0.65    -0.56
# Identificação de extremos
medias <- colMeans(df_avareza[, 1:20])
cat("A menor média é do", names(which.min(medias)), ":", round(min(medias), 2), "\n")
## A menor média é do item10 : 1.17
cat("A maior média é do", names(which.max(medias)), ":", round(max(medias), 2), "\n")
## A maior média é do item2 : 4.02
# Criar tabela final para exportação
tabela_descritiva_final <- data.frame(
  Item = rownames(estatisticas),
  Media = round(estatisticas$mean, 2),
  Mediana = estatisticas$median,
  Desvio_Padrao = round(estatisticas$sd, 2),
  Assimetria = round(estatisticas$skew, 2),
  Curtose = round(estatisticas$kurtosis, 2)
)

3. Estatísticas Totais e Visualização

Analisamos o escore médio total da escala para compreender a distribuição geral do traço de avareza na amostra.

# Escore Médio Total
df_avareza$escore_total <- rowMeans(df_avareza[, 1:20], na.rm = TRUE)
stats_total <- psych::describe(df_avareza$escore_total)

cat("--- ESTATÍSTICAS TOTAIS DA ESCALA AVARITIA ---\n")
## --- ESTATÍSTICAS TOTAIS DA ESCALA AVARITIA ---
print(round(stats_total[1, c("mean", "sd", "median", "skew", "kurtosis")], 2))
##    mean  sd median skew kurtosis
## X1 2.63 0.6    2.6 0.05    -0.57
# Histograma da Distribuição Total
hist(df_avareza$escore_total, 
     main = "Distribuição dos Escores Totais",
     xlab = "Escore Médio (1-5)", col = "lightblue", border = "white", breaks = 15)
abline(v = mean(df_avareza$escore_total), col = "red", lwd = 2, lty = 2)

# Gráfico de Barras por Item
medias_itens <- colMeans(df_avareza[, 1:20], na.rm = TRUE)
df_plot <- data.frame(Item = names(medias_itens), Media = as.numeric(medias_itens))
df_plot$Item <- factor(df_plot$Item, levels = df_plot$Item[order(df_plot$Media)])

ggplot(df_plot, aes(x = Item, y = Media, fill = Media)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  scale_fill_gradient(low = "lightblue", high = "darkblue") +
  labs(title = "Médias de Resposta por Item", y = "Média (Likert 1-5)") +
  theme_minimal() +
  geom_hline(yintercept = 3, linetype = "dashed", color = "red")

4. Análise Fatorial Exploratória (AFE)

Verificamos a fatorabilidade da matriz e a estrutura interna do instrumento através da extração por Mínimos Quadrados Não Ponderados (ULS).

# Testes de Fatorabilidade
kmo_resultado <- KMO(df_avareza[, 1:20])
bartlett_resultado <- cortest.bartlett(df_avareza[, 1:20])

print(kmo_resultado)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = df_avareza[, 1:20])
## Overall MSA =  0.78
## MSA for each item = 
##  item1  item2  item3  item4  item5  item6  item7  item8  item9 item10 item11 
##   0.73   0.59   0.85   0.85   0.87   0.75   0.88   0.63   0.48   0.68   0.76 
## item12 item13 item14 item15 item16 item17 item18 item19 item20 
##   0.73   0.82   0.80   0.81   0.74   0.87   0.79   0.68   0.67
print(bartlett_resultado)
## $chisq
## [1] 750.141
## 
## $p.value
## [1] 1.45872e-67
## 
## $df
## [1] 190
# 2. ANÁLISE PARALELA
# Calculamos a matriz policórica manualmente primeiro para evitar o erro de integração ao fazer o knit no RMarkdown
matriz_poly <- psych::polychoric(df_avareza[, 1:20])$rho

# Agora rodamos a análise paralela usando a matriz já calculada
# O n.obs é obrigatório aqui para o R saber o tamanho da amostra (122)
fa.parallel(matriz_poly, n.obs = 122, fa = "fa", main = "Análise Paralela (Matriz Policórica)")

## Parallel analysis suggests that the number of factors =  6  and the number of components =  NA
# Execução da AFE (2 fatores conforme teoria)
modelo_fatorial <- fa(df_avareza[, 1:20], nfactors = 2, cor = "poly", fm = "uls", rotate = "promax")
print(modelo_fatorial$loadings, cutoff = 0.3)
## 
## Loadings:
##        ULS1   ULS2  
## item1   0.438       
## item2   0.635 -0.366
## item3   0.580       
## item4   0.532  0.336
## item5   0.652       
## item6   0.425       
## item7   0.525       
## item8               
## item9   0.586 -0.428
## item10  0.422       
## item11         0.679
## item12         0.449
## item13  0.558       
## item14         0.438
## item15  0.311  0.369
## item16         0.800
## item17  0.374  0.428
## item18         0.606
## item19         0.455
## item20  0.416       
## 
##                 ULS1  ULS2
## SS loadings    3.565 3.094
## Proportion Var 0.178 0.155
## Cumulative Var 0.178 0.333

4.1 Correlograma

Visualização das correlações policóricas entre os itens.

matriz_cor <- cor(df_avareza[, 1:20], use = "complete.obs")
ggcorrplot(matriz_cor, hc.order = TRUE, type = "lower", lab = TRUE, lab_size = 2,
           method = "circle", colors = c("lightblue", "white", "red"),
           title = "Correlograma dos Itens (N=122)")

5. Índices de Ajuste e Simplicidade (Índice S)

Avaliamos a qualidade do modelo e a pureza semântica de cada item

# Índices de Ajuste
cat("RMSEA: ", round(modelo_fatorial$RMSEA[1], 3), "\n")
## RMSEA:  0.128
cat("TLI: ", round(modelo_fatorial$TLI, 3), "\n")
## TLI:  0.577
# Cálculo do Índice S
cargas_sq <- modelo_fatorial$loadings^2
comunalidades <- modelo_fatorial$communality
indice_s <- apply(cargas_sq, 1, max) / comunalidades

tabela_s <- data.frame(
  Item = names(indice_s),
  Indice_S = round(indice_s, 3),
  Interpretacao = ifelse(indice_s >= 0.8, "Estável (Simples)", "Instável (Complexo)")
)
print(tabela_s)
##          Item Indice_S       Interpretacao
## item1   item1    1.016   Estável (Simples)
## item2   item2    1.308   Estável (Simples)
## item3   item3    0.825   Estável (Simples)
## item4   item4    0.495 Instável (Complexo)
## item5   item5    0.655 Instável (Complexo)
## item6   item6    0.462 Instável (Complexo)
## item7   item7    0.663 Instável (Complexo)
## item8   item8    0.412 Instável (Complexo)
## item9   item9    1.229   Estável (Simples)
## item10 item10    0.865   Estável (Simples)
## item11 item11    1.240   Estável (Simples)
## item12 item12    0.807   Estável (Simples)
## item13 item13    0.826   Estável (Simples)
## item14 item14    0.669 Instável (Complexo)
## item15 item15    0.394 Instável (Complexo)
## item16 item16    1.277   Estável (Simples)
## item17 item17    0.381 Instável (Complexo)
## item18 item18    0.876   Estável (Simples)
## item19 item19    0.703 Instável (Complexo)
## item20 item20    0.665 Instável (Complexo)

6. Validação da Versão Reduzida

Após a análise dos 20 itens, procedemos com a redução para os 10 melhores indicadores (5 por fator) e recalculamos as propriedades psicométricas.

# Seleção dos 10 itens
itens_10 <- c("item2", "item3", "item5", "item9", "item11", 
              "item12", "item13", "item16", "item18", "item19")
df_final <- df_avareza[, itens_10]

# Fidedignidade (Alfa e Ômega)
res_alpha_final <- psych::alpha(df_final)
res_omega_final <- psych::omega(df_final, nfactors = 2, poly = TRUE)

# Nova AFE para a Versão Curta
modelo_final <- fa(df_final, nfactors = 2, cor = "poly", fm = "uls", rotate = "promax")

cat("--- RESULTADOS FINAIS (10 ITENS) ---\n")
## --- RESULTADOS FINAIS (10 ITENS) ---
cat("Alfa Total:", round(res_alpha_final$total$raw_alpha, 2), "\n")
## Alfa Total: 0.69
cat("Omega Total:", round(res_omega_final$omega.tot, 2), "\n")
## Omega Total: 0.79
cat("RMSEA Final:", round(modelo_final$RMSEA[1], 3), "\n")
## RMSEA Final: 0.143
cat("TLI Final:", round(modelo_final$TLI, 3), "\n")
## TLI Final: 0.626

7. Considerações de Fidedignidade por Fator

# Fator 1: Desejo Contínuo
alpha_f1 <- psych::alpha(df_final[, c("item2", "item3", "item5", "item9", "item13")])

# Fator 2: Insatisfação Crônica
alpha_f2 <- psych::alpha(df_final[, c("item11", "item12", "item16", "item18", "item19")])

cat("Alfa Fator 1 (Desejo):", round(alpha_f1$total$raw_alpha, 2), "\n")
## Alfa Fator 1 (Desejo): 0.63
cat("Alfa Fator 2 (Insatisfação):", round(alpha_f2$total$raw_alpha, 2), "\n")
## Alfa Fator 2 (Insatisfação): 0.65