robustify tam- and person-parameter-estimates against single-case inputs

[thkiefer]

Hi Alex,

I'm screening https://stackoverflow.com for questions regarding TAM. I found this Stackoverflow-Question on how to compute person parameters for a single case (given existing item paramters).

The data are as follows

# Data with 1 candidate
data <- t(c(item1 = 1, item2 = 0, item3 = 1))
# Define a fixed difficulty matrix
difficulty_matrix <- cbind(1:ncol(data), c(1.5, 2.0, 1.0))

OP would want the following code not to terminate with an error

library(TAM)
tam(data, xsi.fixed = difficulty_matrix, verbose = FALSE)

(same with tam.mml and tam.mml.3pl). The Error in dimnames(A.draft) (within the designMatrices method) can be avoided by setting the argument item.elim = FALSE. However, further down the code there are two more instances where the code breaks if the input matrix has a single row.

The first stems from a call to sd on a single value which results in an NA that is passed to an if statement in line 8 in the file tam_mml_proc_unidim_simplify.R (called in line 245 in tam.mml.R). This can be fixed with an additional clause to the if statement

tam_mml_proc_unidim_simplify <- function(Y, A, G, beta.fixed)
{
    eps <- 1E-15
    YSD <- max( apply( Y, 2, stats::sd ) )
    if (nrow(Y) > 1 & YSD > eps ){
        YSD <- TRUE
    } else {
        YSD <- FALSE
    }
...

The next error occurs in tam_calc_counts.R (called in line 418 in tam.mml.R) where a call to crossprod throws an error since by indexing the matrices therein loose a dimension (and become vectors). That can be handled by setting the drop argument to FALSE like this.

## File Name: tam_calc_counts.R
## File Version: 9.13

#######################################################
# calculate counts
tam_calc_counts <- function( resp, theta, resp.ind,
    group, maxK, pweights, hwt )
{
    TP <- nrow(theta)
    I <- ncol(resp)
    if ( is.null( group )){
        group <- rep(1, nrow(resp))
    }
    G <- length( unique( group ))
    # n.ik [ 1:TP, 1:I, 1:(K+1), 1:G ]
    n.ik <- array( 0, dim=c(TP,I,maxK, G ))
    for (gg in 1:G){    # gg <- 1
        ind.gg <- which( group==gg )
        for (kk in 1:(maxK)){
            dkk2 <- ( resp[ ind.gg, ]==(kk-1) ) * resp.ind[ ind.gg, ] * pweights[ind.gg]
            # t( t(A) * B )=t(B) * A=crossprod(B,A)
            n.ik[,,kk,gg] <- crossprod( hwt[ind.gg,,drop = F], dkk2 )
        }
    }

    # calculate pi.k
    pi.k <- matrix( pweights, nrow=nrow(resp), ncol=ncol(hwt) )
    prob.theta <- matrix( NA, nrow=TP, ncol=G)
    for (gg in 1:G){
        # gg <- 1
        ind <- which( group==gg )
        pi.k1 <- colSums( pi.k[ind,,drop = F] * hwt[ind,,drop = F] ) / colSums( pi.k[ind,,drop = F] )
        prob.theta[,gg] <- pi.k1 / sum( pi.k1 )
    }
    res <- list( "n.ik"=n.ik, "pi.k"=prob.theta)
    return(res)
}
#####################################

tam.calc.counts <- tam_calc_counts
.tam.calc.counts <- tam_calc_counts

With these two fixes, we'll get an EAP.

md <- TAM::tam(data, xsi.fixed = difficulty_matrix, verbose = F, 
               item.elim = F, control = list(maxiter = 1))
md$person$EAP

However, tam.mml.wle2 also has an issue, where indexing reduces the dimensionality of an object in a crossprod call; specifically in line 41 in tam.mml.wle2.R can be fixed with setting drop = FALSE like this

cResp <- resp[, col.index, drop = FALSE  ]*resp.ind[, col.index, drop = FALSE ]

Best Wishes,
Tom