# Modified Bin and Union Method for Item Pool Design

October 28, 2013
By

(This article was first published on Econometrics by Simulation, and kindly contributed to R-bloggers)

`# Reckase (2003) proposes a method for designing an item pool for a computer# adaptive test that has been known as the bin and union method.  This method# involves drawing a subject from a distribution of abilities. Then selecting# the item that maximizes that subject's information from the possible set of # all items given a standard CAT proceedure. This is repeated until the test# reaches the predifined stopping point. # Then then next subject is drawn and a new set of items is drawn.  Items are# divided into bins such that there is a kind of rounding.  Items which are# sufficiently close to other items it terms of parameter fit are considered# the same item and the two sets are unionized together into a larger pool. # As more subjects are added more items are collected though at a decreasing# rate as fewer new items become neccessary. # In the original paper he uses a fixed length test though in a forthcoming # paper he and his student Wei He is also using a variable length test. # I have modified his proceedure slightly in this simulation.  Rather than# selecting optimal items for each subject based from the continuous pool# of possible items I have the test look within the already constructed pool# to see if any items are within bin length of the subject's estimated ability. # If there is no item then I add an item that perfectly matches the subject's# estimated ability. The reason I prefer this method is that I think it better# represents the process that a CAT test typically must go through with items# close to but rarely exactly at the level of the subjects. Thus the information# for each subject will be slightly less as a result of this modified method# relative to the original. # As with the new paper this simulation uses a variable length test. My stopping# rule is simple.  Once the test achieves a sufficiently high level of # information, then it stops. # I have constructed this simulation as one with three nested loops.# Over subjects within the item pool construction. # It simulates the item pool construction a number of times to get the# average number of items after each subject as well as a histogram# of average number of items required at each difficulty level. # I have also included a control for item exposure.  This control # dicatates that as the acceptable exposure rate is reduced, more items# will be required since some are too frequently exposed. # Overall this method is seems pretty great to me.  It allows for# item selection criteria, stopping rules, and exposure controls# to be easily modified to accomidate most any CAT design. require("catR") # Variable Length Test # The number of times to repeat the simulationnsim <- 10 # The number of subjects to simulatenpop <- 1000 # The maximum number of itemsmax.items <- 5000 # Maximum exposure rate of individual itemmax.exposure <- .2 # Stop the test when information reaches this levelmin.information <- 10 # How far away will the program reach for a new item (b-b_ideal)bin.width <- .25 expect.a <- 1 p <- function(theta, b) exp(theta-b)/(1+exp(theta-b))info <- function(theta, b, a=expect.a) p(theta,b)*(1-p(theta,b))*a^2 info(0,0) # The choose.item funciton takes an input thetahat and searches# available items to see if any already exist that can be used# otherwise it finds a new item.choose.item <- function(thetahat, item.b, items.unavailable, bin.width) {  # Construct a vector of indexes of available items  avail.n <- (1:length(item.b))   # Remove any already make unusuable  if (length(items.unavailable)>0)     avail.n <- (1:length(item.b))[-items.unavailable]   # If there are no items available then generate the next item  # equal to thetaest.  if (length(avail.n)==0)     return(c(next.b=thetahat, next.n=length(item.b)+1))   # Figure out how far each item is from thetahat  avail.dist <- abs(item.b[avail.n]-thetahat)   # Reorder the n's and dist in terms of proximity  avail.n <- avail.n[order(avail.dist)]  avail.dist <- sort(avail.dist)   # If the closest item is within the bin width return it  if (avail.dist[1]<bin.width)     return(c(next.b=item.b[avail.n[1]], next.n=avail.n[1]))  # Otherwise generate a new item  if (avail.dist[1]>=bin.width)     return(c(next.b=thetahat, next.n=length(item.b)+1))} # Define the simulation level vectors which will become matricesTnitems <- Ttest.length <- Titems.taken.N <- Titem.b<- NULL # Loop through the number of simulationsfor (j in 1:nsim) {    # Seems to be working well  choose.item(3, c(0,4,2,2,3.3), NULL, .5)   # This is the initial item pool  item.b <- 0   # This is the initial number of items taken  items.taken.N <- rep(0,max.items)   # A vector to record the individual test lengths   test.length <- NULL   # Number of total items after each individual  nitems <- NULL   # Draw theta from a population distribution  theta.pop <- rnorm(npop)   # Start the individual test  for (i in 1:npop) {    # The this person has a theta of:    theta0 <- theta.pop[i]     # Our initial guess at theta = 0    thetahat <- 0     print(paste("Subject:", i,"- Item Pool:", length(item.b)))    response <- items.taken <- NULL     # Remove any items that would have been overexposed    items.unavailable <- (1:length(item.b))[!(items.taken.N < max.exposure*npop)]     # The initial imformation on each subject is zero    infosum <- 0     # Loop through each subject    while(infosum < min.information) {       chooser <- choose.item(thetahat, item.b, items.unavailable, bin.width)       nextitem <- chooser[2]      nextb <- chooser[1]        names(nextitem) <- names(nextb) <- NULL       items.unavailable <- c(items.unavailable,nextitem)      item.b[nextitem] <- nextb       response <- c(response, runif(1)<p(theta0, nextb))       items.taken <- c(items.taken, nextitem)       it <- cbind(1, item.b[items.taken], 0,1)       thetahat <- thetaEst(it, response)       infosum <- infosum+info(theta0, nextb)    }     # Save individual values    nitems <- c(nitems, length(item.b))     test.length <- c(test.length, length(response))     items.taken.N[items.taken] <- items.taken.N[items.taken]+1  }   # Save into matrices the results of each simulation  Titem.b <- c(Titem.b, sort(item.b))  Tnitems <- cbind(Tnitems, nitems)  Ttest.length <- cbind(Ttest.length, test.length)  Titems.taken.N <- cbind(Titems.taken.N, items.taken.N) } plot(apply(Tnitems, 1, max), type="n",     xlab = "N subjects", ylab = "N items",     main = paste(nsim, "Different Simulations"))for (i in 1:nsim) lines(Tnitems[,i], col=grey(.3+.6*i/nsim)) `

`# We can see that the number of items is a function of the number of`
`# subjects taking the exam.  This relationship becomes relaxed`
`# when the number of subjects becomes large and the exposure controls`
`# are removed.`
`hist(Titem.b, breaks=30)`
` hist(Ttest.length, breaks=20)`

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...