R/itemFit.R

In joakimwallmark/PolyOptimalIRT:

# Implements S-X^2
# Each item in data starts with 0
# probMatList is list of model probs with categories as rows and qpoints as cols
# density is vector with density values for each qpoint
# itemDF is vector of DF for each item
# mincell is minimum allowed cell value before collapse
itemFit <- function(data, probMatList, density, itemDF, items = 1:ncol(data), mincell = 1) {
    maxScore <- 0 # get max score of test
    for (item in items) {
        maxScore <- maxScore + nrow(probMatList[[item]][, ])-1
    }
    # Compute f(k|theta)
    totGivenTheta <- conditionalTotalScoreProbs(probMatList, thetas = density[, 1])

    oList <- list() # lists of O and E matrices for each item
    eList <- list()
    sX2List <- vector(mode = "numeric", length = ncol(data))
    df <- vector(mode = "numeric", length = ncol(data))
    for (item in items) {
        itemMax <- nrow(probMatList[[item]])-1
        # Compute f*(k|theta) (f(k|theta) without item)
        totMinusItemGivenTheta <- conditionalTotalScoreProbs(probMatList[-item], thetas = density[, 1])
        # total scores as rows and item scores(+1) as columns
        O <- matrix(0, nrow = maxScore-1, ncol = itemMax+1)
        E <- matrix(0, nrow = maxScore-1, ncol = itemMax+1)
        N <- vector(mode = "numeric", length = maxScore-1)
        C <- 0 # collapsed solumns
        for (totScore in 1:(maxScore-1)) {
            # compute integral denominator
            denom <- sum(totGivenTheta[totScore+1, ]*density[, 2])/sum(density[, 2])
            N[totScore] <- sum(rowSums(data)==totScore) # no of test takers with score = totScore
            scoreRows <- data[rowSums(data)==totScore, , drop = F]
            # only loop through item scores that can lead to totScore
            for (itemScore in max(itemMax-(maxScore-totScore), 0):min(itemMax, totScore)) {
                O[totScore, itemScore+1] <- sum(scoreRows[, item]==itemScore)/length(scoreRows[, item])
                # Compute integral numerator for given item score
                num <- sum(probMatList[[item]][itemScore+1, ]*
                               totMinusItemGivenTheta[totScore-itemScore+1, ]*
                               density[, 2])/sum(density[, 2])
                E[totScore, itemScore+1] <- num/denom
            }
        }
        colOnEn <- collapseItemScores(O*N, E*N, mincell = 1)
        On <- colOnEn$On
        En <- colOnEn$En
        # Paper: Ki * number of categories - m - C
        # df[item] <- (maxScore-2*itemMax+1)*itemMax - itemDF[item] - C
        # Mirt way: Cells-rows-parameters
        df[item] <- sum(!is.na(En)) - nrow(En) - itemDF[item]

        # sX2 func. doesn't work anymore after collapsed col
        # sX2List[item] <- sX2(O, E, N, maxScore, itemMax)
        # get S-X^2
        sX2List[item] <- sum((On - En)^2/En, na.rm = TRUE)
        oList[[item]] <- O
        eList[[item]] <- E
    }
    df[df < 0] <- 0
    pval <- pchisq(sX2List, df = df, lower.tail = F)

    return(list(SX2 = sX2List, p = pval, df = df, O = oList, E = eList))
}