library(psych)
library(tidyverse)
library(haven)
library(nFactors)
library(EGAnet)
library(psychTools)
library(haven)
library(dplyr)
library(tidyr)
library(ggcorrplot)
library(knitr)
library(lavaan)
library(mirt)
#Bu kod baya işlevsel oldu
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
Bu günlükte:
1- Tek boyutluluk testleri
2- Yerel bağımsızlık (Yen’in Q3)
3- Model karşılaştırmaları
4- Uygun model seçimi
5- Model parametre kestirimleri
6- Madde bilgi fonksiyonları ve yetenek kestirimleri yapılmıştır.
Veri seti LISS veri paneli 2024 yılı, kişilik araştırmaları 16. döngüden alınmıştır. Social Desirability ölçeği kullanılmıştır.
data <- read_sav("cp24p_EN_1.0p.sav")
data <- data %>%
select("cp24p136":"cp24p145") %>% expss::drop_var_labs() %>% na.omit()
head(data)
## # A tibble: 6 × 10
## cp24p136 cp24p137 cp24p138 cp24p139 cp24p140 cp24p141 cp24p142 cp24p143
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2 2 1 1 2 2 2 2
## 2 2 2 1 2 2 2 2 2
## 3 2 1 1 1 2 2 1 2
## 4 2 1 1 2 2 1 1 2
## 5 2 1 2 2 2 2 2 2
## 6 2 2 2 2 2 1 2 1
## # ℹ 2 more variables: cp24p144 <dbl>, cp24p145 <dbl>
data %>%
psych::describe() %>%
select(mean, sd, skew, kurtosis) %>%
kable(digits = 2)
mean | sd | skew | kurtosis | |
---|---|---|---|---|
cp24p136 | 1.80 | 0.40 | -1.48 | 0.19 |
cp24p137 | 1.36 | 0.48 | 0.58 | -1.66 |
cp24p138 | 1.25 | 0.43 | 1.14 | -0.71 |
cp24p139 | 1.41 | 0.49 | 0.38 | -1.86 |
cp24p140 | 1.89 | 0.31 | -2.51 | 4.28 |
cp24p141 | 1.66 | 0.48 | -0.66 | -1.57 |
cp24p142 | 1.52 | 0.50 | -0.06 | -2.00 |
cp24p143 | 1.83 | 0.38 | -1.72 | 0.97 |
cp24p144 | 1.52 | 0.50 | -0.06 | -2.00 |
cp24p145 | 1.68 | 0.46 | -0.79 | -1.37 |
Çarpıklık ve basıklık katsayıları için [-2,2] aralığı kabul edilebilir sınır olarak alınmaktadır. Bu durumda veri setinde yer alan değişkenlerin çarpıklık ve basıklık değerlerinin uygun olduğu (m8 - basıklık hariç) yorumu yapılabilir.
Social Desirability Ölçeği tek boyutlu bir ölçektir. Maddeler 1-2 arası puanlanmaktadır. 1: False, 2: True ile etiketlenmiştir. Yüksek puanlar daha sosyal beğenirlik algısını temsil eder.
colnames(data) <- c("m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10")
# Yeniden kodlayalım 0-1 olacak şekilde
data <- data - 1
head(data)
## m1 m2 m3 m4 m5 m6 m7 m8 m9 m10
## 1 1 1 0 0 1 1 1 1 0 1
## 2 1 1 0 1 1 1 1 1 0 0
## 3 1 0 0 0 1 1 0 1 0 1
## 4 1 0 0 1 1 0 0 1 0 1
## 5 1 0 1 1 1 1 1 1 1 0
## 6 1 1 1 1 1 0 1 0 0 1
Veri setinin bileşenleri incelenmiştir. 2 Boyutlu olduğu olduğu görülmektedir.
library(Gifi)
pca <- princals(data)
plot(pca)
psych::fa.parallel(data, cor = "poly")
## Parallel analysis suggests that the number of factors = 4 and the number of components = 3
PA ise 4 boyut öneriyor. Ancak bu boyutların anlamlı olup olmadığına bakmak gerekir.
onefac <- psych::fa(data,1,cor = "poly")
twofac <- psych::fa(data,2,cor = "poly")
threefac <- psych::fa(data,3,cor = "poly")
onefac$loadings
##
## Loadings:
## MR1
## m1 -0.320
## m2 -0.414
## m3 0.423
## m4 0.538
## m5 -0.253
## m6 -0.384
## m7 0.500
## m8 -0.271
## m9 0.565
## m10 0.486
##
## MR1
## SS loadings 1.832
## Proportion Var 0.183
twofac$loadings
##
## Loadings:
## MR1 MR2
## m1 -0.142 0.380
## m2 -0.380
## m3 0.380 -0.113
## m4 0.543
## m5 0.535
## m6 -0.275 0.228
## m7 0.465
## m8 0.653
## m9 0.585
## m10 0.626 0.146
##
## MR1 MR2
## SS loadings 1.631 0.964
## Proportion Var 0.163 0.096
## Cumulative Var 0.163 0.259
threefac$loadings
##
## Loadings:
## MR1 MR2 MR3
## m1 0.329 0.171
## m2 -0.109 0.553
## m3 0.393 -0.127
## m4 0.569
## m5 0.624
## m6 0.606
## m7 0.404 -0.120
## m8 0.577 0.116
## m9 0.638
## m10 0.575 0.154
##
## MR1 MR2 MR3
## SS loadings 1.401 0.896 0.744
## Proportion Var 0.140 0.090 0.074
## Cumulative Var 0.140 0.230 0.304
Faktör yükleri, açıklanan varyans oranı vb. birçok bilgi incelendiğinde veri setinin iki boyutlu olduğu söylenebilir.
EGAnet::EGA(data, cor = "auto", algorithm = "louvain",uni.method = "louvain")
## Registered S3 methods overwritten by 'Hmisc':
## method from
## [.labelled expss
## print.labelled expss
## as.data.frame.labelled expss
## Model: GLASSO (EBIC with gamma = 0.5)
## Correlations: auto
## Lambda: 0.0399658871559826 (n = 100, ratio = 0.1)
##
## Number of nodes: 10
## Number of edges: 35
## Edge density: 0.778
##
## Non-zero edge weights:
## M SD Min Max
## 0.048 0.110 -0.121 0.266
##
## ----
##
## Consensus Method: Most Common (1000 iterations)
## Algorithm: Louvain
## Order: Higher
##
## Number of communities: 3
##
## m1 m2 m3 m4 m5 m6 m7 m8 m9 m10
## 1 2 3 3 1 2 3 1 3 3
##
## ----
##
## Unidimensional Method: Louvain
## Unidimensional: No
##
## ----
##
## TEFI: -5.785
EGA da modelin üç boyutlu olduğunu göstermektedir.
Veri setinin tek boyutlu olmadığı açıkça görülmektedir. Bu nedenle kestirimlere devam edebilmek adına boyutlardan birini seçip devam edeceğim. Bunun için EGA tarafından işaretlenmiş 3. boyutu ele alacağım. (m3, m4, m7, m9, m10)
data <- data %>% select(m3, m4, m7, m9, m10)
EGA(data, cor = "auto", algorithm = "louvain",uni.method = "louvain")
## Model: GLASSO (EBIC with gamma = 0.5)
## Correlations: auto
## Lambda: 0.0399658871559826 (n = 100, ratio = 0.1)
##
## Number of nodes: 5
## Number of edges: 10
## Edge density: 1.000
##
## Non-zero edge weights:
## M SD Min Max
## 0.143 0.080 0.005 0.279
##
## ----
##
## Algorithm: Louvain
##
## Number of communities: 1
##
## m3 m4 m7 m9 m10
## 1 1 1 1 1
##
## ----
##
## Unidimensional Method: Louvain
## Unidimensional: Yes
##
## ----
##
## TEFI: 0
Seçilen 5 maddenin tek boyutlu olduğuna kanıt getirmiş olduk.
Rasch, 1PL, 2PL ve 3PL için kestirimler yapacağım. AIC ve BIC kullanarak model seçimini yapacağım.
rasch <- mirt(data, 1, itemtype = "Rasch", verbose = F)
onepl <- mirt(data, 1, itemtype = "1PL", verbose = F)
twopl <- mirt(data, 1, itemtype = "2PL", verbose = F)
threepl <- mirt(data, 1, itemtype = "3PL", verbose = F)
kable(anova(rasch,onepl,twopl,threepl), digits = 2, caption = "Model veri uyumu")
AIC | SABIC | HQ | BIC | logLik | X2 | df | p | |
---|---|---|---|---|---|---|---|---|
rasch | 33966.15 | 33986.67 | 33979.96 | 34005.74 | -16977.07 | NA | NA | NA |
onepl | 33970.91 | 33988.01 | 33982.42 | 34003.90 | -16980.45 | -6.76 | -1 | NaN |
twopl | 33939.71 | 33973.92 | 33962.74 | 34005.70 | -16959.86 | 41.20 | 5 | 0.00 |
threepl | 33948.46 | 33999.78 | 33983.01 | 34047.44 | -16959.23 | 1.25 | 5 | 0.94 |
AIC, BIC değerleri incelendiğinde ve \(\chi^2\) değerleri arasındaki farkların anlamlılığı incelendiğinde en iyi uyum 2PL model olduğu belirlenmiştir.
mirt::itemfit(twopl, method = "S-X2")
## item S_X2 df.S_X2 RMSEA.S_X2 p.S_X2
## 1 m3 1.041 2 0.000 0.594
## 2 m4 2.694 2 0.008 0.260
## 3 m7 4.758 2 0.016 0.093
## 4 m9 0.699 2 0.000 0.705
## 5 m10 0.742 2 0.000 0.690
Tüm maddeler için p > 0.05 olduğu, bu nedenle madde-model uyumunun sağlandığı söylenebilir.
kable(mirt::coef(twopl, IRTpars = TRUE,simplify = T)$items,digits = 2, caption = "Madde parametreleri")
a | b | g | u | |
---|---|---|---|---|
m3 | 0.82 | 1.51 | 0 | 1 |
m4 | 1.17 | 0.41 | 0 | 1 |
m7 | 0.89 | -0.08 | 0 | 1 |
m9 | 1.36 | -0.06 | 0 | 1 |
m10 | 1.14 | -0.85 | 0 | 1 |
Elde edilen parametreler: b) madde güçlüğü, a) madde ayırt ediciliğine karşılık gelmektedir. Bu bağlamda en kolay madde m10 (b = -0.85), en zor madde m3 (b = 1.51), en yüksek ayırt ediciliğe sahip madde m9 (a = 1.36), en düşük ayırt ediciliğe sahip madde m7 (a = 0.89) olarak belirlenmiştir.
plot(twopl, type = "trace")
plot(twopl, type = "info", which.items = 1, main = "Madde Bilgi Fonksiyonu")
plot(twopl, type = "info", which.items = 2, main = "Madde Bilgi Fonksiyonu")
plot(twopl, type = "info", which.items = 3, main = "Madde Bilgi Fonksiyonu")
plot(twopl, type = "info", which.items = 4, main = "Madde Bilgi Fonksiyonu")
plot(twopl, type = "info", which.items = 5, main = "Madde Bilgi Fonksiyonu")
plot(twopl, type = "info")
plot(twopl, type = "SE")
Testin bilgi fonksiyonuna ilişkin standart hata grafiği de bu şekilde. Düşük yetenek düzeylerinde daha yüksek hata olabileceği görülüyor.
theta <- fscores(twopl, method = "EAP")
psych::describe(theta, fast = T)
## vars n mean sd median min max range skew kurtosis se
## X1 1 5423 0 0.72 -0.06 -1.25 1.32 2.58 0 -0.83 0.01
Theta’lar -1.25, 1.32 arasında değişmektedir.
hist(theta, main = "Theta Dağılımı", xlab = "Theta", breaks = 5)
Not: Yaklaşık 20 dk sürdü.