library(GDINA)## GDINA Package [Version 2.7.8; 2020-01-15]
## More information: https://wenchao-ma.github.io/GDINAWhen a test measures K=10 attributes, how many parameters do you have in the (1) saturated joint attribute distribution, (2) independent model, (3) 2PL higher-order model and (4) a linear structure model ( A1→A2→…→A10).
Find these quantities for item 1.
Q <- matrix(c(1,0,
1,0,
0,1,
0,1,
1,1),ncol = 2,byrow = TRUE)
Q## [,1] [,2]
## [1,] 1 0
## [2,] 1 0
## [3,] 0 1
## [4,] 0 1
## [5,] 1 1 y <- matrix(c( 1,0,1,0,1,
0,1,1,0,0,
0,0,1,1,1,
1,1,0,1,0,
1,0,0,0,1,
0,0,1,0,1,
0,1,1,0,0,
0,1,1,1,1,
1,1,0,1,0,
1,0,1,0,1),ncol = 5,byrow = TRUE)
y## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 0 1 0 1
## [2,] 0 1 1 0 0
## [3,] 0 0 1 1 1
## [4,] 1 1 0 1 0
## [5,] 1 0 0 0 1
## [6,] 0 0 1 0 1
## [7,] 0 1 1 0 0
## [8,] 0 1 1 1 1
## [9,] 1 1 0 1 0
## [10,] 1 0 1 0 1p.y.given.alpha <- matrix(c(0.1,0.8,0.1,0.8,
0.1,0.8,0.1,0.8,
0.1,0.1,0.8,0.8,
0.1,0.1,0.8,0.8,
0.1,0.1,0.1,0.8),ncol = 4,byrow = TRUE)
p.y.given.alpha #The probability of each possible attribute profile for each item## [,1] [,2] [,3] [,4]
## [1,] 0.1 0.8 0.1 0.8
## [2,] 0.1 0.8 0.1 0.8
## [3,] 0.1 0.1 0.8 0.8
## [4,] 0.1 0.1 0.8 0.8
## [5,] 0.1 0.1 0.1 0.8Li.given.alpha.c <- matrix(NA,nrow = 10,ncol = 4)
for(i in 1:10){#for each student
for(cc in 1:4){# for each latent class
Li.given.alpha.c[i,cc] <- prod( (p.y.given.alpha[,cc] ^ y[i,] ) * (1-p.y.given.alpha[,cc]) ^ (1 - y[i,]))
}
}
colnames(Li.given.alpha.c) <- c("00","10","01","11")
rownames(Li.given.alpha.c) <- paste("student",1:10)
Li.given.alpha.c## 00 10 01 11
## student 1 0.00081 0.00144 0.00144 0.02048
## student 2 0.00729 0.01296 0.01296 0.00512
## student 3 0.00081 0.00004 0.05184 0.02048
## student 4 0.00081 0.05184 0.00144 0.02048
## student 5 0.00729 0.01296 0.00036 0.00512
## student 6 0.00729 0.00036 0.01296 0.00512
## student 7 0.00729 0.01296 0.01296 0.00512
## student 8 0.00009 0.00016 0.00576 0.08192
## student 9 0.00081 0.05184 0.00144 0.02048
## student 10 0.00081 0.00144 0.00144 0.020480.00729/6+0.01296/6+0.01296/3+0.00512/3## [1] 0.009401667P.alphac.given.yi <- matrix(NA,nrow = 10,ncol = 4)
p.alphac <- c(1/6,1/6,1/3,1/3)
for(i in 1:10){
p.yi <- sum(Li.given.alpha.c[i,] * p.alphac)
P.alphac.given.yi[i,] <- Li.given.alpha.c[i,] * p.alphac / p.yi
}
colnames(P.alphac.given.yi) <- c("00","10","01","11")
rownames(P.alphac.given.yi) <- paste("student",1:10)
P.alphac.given.yi## 00 10 01 11
## student 1 0.0175743111 0.0312432198 0.06248644 0.8886960
## student 2 0.1292324056 0.2297464988 0.45949300 0.1815281
## student 3 0.0055673929 0.0002749330 0.71262630 0.2815314
## student 4 0.0083946523 0.5372577469 0.02984765 0.4244999
## student 5 0.2335789811 0.4152515219 0.02306953 0.3281000
## student 6 0.1664003652 0.0082173020 0.59164574 0.2337366
## student 7 0.1292324056 0.2297464988 0.45949300 0.1815281
## student 8 0.0005124993 0.0009111098 0.06559991 0.9329765
## student 9 0.0083946523 0.5372577469 0.02984765 0.4244999
## student 10 0.0175743111 0.0312432198 0.06248644 0.8886960Nj0 <- sum(P.alphac.given.yi[,1] + P.alphac.given.yi[,3])
Nj1 <- sum(P.alphac.given.yi[,2] + P.alphac.given.yi[,4])
Rj0 <- sum(y[,1]*(P.alphac.given.yi[,1] + P.alphac.given.yi[,3]))
Rj1 <- sum(y[,1]*(P.alphac.given.yi[,2] + P.alphac.given.yi[,4]))
Nj0## [1] 3.213058Nj1## [1] 6.786942Rj0## [1] 0.4932546Rj1## [1] 4.506745Find the estimated guessing and slip parameters for item 1.
g1 <- Rj0/Nj0
g1## [1] 0.1535156s1 <- 1-Rj1/Nj1
s1## [1] 0.3359682Write R code to estimate item parameters of the DINA model.
exercise <- GDINA(dat = y, Q = Q, model = "DINA",verbose = 0)
coef(exercise, withSE = TRUE)## $`Item 1`
## P(0) P(1)
## Est. 0.0001 0.9999
## S.E. 0.3433 0.3361
##
## $`Item 2`
## P(0) P(1)
## Est. 0.6000 0.4000
## S.E. 0.3378 0.2873
##
## $`Item 3`
## P(0) P(1)
## Est. 0.0001 0.9999
## S.E. 0.3032 0.2451
##
## $`Item 4`
## P(0) P(1)
## Est. 0.6667 0.2857
## S.E. 0.2740 0.2886
##
## $`Item 5`
## P(00) P(10) P(01) P(11)
## Est. 0.5000 0.5000 0.5000 0.9999
## S.E. 0.4735 0.4735 0.4735 0.2044