Generating Tests of Particular Properties

# This post will demonstrate how to generate total test score distributions from a set of 50 items.

# It will build on a previous post (http://www.econometricsbysimulation.com/2012/09/simulating-3-parameter-irt-data.html) that demonstrated how to easily draw a matrix of 3 parameter univariate item responses given a vector of thetas.

# In order to run this code, first run the previous code in order for the command rirt3 to be defined.

# rirt takes a vector of thetas and vectors of the a,b, and c parameters and constructs a response matrix with rows equal to the number of test takers and columns equal to the number of items.

Item.Scores <- rirt3(theta=seq(-2,2,.1) ,a=c(1,.5,1,1,1),b=c(1,2,3,4,5),c=c(.15,.1,.2,.025,.1))
Total.Score <- apply(Item.Scores,1,sum)
hist(Total.Score, breaks=0:max(Total.Score), main="Total test score - 5 item test")

# Thus will create three rows for forty individuals with two items taken per individual.

# Let's look at a practical example.  Imagine we have 10000 test takers with ability drawn from a normal distribution.

theta = rnorm(10000)

# And we get to choose 50 items (or rather their parameters) to build a test from.

# We know on average about 95% of our sample falls within two standard deviations of the mean zero.

# First let's assume that we are restricted to items that have equal discriminatory power a=1 and equal guessing probability = .1.

# 1. Assignment one.  Build a test that has total scores that looks normally distributed.

# Since the underlying parameter distribution is normally distributed we should only need offer items that span the relevant range.

b=seq(-2.5,2.5, length.out=50)

Item.Scores <- rirt3(theta=theta ,a=2,b=b,c=.1)
Total.Score <- apply(Item.Scores,1,sum)
hist(Total.Score, breaks=0:max(Total.Score), main="Total test score - 50 item test")

plot(theta, Total.Score, main="Theta is an excellent predictor of total score")
# From the steady angle of this plot we can see at all levels this test does generally equally well at discriminating between different levels of theta.

# However, we may be interested less in how well average students perform and more in how well we can discriminate between top students who we would like to give scholarships to as well as bottom students which we would like to refer to remedial studies as necessary.

# 2. Assignment two.  Build a test that has more power to discriminate at the lower end and at the upper end of the ability distribution.

# In order to do this let us divide the students into three groups.  Low group and high group each get 20 questions while middle group instead gets 10 questions.  Low group starts as -3 and goest to -1.1, middle -1 to 1, and high 1.1 to 3.

b=c(seq(-3,-1.1,length.out=22), seq(-1,1,length.out=6), seq(1.1,3, length.out=22))

Item.Scores <- rirt3(theta=theta ,a=2,b=b,c=.1)
Total.Score <- apply(Item.Scores,1,sum)
hist(Total.Score, breaks=0:max(Total.Score), main="Total test score - 50 item test")

# It is not obvious that this is doing what we want it to be doing from the histogram.  This is because the middle most bins are now more crowded making all of the other bins look small.

plot(theta, Total.Score, main="Around the middle it is hard to tell between ability level")

# We can see from the plot that we have less movement in total scores around the mean ability level while high and low ability levels tend to be well discriminated.

# 3. Assignment three.  Construct a test in which most total scores greater than 10 and less than 40 are equally likely to occure.

# In order to do this we want to make sure parts of the theta distribution in which there are many students stacked also have a large number of questions causing spread within that group.

# We should be able to do this by using the inverse of the normal CDF.

b=qnorm(seq(.01,.99,length.out=50))

Item.Scores <- rirt3(theta=theta ,a=2,b=b,c=.1)
Total.Score <- apply(Item.Scores,1,sum)
hist(Total.Score, breaks=0:max(Total.Score), main="Total test score - 50 item test")

plot(theta, Total.Score, main="Detecting differences between students is equally distributed")

# It is not obvious from this plot because there are more thetas grouped in the middle where the plot is steepest.  If we rank the thetas on the other hand it becomes very clear.

plot(rank(theta), Total.Score, main="Detecting differences between students is equally distributed")

# Try ranking the thetas on the other plots.  You will find that the other plots will fatten out even more near the center of the plot.  That is because without stacking extra items near the center of the distribution of abilities it is hard to tell the difference between densely stacked students.