Değişen Madde Fonksiyonu (DMF) Tespit Yöntemlerinin Karşılaştırılması
2025-12-25
Veri Simülasyonu
Simülasyon parametrelerinin belirlenmesi: 500 odak, 500 referans grup ve 30 madde.
set.seed(12345)
n_referans <- 500
n_odak <- 500
n_toplam <- n_referans + n_odak
n_madde <- 30
grup <- c(rep(0, n_odak), rep(1, n_referans))Yetenek parametrelerinin (theta) oluşturulması. Referans grubun ortalaması biraz daha yüksek.
theta_odak <- rnorm(n_odak, mean = 0, sd = 1)
theta_referans <- rnorm(n_referans, mean = 0.2, sd = 1)
theta <- c(theta_odak, theta_referans)Madde parametrelerinin (a ve b) oluşturulması.
DMF eklenmesi: Bazı maddelerde güçlük (b), bazılarında ayırt edicilik (a) farklılaştırılması.
b_param_referans <- b_param
b_param_referans[c(3, 7, 12)] <- b_param[c(3, 7, 12)] - 0.8
b_param_referans[c(18, 24)] <- b_param[c(18, 24)] + 0.8
a_param_referans <- a_param
a_param_referans[c(10, 20)] <- a_param[c(10, 20)] * 1.8
b_param_odak <- b_param
a_param_odak <- a_param2PL modeline göre yanıt matrisinin üretilmesi.
yanit_matrisi <- matrix(NA, nrow = n_toplam, ncol = n_madde)
for (i in 1:n_odak) {
for (j in 1:n_madde) {
prob <- 1 / (1 + exp(-a_param_odak[j] * (theta_odak[i] - b_param_odak[j])))
yanit_matrisi[i, j] <- rbinom(1, 1, prob)
}
}
for (i in 1:n_referans) {
for (j in 1:n_madde) {
prob <- 1 / (1 + exp(-a_param_referans[j] * (theta_referans[i] - b_param_referans[j])))
yanit_matrisi[n_odak + i, j] <- rbinom(1, 1, prob)
}
}
colnames(yanit_matrisi) <- paste0("madde", 1:n_madde)
veri_df <- data.frame(grup = grup, yanit_matrisi)Betimsel İstatistikler
## grup madde1 madde2 madde3 madde4 madde5 madde6 madde7 madde8 madde9 madde10
## 1 0 0 1 1 1 0 1 0 1 0 0
## 2 0 1 1 0 1 1 0 0 1 0 0
## 3 0 0 1 0 1 0 0 1 1 0 0
## 4 0 0 1 1 1 1 0 0 1 0 0
## 5 0 0 1 1 1 1 1 1 1 0 0
## 6 0 0 0 0 0 1 0 0 0 0 0
## 7 0 0 1 1 1 1 1 1 1 1 0
## 8 0 0 1 0 1 0 0 0 0 0 0
## 9 0 0 1 0 1 1 0 0 1 0 0
## 10 0 0 0 0 1 0 0 1 0 0 0
## madde11 madde12 madde13 madde14 madde15 madde16 madde17 madde18 madde19
## 1 0 1 1 1 1 1 1 0 0
## 2 1 1 1 0 1 1 1 0 1
## 3 0 0 1 0 1 1 1 0 0
## 4 0 0 1 0 1 1 0 0 0
## 5 0 1 1 0 1 1 1 0 0
## 6 0 0 1 0 0 0 0 0 0
## 7 0 1 1 0 1 1 1 0 1
## 8 0 1 1 0 1 1 0 0 0
## 9 1 0 1 0 1 1 1 0 0
## 10 1 0 1 0 0 0 0 0 0
## madde20 madde21 madde22 madde23 madde24 madde25 madde26 madde27 madde28
## 1 1 0 1 0 0 1 0 0 1
## 2 1 0 1 1 0 1 1 0 1
## 3 1 1 1 0 0 0 0 1 0
## 4 0 0 1 0 0 0 0 1 0
## 5 1 0 1 1 0 0 0 0 1
## 6 0 0 1 0 0 0 0 0 0
## 7 0 0 1 0 0 1 0 1 0
## 8 0 1 1 0 0 0 0 1 0
## 9 1 1 1 0 0 0 0 1 0
## 10 0 0 1 0 0 0 0 1 0
## madde29 madde30
## 1 1 0
## 2 1 1
## 3 1 1
## 4 1 1
## 5 1 1
## 6 0 0
## 7 1 0
## 8 1 0
## 9 1 1
## 10 0 0toplam_puan <- rowSums(yanit_matrisi)
print(c(
Odak_Grup_Sayisi = sum(grup == 0),
Referans_Grup_Sayisi = sum(grup == 1),
Odak_Grup_Ortalama_Puan = round(mean(toplam_puan[grup == 0]), 2),
Referans_Grup_Ortalama_Puan = round(mean(toplam_puan[grup == 1]), 2)
))## Odak_Grup_Sayisi Referans_Grup_Sayisi
## 500.00 500.00
## Odak_Grup_Ortalama_Puan Referans_Grup_Ortalama_Puan
## 15.69 16.62Mantel-Haenszel Yöntemi
mh_sonuc <- difMH(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
purify = TRUE,
p.adjust.method = "BH"
)
print(mh_sonuc$MH)## [1] 1.002702865 1.707094370 53.487490217 5.750117497 1.501363972
## [6] 0.151000422 28.710748678 0.179608749 0.100266928 6.039106014
## [11] 1.265798087 38.410630639 0.006214052 0.767371378 0.167965871
## [16] 0.005936615 0.610622164 26.585085532 1.525738474 0.053532488
## [21] 3.528648486 0.437844874 0.110318853 57.426144186 0.484630865
## [26] 1.243480599 1.916796692 6.608156026 0.022626530 0.740749423## [1] 3 7 12 18 24Lojistik Regresyon Yöntemi
Üç farklı DMF tipi için analiz: uniform, non-uniform ve her ikisi birlikte.
lr_uniform <- difLogistic(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
type = "udif",
purify = TRUE,
p.adjust.method = "BH"
)
lr_nonuniform <- difLogistic(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
type = "nudif",
purify = TRUE,
p.adjust.method = "BH"
)
lr_both <- difLogistic(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
type = "both",
purify = TRUE,
p.adjust.method = "BH"
)
print(lr_uniform$DIFitems)## [1] 3 7 12 18 24 28## [1] 7 10## [1] 3 7 10 12 18 24SIBTEST Yöntemi
Uniform ve crossing (non-uniform) DMF tespiti.
sibtest_uniform <- difSIBTEST(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
type = "udif",
purify = TRUE,
p.adjust.method = "BH"
)
sibtest_crossing <- difSIBTEST(
Data = yanit_matrisi,
group = grup,
focal.name = 0,
type = "nudif",
purify = TRUE,
p.adjust.method = "BH"
)
print(sibtest_uniform$DIFitems)## [1] 3 7 12 18 24## [1] 3 7 12 18 24Yöntemlerin Karşılaştırılması
Tüm yöntemlerin tespit ettiği DMF’li maddelerin bir tabloda gösterilmesi.
dmf_mh <- if (length(mh_sonuc$DIFitems) > 0) paste0("madde", mh_sonuc$DIFitems) else character(0)
dmf_lr_uniform <- if (length(lr_uniform$DIFitems) > 0) paste0("madde", lr_uniform$DIFitems) else character(0)
dmf_lr_nonuniform <- if (length(lr_nonuniform$DIFitems) > 0) paste0("madde", lr_nonuniform$DIFitems) else character(0)
dmf_lr_both <- if (length(lr_both$DIFitems) > 0) paste0("madde", lr_both$DIFitems) else character(0)
dmf_sibtest_uniform <- if (length(sibtest_uniform$DIFitems) > 0) paste0("madde", sibtest_uniform$DIFitems) else character(0)
dmf_sibtest_crossing <- if (length(sibtest_crossing$DIFitems) > 0) paste0("madde", sibtest_crossing$DIFitems) else character(0)
tum_maddeler <- paste0("madde", 1:n_madde)
karsilastirma <- data.frame(
Madde = tum_maddeler,
MH = ifelse(tum_maddeler %in% dmf_mh, "DMF", "-"),
LR_Uniform = ifelse(tum_maddeler %in% dmf_lr_uniform, "DMF", "-"),
LR_NonUniform = ifelse(tum_maddeler %in% dmf_lr_nonuniform, "DMF", "-"),
LR_Both = ifelse(tum_maddeler %in% dmf_lr_both, "DMF", "-"),
SIBTEST_Uniform = ifelse(tum_maddeler %in% dmf_sibtest_uniform, "DMF", "-"),
SIBTEST_Crossing = ifelse(tum_maddeler %in% dmf_sibtest_crossing, "DMF", "-"),
Gercek_DMF = ifelse(tum_maddeler %in% c("madde3", "madde7", "madde10", "madde12", "madde18", "madde20", "madde24"), "DMF", "-")
)
print(karsilastirma)## Madde MH LR_Uniform LR_NonUniform LR_Both SIBTEST_Uniform
## 1 madde1 - - - - -
## 2 madde2 - - - - -
## 3 madde3 DMF DMF - DMF DMF
## 4 madde4 - - - - -
## 5 madde5 - - - - -
## 6 madde6 - - - - -
## 7 madde7 DMF DMF DMF DMF DMF
## 8 madde8 - - - - -
## 9 madde9 - - - - -
## 10 madde10 - - DMF DMF -
## 11 madde11 - - - - -
## 12 madde12 DMF DMF - DMF DMF
## 13 madde13 - - - - -
## 14 madde14 - - - - -
## 15 madde15 - - - - -
## 16 madde16 - - - - -
## 17 madde17 - - - - -
## 18 madde18 DMF DMF - DMF DMF
## 19 madde19 - - - - -
## 20 madde20 - - - - -
## 21 madde21 - - - - -
## 22 madde22 - - - - -
## 23 madde23 - - - - -
## 24 madde24 DMF DMF - DMF DMF
## 25 madde25 - - - - -
## 26 madde26 - - - - -
## 27 madde27 - - - - -
## 28 madde28 - DMF - - -
## 29 madde29 - - - - -
## 30 madde30 - - - - -
## SIBTEST_Crossing Gercek_DMF
## 1 - -
## 2 - -
## 3 DMF DMF
## 4 - -
## 5 - -
## 6 - -
## 7 DMF DMF
## 8 - -
## 9 - -
## 10 - DMF
## 11 - -
## 12 DMF DMF
## 13 - -
## 14 - -
## 15 - -
## 16 - -
## 17 - -
## 18 DMF DMF
## 19 - -
## 20 - DMF
## 21 - -
## 22 - -
## 23 - -
## 24 DMF DMF
## 25 - -
## 26 - -
## 27 - -
## 28 - -
## 29 - -
## 30 - -Performans Değerlendirmesi
Duyarlılık, özgüllük, kesinlik ve F1 skorlarının hesaplanması.
gercek_dmf <- c("madde3", "madde7", "madde10", "madde12", "madde18", "madde20", "madde24")
hesapla_performans <- function(tespit_edilen, gercek) {
tp <- sum(tespit_edilen %in% gercek)
fp <- sum(!(tespit_edilen %in% gercek))
fn <- sum(!(gercek %in% tespit_edilen))
tn <- n_madde - tp - fp - fn
duyarlilik <- if (tp + fn > 0) tp / (tp + fn) else 0
ozgulluk <- if (tn + fp > 0) tn / (tn + fp) else 0
kesinlik <- if (tp + fp > 0) tp / (tp + fp) else 0
f1_skor <- if (kesinlik + duyarlilik > 0) 2 * (kesinlik * duyarlilik) / (kesinlik + duyarlilik) else 0
c(
TP = tp, FP = fp, FN = fn, TN = tn,
Duyarlilik = round(duyarlilik, 3),
Ozgulluk = round(ozgulluk, 3),
Kesinlik = round(kesinlik, 3),
F1_Skor = round(f1_skor, 3)
)
}
performans_mh <- hesapla_performans(dmf_mh, gercek_dmf)
performans_lr_uniform <- hesapla_performans(dmf_lr_uniform, gercek_dmf)
performans_lr_nonuniform <- hesapla_performans(dmf_lr_nonuniform, gercek_dmf)
performans_lr_both <- hesapla_performans(dmf_lr_both, gercek_dmf)
performans_sibtest_uniform <- hesapla_performans(dmf_sibtest_uniform, gercek_dmf)
performans_sibtest_crossing <- hesapla_performans(dmf_sibtest_crossing, gercek_dmf)
performans_tablo <- data.frame(
Yontem = c("MH", "LR_Uniform", "LR_NonUniform", "LR_Both", "SIBTEST_Uniform", "SIBTEST_Crossing"),
rbind(
performans_mh,
performans_lr_uniform,
performans_lr_nonuniform,
performans_lr_both,
performans_sibtest_uniform,
performans_sibtest_crossing
)
)
print(performans_tablo)## Yontem TP FP FN TN Duyarlilik Ozgulluk
## performans_mh MH 5 0 2 23 0.714 1.000
## performans_lr_uniform LR_Uniform 5 1 2 22 0.714 0.957
## performans_lr_nonuniform LR_NonUniform 2 0 5 23 0.286 1.000
## performans_lr_both LR_Both 6 0 1 23 0.857 1.000
## performans_sibtest_uniform SIBTEST_Uniform 5 0 2 23 0.714 1.000
## performans_sibtest_crossing SIBTEST_Crossing 5 0 2 23 0.714 1.000
## Kesinlik F1_Skor
## performans_mh 1.000 0.833
## performans_lr_uniform 0.833 0.769
## performans_lr_nonuniform 1.000 0.444
## performans_lr_both 1.000 0.923
## performans_sibtest_uniform 1.000 0.833
## performans_sibtest_crossing 1.000 0.833Görselleştirme
DMF Tespit Sayıları
par(mar = c(5, 5, 4, 2))
barplot(
c(
length(dmf_mh), length(dmf_lr_uniform), length(dmf_lr_nonuniform),
length(dmf_lr_both), length(dmf_sibtest_uniform), length(dmf_sibtest_crossing)
),
names.arg = c("MH", "LR\nUniform", "LR\nNonUniform", "LR\nBoth", "SIBTEST\nUniform", "SIBTEST\nCrossing"),
main = "Yöntemlere Göre Tespit Edilen DMF Sayısı",
ylab = "DMF Gösteren Madde Sayısı",
col = c("#E74C3C", "#3498DB", "#2ECC71", "#F39C12", "#9B59B6", "#1ABC9C"),
ylim = c(
0,
max(
length(dmf_mh), length(dmf_lr_uniform), length(dmf_lr_nonuniform),
length(dmf_lr_both), length(dmf_sibtest_uniform), length(dmf_sibtest_crossing)
) + 2
)
)
abline(h = length(gercek_dmf), col = "red", lwd = 2, lty = 2)
legend("topright", legend = c("Gerçek DMF Sayısı"), col = "red", lty = 2, lwd = 2)
F1 Skorları
par(mar = c(5, 5, 4, 2))
barplot(
performans_tablo$F1_Skor,
names.arg = performans_tablo$Yontem,
main = "Yöntemlerin F1 Skorları",
ylab = "F1 Skoru",
col = c("#E74C3C", "#3498DB", "#2ECC71", "#F39C12", "#9B59B6", "#1ABC9C"),
ylim = c(0, 1)
)
Duyarlılık ve Özgüllük
par(mfrow = c(1, 2), mar = c(5, 5, 4, 2))
barplot(
performans_tablo$Duyarlilik,
names.arg = performans_tablo$Yontem,
main = "Yöntemlerin Duyarlılığı (Sensitivity)",
ylab = "Duyarlılık",
col = "#3498DB",
ylim = c(0, 1),
las = 2
)
barplot(
performans_tablo$Ozgulluk,
names.arg = performans_tablo$Yontem,
main = "Yöntemlerin Özgüllüğü (Specificity)",
ylab = "Özgüllük",
col = "#2ECC71",
ylim = c(0, 1),
las = 2
)