Bu öğrenme günlüğünde, psych paketindeki Big Five Inventory (BFI) veri setindeki 25 çok kategorili madde (A1–A5, C1–C5, E1–E5, N1–N5, O1–O5) üzerinde farklı Madde Tepki Kuramı (MTK) modelleri karşılaştırılacaktır. İncelenecek modeller:

Bu modellerin veri uyumunu log-Likelihood (LogLik), AIC ve BIC ölçütleriyle karşılaştırarak en uygun MTK modelini belirleyeceğim.

Veri Hazırlama

library(mirt)
library(ltm)
library(psych)
library(dplyr)
library(knitr)
library(kableExtra)

BFI verisini yükleme ve madde sütunlarını seçme

data(bfi)
bfi_items <- bfi %>%
  select(A1:A5, C1:C5, E1:E5, N1:N5, O1:O5) %>%
  na.omit()

Madde ortalama ve standart sapmaları

desc <- describe(bfi_items)
knitr::kable(desc, digits = 2, caption = "Madde Betimsel İstatistikleri") %>%
  kableExtra::kable_styling(full_width = TRUE)
Madde Betimsel İstatistikleri
vars n mean sd median trimmed mad min max range skew kurtosis se
A1 1 2436 2.41 1.41 2 2.22 1.48 1 6 5 0.84 -0.28 0.03
A2 2 2436 4.80 1.18 5 4.97 1.48 1 6 5 -1.12 1.01 0.02
A3 3 2436 4.60 1.31 5 4.79 1.48 1 6 5 -1.01 0.46 0.03
A4 4 2436 4.69 1.49 5 4.92 1.48 1 6 5 -1.02 0.02 0.03
A5 5 2436 4.54 1.27 5 4.70 1.48 1 6 5 -0.84 0.13 0.03
C1 6 2436 4.53 1.24 5 4.66 1.48 1 6 5 -0.87 0.32 0.03
C2 7 2436 4.37 1.32 5 4.50 1.48 1 6 5 -0.74 -0.15 0.03
C3 8 2436 4.30 1.29 5 4.41 1.48 1 6 5 -0.68 -0.15 0.03
C4 9 2436 2.55 1.38 2 2.41 1.48 1 6 5 0.61 -0.59 0.03
C5 10 2436 3.31 1.63 3 3.26 1.48 1 6 5 0.06 -1.23 0.03
E1 11 2436 2.98 1.63 3 2.86 1.48 1 6 5 0.37 -1.09 0.03
E2 12 2436 3.15 1.61 3 3.07 1.48 1 6 5 0.23 -1.15 0.03
E3 13 2436 3.98 1.35 4 4.05 1.48 1 6 5 -0.47 -0.46 0.03
E4 14 2436 4.41 1.47 5 4.58 1.48 1 6 5 -0.82 -0.32 0.03
E5 15 2436 4.39 1.34 5 4.53 1.48 1 6 5 -0.78 -0.11 0.03
N1 16 2436 2.94 1.58 3 2.84 1.48 1 6 5 0.37 -1.02 0.03
N2 17 2436 3.52 1.53 4 3.52 1.48 1 6 5 -0.08 -1.06 0.03
N3 18 2436 3.22 1.59 3 3.17 1.48 1 6 5 0.14 -1.18 0.03
N4 19 2436 3.20 1.57 3 3.14 1.48 1 6 5 0.20 -1.09 0.03
N5 20 2436 2.97 1.62 3 2.85 1.48 1 6 5 0.38 -1.07 0.03
O1 21 2436 4.81 1.13 5 4.96 1.48 1 6 5 -0.90 0.46 0.02
O2 22 2436 2.68 1.55 2 2.53 1.48 1 6 5 0.62 -0.76 0.03
O3 23 2436 4.45 1.21 5 4.57 1.48 1 6 5 -0.77 0.32 0.02
O4 24 2436 4.93 1.19 5 5.13 1.48 1 6 5 -1.24 1.18 0.02
O5 25 2436 2.47 1.32 2 2.32 1.48 1 6 5 0.76 -0.18 0.03

Madde düzeyinde yapılan betimsel analizler, katılımcıların çoğu maddeye olumlu yanıt verdiğini göstermektedir. A1, C4 ve O5 maddeleri düşük ortalamalarıyla dikkat çekerken, diğer maddeler genellikle orta-üst düzeyde değerlendirilmiştir. Çarpıklık ve basıklık değerleri ±1.5 aralığında olup, veri dağılımlarının normal dağılıma yakın olduğunu göstermektedir. Bu durum, sonraki yapısal analizler için uygun bir temel sunmaktadır. Ben A1-A5 maddeleri için çalışma yapacağım.

Varsayımlar

Tek boyutluluk varsayımı:

Tek boyutluluk varsayımını test etmek için, psych paketindeki principal fonksiyonu ile temel bileşen analizi (PCA) yapılacaktır. PCA, veri setinin tek bir boyutta yoğunlaşma eğiliminde olup olmadığını belirlemek için kullanılır. Ayrıca EGA (Exploratory Graph Analysis) ile de tek boyutluluk varsayımını test edebiliriz. A1 ter puanlandığı için önce o maddeyi ters puanlayacağız.

bfi_items <- bfi_items %>%
  mutate(A1 = 6 - A1)
pc <- principal(bfi_items[1:5], nfactors = 1, rotate = "none")
kable(pc$loadings, digits = 2, caption = "PCA Sonuçları") %>%
  kable_styling(full_width = TRUE)
PCA Sonuçları
PC1
A1 0.51
A2 0.77
A3 0.80
A4 0.63
A5 0.72 
library(EGAnet)
EGA(bfi_items[1:5], nFactors = 1, graph = TRUE)

## Model: GLASSO (EBIC with gamma = 0.5)
## Correlations: auto
## Lambda: 0.0581963241966381 (n = 100, ratio = 0.1)
## 
## Number of nodes: 5
## Number of edges: 9
## Edge density: 0.900
## 
## Non-zero edge weights: 
##      M    SD   Min   Max
##  0.184 0.114 0.001 0.373
## 
## ----
## 
## Algorithm:  Louvain
## 
## Number of communities:  1
## 
## A1 A2 A3 A4 A5 
##  1  1  1  1  1 
## 
## ----
## 
## Unidimensional Method: Louvain
## Unidimensional: Yes
## 
## ----
## 
## TEFI: 0

Yapılan EGA analizinde değişkenler arasında yüksek bağlantı yoğunluğu (%90) gözlenmiştir. Bu da yapının tek boyutlu olduğunu göstermiştir. Benzer şekilde, temel bileşenler analizi (PCA) sonuçları da tek faktörlü bir yapıyı desteklemiştir. Sonuç olarak, ilgili maddelerin ortak bir yapıyı ölçtüğüne karar verilmiştir.

Yerel bağımsızlık varsayımı:

Yerel bağımsızlık varsayımını test etmek için, Yen’in Q3 istatistiği kullanılacaktır. Bu istatistik, her bir madde çifti arasındaki bağımlılığı ölçer. Eğer Q3 değeri 0.2’den büyükse, maddeler arasında bağımlılık olduğu kabul edilir.

library(mirt)
library(reshape2)
library(dplyr)
library(knitr)
library(kableExtra)

mod_a <- mirt(bfi_items[, 1:5], 1)
## Iteration: 1, Log-Lik: -17569.456, Max-Change: 0.82760Iteration: 2, Log-Lik: -17293.933, Max-Change: 0.54548Iteration: 3, Log-Lik: -17202.953, Max-Change: 0.48978Iteration: 4, Log-Lik: -17163.846, Max-Change: 0.18876Iteration: 5, Log-Lik: -17149.727, Max-Change: 0.14783Iteration: 6, Log-Lik: -17143.944, Max-Change: 0.12614Iteration: 7, Log-Lik: -17141.392, Max-Change: 0.08485Iteration: 8, Log-Lik: -17139.844, Max-Change: 0.05098Iteration: 9, Log-Lik: -17139.217, Max-Change: 0.04864Iteration: 10, Log-Lik: -17138.530, Max-Change: 0.01209Iteration: 11, Log-Lik: -17138.470, Max-Change: 0.00319Iteration: 12, Log-Lik: -17138.466, Max-Change: 0.00176Iteration: 13, Log-Lik: -17138.462, Max-Change: 0.00080Iteration: 14, Log-Lik: -17138.461, Max-Change: 0.00064Iteration: 15, Log-Lik: -17138.461, Max-Change: 0.00015Iteration: 16, Log-Lik: -17138.461, Max-Change: 0.00070Iteration: 17, Log-Lik: -17138.461, Max-Change: 0.00184Iteration: 18, Log-Lik: -17138.459, Max-Change: 0.00013Iteration: 19, Log-Lik: -17138.459, Max-Change: 0.00013Iteration: 20, Log-Lik: -17138.459, Max-Change: 0.00035Iteration: 21, Log-Lik: -17138.459, Max-Change: 0.00040Iteration: 22, Log-Lik: -17138.459, Max-Change: 0.00027Iteration: 23, Log-Lik: -17138.459, Max-Change: 0.00030Iteration: 24, Log-Lik: -17138.459, Max-Change: 0.00009
q3_matrix <- residuals(mod_a, type = "Q3")
## Q3 summary statistics:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -0.377  -0.232  -0.176  -0.167  -0.099   0.064 
## 
##        A1     A2     A3     A4     A5
## A1  1.000  0.064 -0.183 -0.098 -0.168
## A2  0.064  1.000 -0.377 -0.096 -0.268
## A3 -0.183 -0.377  1.000 -0.193 -0.245
## A4 -0.098 -0.096 -0.193  1.000 -0.104
## A5 -0.168 -0.268 -0.245 -0.104  1.000
q3_long <- melt(q3_matrix, varnames = c("Item1", "Item2"), value.name = "Q3")

q3_results <- q3_long %>%
  filter(as.character(Item1) < as.character(Item2)) %>%
  mutate(Significant = ifelse(Q3 > 0.20, "EVET", "HAYIR"))
kable(q3_results, digits = 3, caption = "Yen'in Q3 İstatistikleri") %>%
  kable_styling(full_width = TRUE)
Yen’in Q3 İstatistikleri
Item1 Item2 Q3 Significant
A1 A2 0.064 HAYIR
A1 A3 -0.183 HAYIR
A2 A3 -0.377 HAYIR
A1 A4 -0.098 HAYIR
A2 A4 -0.096 HAYIR
A3 A4 -0.193 HAYIR
A1 A5 -0.168 HAYIR
A2 A5 -0.268 HAYIR
A3 A5 -0.245 HAYIR
A4 A5 -0.104 HAYIR

Yen’in Q3 istatistiklerine göre, tüm madde çiftleri arasındaki artık korelasyonlar 0.20 sınırının altında kalmış, en yüksek değer A1 ve A2 arasında 0.064 olarak gözlenmiştir. Ortalama Q3 değeri -0.167 olup, modelde anlamlı bir yerel bağımlılık bulunmadığını göstermektedir. Bu bulgular, tek boyutlu model varsayımının ihlal edilmediğini desteklemektedir.

Madde tepki kuramı (MTK) modellerinin karşılaştırılması:

MTK modellerinin karşılaştırılması için, mirt ve eRm paketleri kullanılacaktır.

model_results <- data.frame(
  Model  = c("GRM", "PCM", "GPCM"),
  LogLik = c(-17138.46, -17521.29, -17313.57),
  AIC    = c(34336.92, 35094.59, 34687.14),
  BIC    = c(34510.86, 35245.34, 34861.08)
)

knitr::kable(model_results, digits = 2, caption = "MTK Modellerinin Karşılaştırma Sonuçları") %>%
  kableExtra::kable_styling(full_width = FALSE)
MTK Modellerinin Karşılaştırma Sonuçları
Model LogLik AIC BIC
GRM -17138.46 34336.92 34510.86
PCM -17521.29 35094.59 35245.34
GPCM -17313.57 34687.14 34861.08

en düşük AIC (34336.92) ve BIC (34510.86) değerleri GRM (Dereceli Tepki Modeli) tarafından elde edilmiştir. Bu durum, GRM modelinin veri ile en iyi uyumu sağladığını göstermektedir. GPCM modeli, GRM’ye yakın log-likelihood değerine sahip olsa da, daha yüksek AIC ve BIC değerleri nedeniyle ikinci sırada yer almaktadır. PCM modeli ise en düşük log-likelihood ve en yüksek uyum kriterleri ile üç model arasında en zayıf uyumu sergilemiştir.

RSM (Rating Scale Model) ise yalnızca koşullu log-likelihood (8126520) değeri vermektedir. Bu değer, tam bilgi log-likelihood temelli modellerle doğrudan karşılaştırılamaz. Ayrıca elde edilen parametre tahminlerinde anlamlı olmayan (NaN) standart hatalar ve aşırı uç değerlere sahip tahminler, bu modelin veri yapısına uygun olmadığını göstermektedir. Dolayısıyla RSM modeli, bu veri seti özelinde istatistiksel olarak güvenilir ve geçerli bir seçenek olarak değerlendirilememektedir.

Sonuç olarak, model karşılaştırma kriterleri doğrultusunda GRM modeli en uygun model olarak seçilmiştir.

grmtab <- coef(mod_grm, IRTpars = TRUE, simplify = TRUE)$items
knitr::kable(grmtab, digits = 2, caption = "GRM Modeli Madde Parametreleri") %>%
  kableExtra::kable_styling(full_width = TRUE)
GRM Modeli Madde Parametreleri
a b1 b2 b3 b4 b5
A1 0.89 -4.32 -2.71 -1.63 -0.74 0.87
A2 1.90 -2.97 -2.09 -1.59 -0.65 0.64
A3 2.61 -2.21 -1.57 -1.16 -0.40 0.73
A4 1.11 -3.20 -2.11 -1.60 -0.67 0.42
A5 1.71 -2.95 -1.90 -1.29 -0.35 0.96

maddelerin ayırt edicilik katsayıları (a) 0.89 ile 2.61 arasında değişmektedir. En yüksek ayırt edicilik A3 maddesinde (a = 2.61) görülürken, en düşük ayırt edicilik A1 maddesinde (a = 0.89) gözlenmiştir. Bu durum, A3 maddesinin bireylerin yetenek düzeylerini ayırt etme konusunda en güçlü madde olduğunu, A1’in ise bu açıdan daha zayıf kaldığını göstermektedir.

Kategori zorluk (b) parametreleri incelendiğinde, tüm maddelerde b1’den b5’e doğru artan bir sıra izlenmekte olup, bu durum modelin monotonluk varsayımını karşıladığını göstermektedir. Tüm maddelerin b değerleri negatiften pozitife doğru bir geçiş sergileyerek, daha yüksek puanların daha yüksek yetenek düzeylerinde verildiğini ortaya koymaktadır.

Genel olarak, model parametreleri GRM’nin geçerli biçimde uygulanabildiğini ve A maddelerinin bireylerin tek boyutlu yapılar üzerindeki yerlerini anlamada yeterli duyarlılığa sahip olduğunu göstermektedir.

theta_scores <- fscores(mod_grm, method = "EAP", full.scores.SE = TRUE)
library(DT)
datatable(theta_scores, options = list(pageLength = 5), caption = "Theta Kestirim Sonuçları")

Yetenek değerleri geniş bir aralıkta dağılmış olup, yaklaşık -2 ila +1 arasında yoğunlaşmaktadır. Standart hata değerleri ise çoğunlukla 0.40–0.50 aralığında seyretmektedir; bu da modelin bireyleri ayırt etme gücünün orta düzeyde olduğunu göstermektedir. Özellikle uç noktalardaki bireyler için hata değerleri nispeten daha yüksektir, bu da uç bölgelerde ölçüm duyarlılığının azaldığını göstermektedir.

Madde karakteristik eğrileri (MCE)

library(plotly)

item_params <- list(
  A1 = list(a = 0.89, b = c(-4.32, -2.71, -1.63, -0.74, 0.87)),
  A2 = list(a = 1.90, b = c(-2.97, -2.09, -1.59, -0.65, 0.64)),
  A3 = list(a = 2.61, b = c(-2.21, -1.57, -1.16, -0.40, 0.73)),
  A4 = list(a = 1.11, b = c(-3.20, -2.11, -1.60, -0.67, 0.42)),
  A5 = list(a = 1.71, b = c(-2.95, -1.90, -1.29, -0.35, 0.96))
)

theta <- seq(-4, 4, length.out = 500)
plot_data <- data.frame()

for (item in names(item_params)) {
  a <- item_params[[item]]$a
  b <- item_params[[item]]$b
  n_cat <- length(b) + 1
  
  P_cum <- sapply(b, function(bk) {
    1 / (1 + exp(-a * (theta - bk)))
  })
  
  P_cum <- cbind(1, P_cum, 0)
  
  for (k in 1:n_cat) {
    P_k <- P_cum[, k] - P_cum[, k + 1]
    plot_data <- rbind(plot_data, data.frame(
      theta = theta,
      probability = P_k,
      item = item,
      category = paste0("Kategori ", k)
    ))
  }
}

plot_ly(plot_data, x = ~theta, y = ~probability,
        color = ~category, linetype = ~item,
        type = "scatter", mode = "lines") %>%
  layout(title = "GRM Modeline Göre Madde Karakteristik Eğrileri",
         xaxis = list(title = "Yetenek (θ)"),
         yaxis = list(title = "Kategori Olasılığı"),
         legend = list(title = list(text = "Kategori")))

Her kategori için θ eksenine yayılmış ayrı karakteristik eğriler gözlemlenmiştir. Eğrilerin düzenli dağılması, maddelerin farklı yetenek düzeylerindeki bireyleri yeterince ayırt ettiğini göstermektedir. Kategori 1 eğrileri daha düşük θ düzeylerinde baskınken, kategori 5 eğrileri yüksek θ değerlerinde yükselerek modelin teorik beklentilerini karşılamaktadır. Bu yapı, A1–A5 maddelerinin ölçüm düzeyinde dengeli ve işlevsel olduğunu ortaya koymaktadır.

Madde bilgi fonksiyonları

library(plotly)

theta <- seq(-4, 4, by = 0.1)
p <- plot_ly()

for (item in names(item_params)) {
  a <- item_params[[item]]$a
  b_vec <- item_params[[item]]$b
  n_cat <- length(b_vec) + 1
  
  P_cum <- sapply(b_vec, function(bk) {
    1 / (1 + exp(-a * (theta - bk)))
  })
  P_cum <- cbind(1, P_cum, 0)  
  
  P_k <- P_cum[, -ncol(P_cum)] - P_cum[, -1]
  
  info <- rowSums(P_k * (1 - P_k)) * a^2
  
  p <- add_trace(p, x = theta, y = info, type = "scatter", mode = "lines", name = item)
}

p <- layout(p,
            title = "GRM Modeline Göre Madde Bilgi Fonksiyonları",
            xaxis = list(title = "Yetenek Düzeyi (θ)"),
            yaxis = list(title = "Bilgi (Information)"))

p

A3 maddesi, hem ayırt edicilik hem de sağladığı bilgi açısından en güçlü maddedir. A1 ve A4 maddeleri görece daha az ölçüm bilgisi sunmakta ve iyileştirmeye açık görünmektedir. Ölçek genel olarak düşük ve orta düzey θ (yetenek) değerlerinde daha duyarlıdır; bu da özellikle desteğe ihtiyaç duyan bireylerin belirlenmesinde etkilidir.

Test bilgi fonksiyonu

theta <- seq(-4, 4, by = 0.1)

test_info <- sapply(theta, function(th) {
  sum(sapply(item_params, function(param) {
    a <- param$a
    b_vec <- param$b
    n_cat <- length(b_vec) + 1

    P_cum <- sapply(b_vec, function(bk) {
      1 / (1 + exp(-a * (th - bk)))
    })
    P_cum <- c(1, P_cum, 0)

    P_k <- P_cum[-length(P_cum)] - P_cum[-1]

    sum(P_k * (1 - P_k)) * a^2
  }))
})

plot_ly(x = ~theta, y = ~test_info, type = "scatter", mode = "lines") %>%
  layout(
    title = "GRM Modeline Göre Test Bilgi Fonksiyonu – A1-A5 Maddeleri",
    xaxis = list(title = "Yetenek Düzeyi (θ)"),
    yaxis = list(title = "Toplam Bilgi")
  )

Grafik incelendiğinde, testin en yüksek bilgi düzeyine θ ≈ -1.5 civarında ulaştığı ve bu yetenek düzeylerinde bireyleri ayırt etmede yüksek duyarlılığa sahip olduğu görülmektedir. Buna karşın, ortalama ve üzeri yetenek düzeylerinde sağlanan bilgi görece düşüktür.

NOT: Öğrenme günlüğünün yazılması yaklaşık 2,5 saat sürdü.