Nothing
###############################################################################
# Qrefine: #
# #
# Refine the Q-matrix by minimizing the RSS. We estimate memberships using the#
# non-parametric classification method (weighted hamming). #
# #
# Inputs: #
# (1) Y: a matrix of binary responses (1=correct, 0=incorrect). Rows #
# represent persons and columns represent items. #
# (2) Q: the Q-matrix of the test. Rows represent items and columns represent #
# attributes. #
# (3) gate: "AND", the examinee needs to possess all related attributes #
# in order to answer an item correctly #
# "OR", the examinee needs to possess only one of the related #
# attributes in order to answer an item correctly #
# (4) max.ite: the iteration to run until all RSS of all items are stationay. #
# #
# Definitions of variables/matrices: #
# RSS: the vector collecting the item and overall RSSs acorss all iterations #
# max.rss.item: the item with largest RSS #
# update.q: the q-vector chosen to replace the old q-vector #
# #
# Outputs: #
# (1) initial.class: initial classification #
# (2) terminal.class: terminal classification #
# (3) modified.Q: the modified Q-matrix #
# (4) modified.entries: the modified q-entries #
# #
###############################################################################
Qrefine <- function(Y, Q, gate=c("AND", "OR"), max.ite=50)
{
gate <- match.arg(gate)
Y <- as.matrix(Y)
Q <- as.matrix(Q)
initial.Q <- Q
nitem <- dim(Q)[1]
natt <- dim(Q)[2]
M <- 2 ^ natt
index <- NULL
RSS <- NULL
pattern <- AlphaPermute(natt)
pattern.Q <- pattern[-1,]
# We may need to run the searching a couple of times until all RSS of all items are stationay.
for (m in 1:max.ite)
{
cat(paste("Iteration:", m))
cat("\n")
max.rss.item <- NULL
for (k in 1:nitem)
{
classification <- AlphaNP(Y, Q, gate, method="Hamming")
est.class <- classification$est.class
est.ideal <- classification$est.ideal
# Record the initial classification
if (m==1 & k==1) initial.class <- est.class
# Update Q by minimizing RSS
diff <- Y - est.ideal
rss <- apply(diff ^ 2, 2, sum)
RSS <- rbind(RSS, c(rss, sum(rss)))
# Start the algorithm with the item of largest RSS. Each item is visited only once.
max.rss <- {if (k == 1) which(rss == max(rss)) else which(rss == max(rss[-max.rss.item]))}
if (length(max.rss) > 1) max.rss <- sample(max.rss, 1)
max.rss.item <- c(max.rss.item, max.rss)
# Find the q-vector among the 2^K possible vectors that the corresponding ideal responses yield
# minimal RSS with data of item of max RSS.
update.rss <- NULL
for (i in 1:(M - 1))
{
u <- apply(t(pattern[est.class, ]) ^ pattern.Q[i, ], 2, prod)
temp.rss <- sum((Y[, max.rss] - u) ^ 2)
update.rss <- c(update.rss, temp.rss)
}
min.update.rss <- which(update.rss == min(update.rss))
if (length(min.update.rss) > 1) min.update.rss <- sample(min.update.rss, 1)
update.q <- pattern.Q[min.update.rss, ]
Q[max.rss, ] <- update.q
}
# Stopping criterion: if all of the RSSs between two iterations are identical (which means
# it's not possible to improve), break the loop.
if (sum(abs(RSS[((m - 1) * nitem + 1):(m * nitem), nitem + 1] - rep(RSS[((m - 1) * nitem + 1), nitem + 1], nitem))) == 0) break else m <- m + 1
}
# Record the terminal classification
terminal.class <- est.class
# Report the modified entries
if (sum((Q - initial.Q) ^ 2) == 0) modified <- "NA" else
{
modified <- which((Q - initial.Q) != 0, arr.ind=TRUE)
colnames(modified) <- c("Item", "Attribute")
}
output <- list(modified.Q=Q, modified.entries=modified, initial.class=initial.class, terminal.class=terminal.class, patterns=pattern, initial.Q=initial.Q, Y=Y, gate=gate)
class(output) <- "Qrefine"
return(output)
}
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.