01.06.2026_Son ders
SC
2026-06-02
Son ders :(
Rasch
p<- 1/(1+exp(-(thetha-b)))
-4, +4 arasındaki her bireyin p(tetha)’sı
Üretim için gerekli kodlar:
b<- rnorm (20, 0, 1)
hist(b)
madde_sayisi <- length (b)
theta <- rnorm (1000, 0, 1)
kisi_sayisi <- length (theta)
replikasyon <-100Her bir bireyin her bir maddeyi doğru cevaplama olasılığı Matris formatına getiriyorum. 1.satırda 20 maddenin parametreleri gibi 2.satırda 20 maddenin parametreleri gibi
bmat <- matrix(b, kisi_sayisi, madde_sayisi, byrow= TRUE)
head(bmat)## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [2,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [3,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [4,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [5,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [6,] 0.1340524 -0.9671755 0.1427374 -2.061358 -1.070876 -1.499264 -1.171894
## [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [2,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [3,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [4,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [5,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [6,] -0.7038612 -0.5042843 0.8545827 0.3620095 0.3268995 0.2155897 0.3079231
## [,15] [,16] [,17] [,18] [,19] [,20]
## [1,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912
## [2,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912
## [3,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912
## [4,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912
## [5,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912
## [6,] -1.535825 0.1966001 0.162348 1.332444 -1.197476 0.8230912thetamat<-matrix(theta, kisi_sayisi, madde_sayisi)
head(thetamat)## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353
## [2,] 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612
## [3,] 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562
## [4,] 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150
## [5,] -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851
## [6,] -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091
## [,7] [,8] [,9] [,10] [,11] [,12]
## [1,] -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353
## [2,] 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612
## [3,] 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562
## [4,] 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150
## [5,] -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851
## [6,] -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091
## [,13] [,14] [,15] [,16] [,17] [,18]
## [1,] -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353 -0.3891353
## [2,] 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612 0.2511612
## [3,] 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562 0.2085562
## [4,] 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150 0.1031150
## [5,] -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851 -1.1388851
## [6,] -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091 -1.5250091
## [,19] [,20]
## [1,] -0.3891353 -0.3891353
## [2,] 0.2511612 0.2511612
## [3,] 0.2085562 0.2085562
## [4,] 0.1031150 0.1031150
## [5,] -1.1388851 -1.1388851
## [6,] -1.5250091 -1.5250091getwd()## [1] "C:/Users/ibrahim/Desktop/OLC733"dir.create("Rasch")## Warning in dir.create("Rasch"): 'Rasch' zaten varp<- 1/(1+exp(-(thetha-b)))
for(i in 1:replikasyon){
logit <- thetamat - bmat
p <- 1/(1+exp(-logit))
rand <- matrix (runif(kisi_sayisi*madde_sayisi), nrow=kisi_sayisi, ncol=madde_sayisi)
res<-ifelse (p>rand, 1, 0)
write.table(res, file=paste("Rasch/rasch_rep", i, "txt", sep=""), sep=",",
row.names = FALSE, col.names = FALSE)
}b parametrelerini, theta (her satır bir maddeyi gösteriyor) parametrelerini oluşturduk. Replikasyon sayımızı belirledik. Vektörlerden matrise dönüştürdük. Klasör oluşturduk, 1pl modele göre kod yazdım. Random sayılar ürettin. Sonra comparation yaptım. Sonra da dosyaya yazması için write.table yazdık.
Aynı şeyi 2pl için yapmak istersek
2pl
p<- 1/(1+exp(-(a)*(thetha-b)))
set.seed(21)
a <- rlnorm (20, 10, 0.20)
b <- rnorm (20, 0, 1)
k <- length (a)
set.seed(41)
birey <- rnorm(400, 0, 1)
n <- length (birey) #nesneye atıyoruz
theta <- rep(birey, k)
aa <- rep(a, n)
bb <- rep(b, n)
p<- 1/(1+exp(-(aa)*(theta-bb)))
head(p)## [1] 0 1 1 1 1 0rr <- runif(n*k, 0, 1)
puan <- ifelse(p>rr, 1, 0)
puan <- matrix (puan, ncol=k)
#bunu bir fonksiyon haline getirelim
puan2pl <- function (madde, birey){
a <- madde [,1]
b <- madde [,2]
k <- length(a)
n <- length(b)
theta <- rep(birey, k)
aa <- rep(a,n)
bb <- rep(b,n)
p<- 1/(1+exp(-(aa)*(thetha-bb)))
rr <- runif(n*k, 0, 1)
puan <- ifelse(p>rr, 1, 0)
puan <- matrix(puan, ncol=k)
puan
}genelde 100 tekrar yeter. sim fonksiyonunun içini biz kendimiz yaptık. Elimizde matematiksel bir model olduğunda fonksiyon kullanabiliriz. Graded Response Model (Aşamalı Tepki Modeli), X kategorisinde veya X kategorisinin üstünde olma olasılığını hesaplıyoruz.
GRM c kategorisinde veya x kategorisinin üstünde
set.seed(26)
a <- rlnorm (8, 0, 0.20)
#kac kategorimiz varsa bir eksigi
b1 <- seq(from= -2.5, to=-0.75, by=0.25)
b2 <- b1 +1.25
b3 <- b2 +1.25
b4 <- b3 +1.25
cbind(b1, b2, b3, b4)## b1 b2 b3 b4
## [1,] -2.50 -1.25 0.00 1.25
## [2,] -2.25 -1.00 0.25 1.50
## [3,] -2.00 -0.75 0.50 1.75
## [4,] -1.75 -0.50 0.75 2.00
## [5,] -1.50 -0.25 1.00 2.25
## [6,] -1.25 0.00 1.25 2.50
## [7,] -1.00 0.25 1.50 2.75
## [8,] -0.75 0.50 1.75 3.00k <- length(a)
set.seed(46)
birey <- rnorm(400)
n <- length (birey)
aa <- rep(a,n)
bb1 <- rep(b1,n)
bb2 <- rep(b2,n)
bb3 <- rep(b3,n)
bb4 <- rep(b4,n)
p1<- 1/(1+exp(-(aa)*(theta-bb1)))## Warning in theta - bb1: uzun olan nesne uzunluğu kısa olan nesne uzunluğunun
## bir katı değil## Warning in -(aa) * (theta - bb1): uzun olan nesne uzunluğu kısa olan nesne
## uzunluğunun bir katı değilp2<- 1/(1+exp(-(aa)*(theta-bb2)))## Warning in theta - bb2: uzun olan nesne uzunluğu kısa olan nesne uzunluğunun
## bir katı değil## Warning in -(aa) * (theta - bb2): uzun olan nesne uzunluğu kısa olan nesne
## uzunluğunun bir katı değilp3<- 1/(1+exp(-(aa)*(theta-bb3)))## Warning in theta - bb3: uzun olan nesne uzunluğu kısa olan nesne uzunluğunun
## bir katı değil## Warning in -(aa) * (theta - bb3): uzun olan nesne uzunluğu kısa olan nesne
## uzunluğunun bir katı değilp4<- 1/(1+exp(-(aa)*(theta-bb4)))## Warning in theta - bb4: uzun olan nesne uzunluğu kısa olan nesne uzunluğunun
## bir katı değil## Warning in -(aa) * (theta - bb4): uzun olan nesne uzunluğu kısa olan nesne
## uzunluğunun bir katı değilpar <- cbind(p1, p2, p3, p4)
head(par)## p1 p2 p3 p4
## [1,] 0.7528762 0.5738532 0.3731255 0.2082918
## [2,] 0.9560107 0.8185025 0.4834176 0.1626091
## [3,] 0.9382987 0.8303823 0.6118072 0.3365941
## [4,] 0.9730101 0.8918998 0.6537712 0.3017497
## [5,] 0.9017110 0.7436024 0.4783067 0.2247089
## [6,] 0.8577022 0.6244732 0.3144972 0.1123525head(birey)## [1] -0.8989165 0.2121311 -0.7285901 1.2355204 1.1688400 -0.6224851rr <- runif(n*k, 0, 1)
head(rr)## [1] 0.3757090 0.4476721 0.7699587 0.7494361 0.9873121 0.9012236Rastgele değerler ile normal olasılık değerlerine bakıyoruz. Ve uygun kategoriye yerleştiriyoruz.
head(rr)## [1] 0.3757090 0.4476721 0.7699587 0.7494361 0.9873121 0.9012236rr[1]<-p1[1]
puan <-0
for (j in 1:(k*n)){
if(rr[j]>p1[j]) puan <-0
else if(rr[j]<p1[j] & rr[j]>p2[j]) puan <-1
else if(rr[j]<p2[j] & rr[j]>p3[j]) puan <-2
else if(rr[j]<p3[j] & rr[j]>p4[j]) puan <-3
else puan[j] <- 4
}
matrix(puan, ncol=k)## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 0 0 0 0 0 0 0 0Hesapladığımız olasılıklar: Her bir bireyin belirli bir kategoriye doğru cevap verme olasılığı
p4 daha zor, olasılık daha düşük random sayı ile kıyaslamam gerekiyor.
rastgele değer olasılık değerinden küçükse ve diğerinden büyükse o zaman bir eksi kategori olmuş oluyor.
Normal veriler bu kadar güzel ilerlemiyor.
Pegemden yayınlanan kitaptaki formüllere dayanarak başka bir modelle de kendimiz deneyebiliriz.
library(mirt) ?simdata Çok boyutlu, çok kategorili… Hazır datadan ürettikten sonra hataları hesaplamak vb.
Öğrenme Günlüğü
Bu ders hem veri üretip hem de fonksiyon yazarak Rasch, 2pl model uygulaması görmüş olduk. Tüm emekleriniz için teşekkür ederiz Kübra hocam. R’ı daha kolay ve anlaşılır hale getirdiniz ve pozitif bir tutum geliştirmemize yardımcı oldunuz. Artık üzerine bir şeyler katmak, tezimizde ve yayınlarımızda kullanmak ise işin bize düşen kısmı.