Monday, October 1, 2012

Generalized Graded Response Data Generating Command


# The following code will draw random test items from a graded response model.

# The command mat.binom will be useful in drawing a matrix of binomial results. I will use a command I programmed in a previous post. (http://www.econometricsbysimulation.com/2012/09/item-response-theory-estimation.html)
mat.binom <- function="function" n="n" p="p">  bin.mat <- p="p">  for (i in 1:nrow(p)) {
    for (ii in 1:ncol(p)) {
    # This will draw a random binomial for each of the probabilities.
    bin.mat[i,ii] <- i="i" ii="ii" n="n" p="p" rbinom="rbinom">  }
  }
 return(bin.mat)
}


rgrm <- d="1.7)" function="function" p="p" theta="0,a=cbind(rep(1,5),rep(1,5)),b=cbind(rep(0,5),rep(1,5)),">  # b is now an input matrix with each row representing a different item and each column representing a different grade for that item.  The number of columns should be equal to the maximum number of grades for all of the items.  Items may have less than the full number of grades indicated by NA values at upper levels.

  # We will use the grm Cululative Grade Function defined in a previous post as what we will use to generate our probabilities.
  # http://www.econometricsbysimulation.com/2012/09/generalize-graded-response-model.html
  grm <- a="1," b="c(0,1,2)," cplot="T," function="function" p="p" pplot="T," stackpoly="F" theta="1,">    ngrade = max(length(b),length(a))
    CGF = matrix(NA, ncol=ngrade  , nrow=length(theta))
    for (i in 1:length(theta)) CGF[i,] = exp(a*(theta[i]-b))/(1+exp(a*(theta[i]-b)))
    return(CGF)
  }

  # This will be the number of items to generate.
  if (sum(dim(a)!=dim(b))>0) warning()
  nitems = nrow(b)

  # This matrix will hold the results of the items.
  Y <- matrix="matrix" ncol="nitems)</p" nrow="length(theta),">
  rownames(Y) = paste("Stud", 1:length(theta))
  colnames(Y) = paste("Item", 1:nitems)

  for (i in 1:nitems) {
    # Draw the submatrix of a and b not equal to NA
    a.sub = !is.na(a[i,])
    b.sub = !is.na(b[i,])
    # Draw a uniform draw for every individual
    unif.draw = runif(length(theta))
    # Spread those draws out into a matrix for each grade of each item for each individual
    unif.draws = matrix(unif.draw, ncol=length(a.sub), nrow=length(theta))
    # Draw the probability of getting each grade for each item
    itemi = grm(theta=theta, a=a[i,a.sub], b=b[i,b.sub])
    # Calculate the grade for each item.
    Y[,i]<-apply itemi="itemi">unif.draw,1,sum)
    # Since the grm function creates a matrix with the probability of getting that value or more for each grade we can simply count the number of times that the random uniform draw got below that value.  If the draw is low enough then the student gets full credit.  If it is high enough then the student gets no credit.
  }
  # Specify the command's return value
  return(Y)
}

# Notice, theta can be any length but a and b must have the same dimensions
a=cbind(rep(1,6),rep(1,6),rep(c(NA,1),3))
b=cbind(rep(1,6),rep(2,6),rep(c(NA,3),3))
# This will create six items with grades from 1 to 2 and 1 to 2 to 3.  The NA's mean that grade is missing (undefined).

# The length of theta is equal to the number of students
theta=seq(0,7,.5)

rgrm(theta=theta,a=a , b=b)

No comments:

Post a Comment