Bu öğrenme günlüğünde Rasch dersinde üzerinde çalıştığımız bir veri setini kullanarak Madde Tepki Kuramı (MTK) çerçevesinde analizler gerçekleştirmeye çalıştım. Analizler şu aşamaları kapsamaktadır:

Verinin Yüklenmesi

library(readxl)
library(mirt)

veri <- read_excel("C:/Users/Lenovo/Desktop/dmfveri.xlsx")

Sadece maddeleri içeren veri setini alıp summary fonksiyonu ile özetleyelim.

cevaplar <- veri[, grep("^m_", names(veri))]
summary(cevaplar)
##       m_1              m_2             m_3              m_4        
##  Min.   :0.0000   Min.   :0.000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.000   Median :0.0000   Median :0.0000  
##  Mean   :0.2251   Mean   :0.173   Mean   :0.4533   Mean   :0.3864  
##  3rd Qu.:0.0000   3rd Qu.:0.000   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :1.000   Max.   :1.0000   Max.   :1.0000  
##       m_5              m_6              m_7              m_8        
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000  
##  Mean   :0.4979   Mean   :0.4607   Mean   :0.2665   Mean   :0.2346  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##       m_9              m_10             m_11             m_12       
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.0000   Median :0.0000   Median :0.0000  
##  Mean   :0.3599   Mean   :0.2633   Mean   :0.2357   Mean   :0.1794  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##       m_13             m_14             m_15             m_16       
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :1.0000   Median :0.0000   Median :0.0000  
##  Mean   :0.2845   Mean   :0.5297   Mean   :0.2229   Mean   :0.4268  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.0000  
##       m_17             m_18             m_19       
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.0000   Median :0.0000  
##  Mean   :0.3631   Mean   :0.3344   Mean   :0.1391  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000

Veri seti, 942 bireyin 19 maddeye verdikleri yanıtları içermektedir. Her bir madde için bireylerin yanıtları 0 (yanlış) veya 1 (doğru) şeklinde kodlanmıştır.

Tek Boyutluluk analizi

Temel bileşenler analizi ile verinin tek boyutlu olup olmadığını kontrol edelim. Plot fonksiyonu diğer maddelerden ayrılan madde var mı diye bakmak için kullanılabilir.

library(Gifi)
cevaplar_faktor <- data.frame(lapply(cevaplar, factor))
pca <- princals(cevaplar_faktor)
summary(pca)
## 
## Loadings (cutoff = 0.1):
##      Comp1  Comp2 
## m_4  -0.544  0.214
## m_5  -0.543       
## m_9  -0.537       
## m_8  -0.370 -0.530
## m_1  -0.459       
## m_2  -0.341 -0.150
## m_3  -0.428  0.284
## m_6  -0.490  0.332
## m_7  -0.391  0.240
## m_10 -0.483 -0.285
## m_11 -0.397  0.315
## m_12 -0.438       
## m_13 -0.401  0.332
## m_14 -0.385 -0.307
## m_15 -0.398 -0.418
## m_16 -0.487  0.119
## m_17 -0.452       
## m_18 -0.405 -0.170
## m_19 -0.464 -0.310
## 
## Importance (Variance Accounted For):
##                  Comp1   Comp2
## Eigenvalues     3.7900  1.3084
## VAF            19.9473  6.8861
## Cumulative VAF 19.9500 26.8300
plot(pca)

library(mirt)
library(knitr)
efa1 <- mirt(cevaplar, 1)
efa2 <- mirt(cevaplar, 2)
karsilastirma <- anova(efa1, efa2)
library(knitr)
kable(karsilastirma)
AIC SABIC HQ BIC logLik X2 df p
efa1 19839.03 19902.57 19909.25 20023.25 -9881.515 NA NA NA
efa2 19773.89 19867.52 19877.37 20045.38 -9830.943 101.1437 18 0

Son olarak EGA (Exploratory Graph Analysis) ile tek boyutluluk varsayımını test edelim.

library(EGAnet)
plot(EGA(cevaplar))

secilen_maddeler <- c("m_1", "m_2", "m_5", "m_7", "m_9", "m_12", "m_13", "m_18")
alt_veri <- cevaplar[, secilen_maddeler]
efa_alt <- mirt(alt_veri, 1)
efa_alt2 <- mirt(alt_veri, 2)
karsilastirma_alt <- anova(efa_alt, efa_alt2)
kable(karsilastirma_alt)
AIC SABIC HQ BIC logLik X2 df p
efa_alt 8322.464 8349.217 8352.030 8400.032 -4145.232 NA NA NA
efa_alt2 8311.341 8349.798 8353.843 8422.845 -4132.670 25.12301 7 0.0007216

TEK BOYUTLULUK VARSAYIMI ZORLANARAK SAĞLANMIŞTIR :)

Model Karşılaştırmaları

mod_1pl <- mirt(alt_veri, 1, itemtype = "Rasch")
mod_2pl <- mirt(alt_veri, 1, itemtype = "2PL")
mod_3pl <- mirt(alt_veri, 1, itemtype = "3PL")
kable(anova(mod_1pl, mod_2pl, mod_3pl))
AIC SABIC HQ BIC logLik X2 df p
mod_1pl 8331.542 8346.591 8348.173 8375.174 -4156.771 NA NA NA
mod_2pl 8322.464 8349.217 8352.030 8400.032 -4145.232 23.07826 7 0.0016519
mod_3pl 8327.186 8367.316 8371.536 8443.538 -4139.593 11.27787 8 0.1864463

Özetle, 2PL modeli istatistiksel olarak en iyi uyumu verirken, BIC açısından Rasch modeli daha uygun görünmektedir. Bu durumda, model seçimi analiz amacına göre belirlemek lazım. Eğer sadelik ve yorumlanabilirlik önemliyse Rasch modeli, model uyumu öncelikliyse 2PL modeli tercih edilebilir.

Ben Mimar Selim Bey’in yaşlı müşterisi gibi sadelikten yanayım, bu yüzden Rasch modelini tercih edeceğim :) Ancak, 2PL modelini de başka bir öğrenme günlüğünde mutlaka deneyeceğim.

Rasch Modeli

Maddelerin modele iyi uyum gösterip göstermediğini kontrol etmek için madde uyum analizi yapacağım.

mirt::itemfit(mod_1pl, method = "S-X2")
##   item   S_X2 df.S_X2 RMSEA.S_X2 p.S_X2
## 1  m_1  2.902       5      0.000  0.715
## 2  m_2  9.128       5      0.030  0.104
## 3  m_5  9.231       4      0.037  0.056
## 4  m_7  5.315       5      0.008  0.379
## 5  m_9 17.952       5      0.052  0.003
## 6 m_12  6.883       5      0.020  0.229
## 7 m_13  3.096       5      0.000  0.685
## 8 m_18  6.877       5      0.020  0.230

Madde Parametreleri

coef(mod_1pl, IRTpars = TRUE, simplify = TRUE)$items
##      a           b g u
## m_1  1 1.487268322 0 1
## m_2  1 1.868884040 0 1
## m_5  1 0.008435991 0 1
## m_7  1 1.222773149 0 1
## m_9  1 0.698691293 0 1
## m_12 1 1.818221874 0 1
## m_13 1 1.115032274 0 1
## m_18 1 0.834471919 0 1
library(knitr)
kable(coef(mod_1pl, IRTpars = TRUE, simplify = TRUE))
a b g u
m_1 1 1.4872683 0 1
m_2 1 1.8688840 0 1
m_5 1 0.0084360 0 1
m_7 1 1.2227731 0 1
m_9 1 0.6986913 0 1
m_12 1 1.8182219 0 1
m_13 1 1.1150323 0 1
m_18 1 0.8344719 0 1
x
F1 0
F1
F1 1.056476

Madde Karakteristik Eğrileri (ICC)

Madde karakteristik eğrilerini interaktif bir grafikle göstermek istiyorum.

library(plotly)
b_values <- c(
  m_1 = 1.5158,
  m_2 = 2.2711,
  m_5 = 0.0037,
  m_7 = 1.2453,
  m_9 = 0.7093,
  m_12 = 1.7531,
  m_13 = 1.2565,
  m_18 = 0.9515
)
theta <- seq(-4, 4, length.out = 500)

plot_data <- do.call(rbind, lapply(names(b_values), function(item) {
  prob <- 1 / (1 + exp(-(theta - b_values[item])))
  data.frame(theta = theta, probability = prob, item = item)
}))

plot_ly(data = plot_data, x = ~theta, y = ~probability, color = ~item, type = 'scatter', mode = 'lines') %>%
  layout(title = "Interaktif ICC Grafiği - Rasch Modeli",
         xaxis = list(title = "Yetenek (θ)"),
         yaxis = list(title = "Doğru Cevap Olasılığı"))

-> NOT: İnteraktif grafikte, sağ tarafta maddelerin üzerine tıklayarak eğrileri yok edip geri getirebilirsiniz. İki madde grafik üzerinden daha kolay yorumlanabiliyor.

Theta Kestirimi

theta_degerleri <- fscores(mod_1pl)
library(DT)
datatable(theta_degerleri, options = list(pageLength = 10))

Örneğin:

. -1.09 civarı değerler, düşük yetenek düzeyini,

. 0 civarındaki değerler, ortalama yetenek düzeyini,

. +2 ve üzeri değerler, yüksek yetenek düzeyini ifade eder.

Genel olarak, theta dağılımı dengeli görünmekte, bu da testin bireyleri ayırt etme gücünün yeterli olduğunu düşündürmektedir.

Madde ve Test Bilgi Fonksiyonları

Madde bilgi fonksiyonları, her bir maddenin yetenek düzeyine göre sağladığı bilginin miktarını gösterir. Test bilgi fonksiyonu ise tüm maddelerin bir araya gelerek sağladığı toplam bilgiyi ifade eder.

Madde bilgi fonksiyonlarını da interaktif bir grafikle göstermek istiyorum.

library(plotly)
theta <- seq(-4, 4, 0.1)
a <- 1
maddeler <- rownames(coef(mod_1pl, IRTpars = TRUE, simplify = TRUE)$items)
b_degerleri <- coef(mod_1pl, IRTpars = TRUE, simplify = TRUE)$items[, "b"]
p <- plot_ly()

for (i in seq_along(maddeler)) {
  b <- b_degerleri[i]
  bilgi <- a^2 * dnorm(theta) * (1 / (1 + exp(-(a * (theta - b))))^2)
  p <- add_trace(p, x = theta, y = bilgi, type = "scatter", mode = "lines", name = maddeler[i])
}

p <- layout(p,
            title = "Tüm Maddeler için Madde Bilgi Fonksiyonları",
            xaxis = list(title = "Theta"),
            yaxis = list(title = "Bilgi"))
p

Test bilgi fonksiyonunu da aynı şekilde interaktif bir grafikle göstermek istiyorum.

library(plotly)
theta <- seq(-4, 4, 0.1)
b_values <- coef(mod_1pl, IRTpars = TRUE, simplify = TRUE)$items[, "b"]
a <- 1

madde_bilgi_fonksiyonlari <- function(b, theta) {
  p <- 1 / (1 + exp(-a * (theta - b)))
  bilgi <- a^2 * p * (1 - p)
  return(bilgi)
}

test_bilgi <- sapply(theta, function(th) {
  sum(madde_bilgi_fonksiyonlari(b_values, th))
})

plot_ly(x = ~theta, y = ~test_bilgi, type = "scatter", mode = "lines") %>%
  layout(title = "Test Bilgi Fonksiyonu",
         xaxis = list(title = "Theta"),
         yaxis = list(title = "Bilgi (Information)"))

NOT: Başka bir günlükte eRm paketini de kullanacağım.

NOT2: Günlük yaklaşık 4 saat sürdü.