# 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)

## No comments:

## Post a Comment