R/noharm_sirt_optim_gradient_R_der_gamma_item.R

Defines functions noharm_sirt_optim_gradient_R_der_gamma_item

## File Name: noharm_sirt_optim_gradient_R_der_gamma_item.R
## File Version: 0.05


noharm_sirt_optim_gradient_R_der_gamma_item <- function(parm_table_free, Fmat,
    Pmat, FP, npar, NH, I)
{
    grad_gamma_diag <- matrix(0, nrow=I, ncol=npar)
    grad_gamma_diag_bool <- matrix(FALSE, nrow=I, ncol=npar)
    for (iii in 1:I){
        grad <- rep(0,npar)
        grad_bool <- rep(FALSE,npar)
        for (hh in 1:NH){
            mat_hh <- parm_table_free[hh,"mat"]
            par_index_hh <- parm_table_free[hh,"index"]
            row <- parm_table_free[hh,"row"]
            col <- parm_table_free[hh,"col"]
            # F
            if (mat_hh=="F"){
                if (row==iii){
                    der <- 2*FP[iii,col]
                    grad[par_index_hh] <- grad[par_index_hh] + der
                    grad_bool[par_index_hh] <- TRUE
                }
            }
            # P
            if (mat_hh=="P"){
                der <- 0
                if (row==col){
                    der <- Fmat[iii,col]^2
                    grad[par_index_hh] <- grad[par_index_hh] + der
                } else {
                    der <- Fmat[iii,row]*Fmat[iii,col]
                    grad[par_index_hh] <- grad[par_index_hh] + der
                }
                if (der!=0){ grad_bool[par_index_hh] <- TRUE }
            }
        }
        grad_gamma_diag[iii,] <- grad
        grad_gamma_diag_bool[iii,] <- grad_bool
    }

    #-- output
    res <- list(grad_gamma_diag=grad_gamma_diag, grad_gamma_diag_bool=grad_gamma_diag_bool)
    return(res)
}
alexanderrobitzsch/sirt documentation built on March 18, 2024, 1:29 p.m.