# The Polytomous Rasch Model (prm) allows for items to receive credit or value that is polytomous (more values than just full credit or no credit).
# The prm is related to the generalized graded response model discussed in a previous post (http://www.econometricsbysimulation.com/2012/10/generalized-graded-response-data.html).
# The prm category characteristic curve is given by: P(x=k) = exp(sum{v=1 to k} D*a_i(theta-b_iv)) / sum{h= 1 to m} exp(sum{v=1 to h} D*a_i(theta-b_iv))
# Where k is the credit value, D is 1.7, a is the discriminatory power of this item, b_iv is the difficulty of this particular grade, k = 1 , 2, ... m. Theta is the ability level of the test taker.
# Let's first write a function that generates the numerator.
numerator <- function(a, b, theta, k, D=1.7) exp(sum(D*a*(theta-b[1:k])))
denominator <- function(a, b, theta, D=1.7) {
sumval <- 0
for (i in 1:length(b)) sumval <- sumval + numerator(a,b,theta,i,D)
return(sumval)
}
denominator(1,c(1,2,3),theta=2)
# Category characteristic curve
prm <- function(a, b, theta, k, D=1.7) numerator(a, b, theta, k, D)/denominator(a, b, theta, D)
prm(1,c(1,2,3),1,1)
# Now let's create a cumulative probability function
cprm <- function(a, b, theta, D=1.7) {
ncat = length(b)
p=1
for (i in 1:ncat) p[i]<- prm(a,b,theta,i,D)
pmf = p
for (i in 1:ncat) pmf[1:ncat>i]<-pmf[1:ncat>i]+p[i]
return(pmf)
}
cprm(1,c(1,2,3),1,1)
# To generate a random score value from any cprm, we only need draw a random uniform and count how many times the random uniform is greater than the category.
sum(cprm(1,c(1,2,3),1)
# Let's try with:
a = 1.4902
b = c(0, -1.2248, -0.7039, -0.2333)
# It turns out the first b does not matter what the value is.
# If we wanted to draw an item for a group of individuals with thetas equal to
theta = c(1,2,3,4,1,1,2,2,1,1,0,-9,-1,-2,-3,2)
for (v in theta) print(paste("Theta=", v, "; Score=", sum(cprm(a,b,v)
