mirtCAT: estimation theta with using prior distribution

10 views
Skip to first unread message

Youngjin Kim

unread,
Jun 6, 2024, 1:57:21 PM (13 days ago) Jun 6
to mirt-package

Dear Phil and all,

I'm working on integrating prior information about a tester into a CAT system.

I believe that using custom_den and customUpdate_Thetas to (1) specify the prior distribution of the tester as N(0, 1) and estimate the EAP(corresponds to 'test1' in the attached R), and (2) estimating without specifying the prior distribution(corresponds to 'test2' in the attached R), should give the same result. This is because the latter method assumes that the tester follows a standard normal distribution by default. However, as shown in the attached R file, the RMSE of the two results differs. If you check the log of the estimated theta, it appears that the estimation methods are different.

If you have any good ideas on this issue, please let me know.

Thanks.

Also, I'm new to using this feature of Google, so I don't know if I'm communicating properly. Please bear with me.
----------------------------------------------------------------------------------------------------
If the file does not open, please refer to the code below.  


library(mirtCAT)
library(truncnorm)
library(tictoc)
library(SimDesign)


true_theta_temp <- matrix(rnorm(100, 0, 1))
reg_theta_temp <- true_theta_temp + runif(100, -0.5, 0.5)
RMSE(true_theta_temp, reg_theta_temp)

n_person <- nrow(true_theta_temp)
n_items <- 300
itemnames <- paste0("Item.", 1:n_items)


# Item parameter
a <- matrix(rlnorm(n_items, 0.3, 0.1), n_items)
b <- rtruncnorm(n_items, a=-4, b=4, mean = 0, sd = 1)
d <- -a * b
pars <- data.frame(a1 = a, d = d)


# Fit model
mod <- generate.mirt_object(pars, '2PL')
pat <- generate_pattern(mo = mod, Theta = true_theta_temp)



## Prior distribution ##
# Custom
custom_den <- function(Theta, prior_mean, ...){
  dnorm(Theta, mean = prior_mean, sd = prior_sd)
}

customUpdate_Thetas <- function(design, person, test){
  mo  <- extract.mirtCAT(test, 'mo')
  responses <- extract.mirtCAT(person, 'responses')
 
  # Person specific means
  pp <- extract.mirtCAT(design, 'person_properties')
  ID <- extract.mirtCAT(person, "ID")
  prior_mean <- pp[ID,]
 
  # Estimate theta using prior custom density  
  tmp         <- fscores(mo, response.pattern = responses,
                         custom_den = custom_den,
                         prior_mean = prior_mean,
                         prior_sd = prior_sd,
                         method = 'EAP')
 
  # Update theta estimate and SE
  person$Update_thetas(tmp[,'F1'],
                       tmp[,'SE_F1', drop=FALSE])
  invisible()
}



start_item_list <- sapply(reg_theta_temp, function(x) which.min(abs(b - x)))

# EAP with N(0, 1) specify
person_prior <- data.frame(prior_mean = cbind(rep(0, n_person)))
theta_start_base <- matrix(person_prior$prior_mean,
                           nrow = n_person, ncol = 1)
prior_sd <- 1

test1 <- mirtCAT(mo = mod, method = 'EAP',
                 criteria = 'MI',
                 start_item = start_item_list,  
                 local_pattern = pat,
                 design = list(min_SEM = 0.0001,
                               max_items = 10,
                               thetas.start = theta_start_base,
                               customUpdateThetas = customUpdate_Thetas,
                               person_properties = person_prior))

# EAP with default
test2 <- mirtCAT(mo = mod, method = 'EAP',
                 criteria = 'MI',
                 start_item = start_item_list,  
                 local_pattern = pat,
                 design = list(min_SEM = 0.0001,
                               max_items = 10))


# EAP with empirical priors
person_prior <- data.frame(prior_mean = cbind(reg_theta_temp))
theta_start_base <- matrix(person_prior$prior_mean,
                           nrow = n_person, ncol = 1)
prior_sd <- sd(reg_theta_temp)
test3 <- mirtCAT(mo = mod, method = 'EAP',
                 criteria = 'MI',
                 start_item = start_item_list,  
                 local_pattern = pat,
                 design = list(min_SEM = 0.0001,
                               max_items = 10,
                               thetas.start = theta_start_base,
                               customUpdateThetas = customUpdate_Thetas,
                               person_properties = person_prior))

result1 <- round(RMSE(true_theta_temp, sapply(1:100, function(i) test1[[i]][["thetas"]])), 3)
result2 <- round(RMSE(true_theta_temp, sapply(1:100, function(i) test2[[i]][["thetas"]])), 3)
result3 <- round(RMSE(true_theta_temp, sapply(1:100, function(i) test3[[i]][["thetas"]])), 3)

mirtCAT help.R
Reply all
Reply to author
Forward
0 new messages