## File Name: marginal.truescore.reliability.R
## File Version: 0.171
marginal.truescore.reliability <- function( b, a=1+0*b, c=0*b, d=1+0*b,
mean.trait=0, sd.trait=1, theta.k=seq( -6, 6, len=200) )
{
TT <- length(theta.k)
I <- length(b)
phi.k <- sirt_dnorm_discrete( theta.k, mean=mean.trait, sd=sd.trait )
phi.kM <- matrix( phi.k, nrow=TT, ncol=I )
aM <- sirt_matrix2( a, nrow=TT)
bM <- sirt_matrix2( b, nrow=TT)
cM <- sirt_matrix2( c, nrow=TT)
dM <- sirt_matrix2( d, nrow=TT)
# item response functions
theta.kM <- matrix( theta.k, nrow=TT, ncol=I )
icc.theta <- cM + (dM-cM)* stats::plogis( aM*(theta.kM - bM ) )
# calculate pi_i (predicted probabilities)
pi.i <- colSums( icc.theta * phi.kM )
# expected number correct
mu <- sum(pi.i)
# compute error variance
sig2.error <- colSums( icc.theta * ( 1 - icc.theta ) * phi.k )
# compute total error variance
sig2.total.error <- sum( sig2.error )
# compute total true score variance
iccmean <- rowMeans( icc.theta )
sig2.total.tau <- sum( ( I*iccmean )^2 * phi.k ) - ( sum( I*iccmean*phi.k ) )^2
# item level true score variance
sig2.tau <- pi.i * ( 1 - pi.i ) - sig2.error
# collect all formulas for item
item <- data.frame( item=1:I, pi=pi.i, sig2.tau=sig2.tau, sig2.error=sig2.error )
item$rel.item <- item$sig2.tau / ( item$sig2.tau + item$sig2.error )
rel.test <- sig2.total.tau / ( sig2.total.tau + sig2.total.error )
cat('Reliability', '=', round( rel.test,3 ),'\n')
# Formula (15)
# sum( sqrt( outer( sig2.tau, sig2.tau ) ) )
res <- list(rel.test=rel.test, item=item, pi=mu/I, sig2.tau=sig2.total.tau,
sig2.error=sig2.total.error )
invisible(res)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.