Nothing
## File Name: tam.Q3.R
## File Version: 9.09
#############################################
# Q3 statistic based on weighted likelihood estimates
tam.Q3 <- function( tamobj, ... )
{
object <- tamobj
res1 <- IRT.residuals( object, ...)
resp_ind <- 1 - is.na( res1$residuals )
cp20 <- cp1 <- crossprod( resp_ind )
# calculate Q3
Q3.matr <- stats::cor( res1$residuals, use="pairwise.complete.obs" )
diag(Q3.matr) <- NA
aQ3.matr <- Q3.matr - mean( Q3.matr, na.rm=TRUE )
Q3_summary <- data.frame( "type"=c("Q3", "aQ3" ) )
diag(cp1) <- NA
cp1_sum <- sum( cp1, na.rm=TRUE )
Q3_summary[1,"M"] <- sum( Q3.matr * cp1, na.rm=TRUE ) / cp1_sum
Q3_summary[2,"M"] <- sum( aQ3.matr * cp1, na.rm=TRUE ) / cp1_sum
Q3_summary[1,"SD"] <- sum( Q3.matr^2 * cp1, na.rm=TRUE ) / cp1_sum
Q3_summary[2,"SD"] <- sum( aQ3.matr^2 * cp1, na.rm=TRUE ) / cp1_sum
Q3_summary$SD <- sqrt( Q3_summary$SD - Q3_summary$M^2 )
Q3_summary[1,"min"] <- min( Q3.matr, na.rm=TRUE )
Q3_summary[1,"max"] <- max( Q3.matr, na.rm=TRUE )
Q3_summary[2,"min"] <- min( aQ3.matr, na.rm=TRUE )
Q3_summary[2,"max"] <- max( aQ3.matr, na.rm=TRUE )
cp10 <- 1 - is.na(cp1)
cp10_sum <- sum( cp10, na.rm=TRUE )
Q3_summary[1,"SGDDM"] <- sum( abs(Q3.matr) * cp10, na.rm=TRUE ) / cp10_sum
Q3_summary[2,"SGDDM"] <- sum( abs(aQ3.matr) * cp10, na.rm=TRUE ) / cp10_sum
Q3_summary[1,"wSGDDM"] <- sum( abs(Q3.matr) * cp1, na.rm=TRUE ) / cp10_sum
Q3_summary[2,"wSGDDM"] <- sum( abs(aQ3.matr) * cp1, na.rm=TRUE ) / cp10_sum
#--- output
res <- list( Q3_summary=Q3_summary, Q3.matr=Q3.matr,
aQ3.matr=aQ3.matr, N_itempair=cp20, residuals=res1 )
class(res) <- "tam.Q3"
return(res)
}
#############################################
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.