dich_response_sim: Simulate Dichotomous Response Model

View source: R/dich_response_sim.R

dich_response_simR Documentation

Simulate Dichotomous Response Model

Description

This function calculates the matrix of first partial derivatives, the matrix of second partial derivatives, and the information matrix for the posterior distribution with respect to theta (ability) based on theslope-intercept form of the item response theory model.

Usage

dich_response_sim(
  I = NULL,
  J = NULL,
  K = NULL,
  M = NULL,
  N = NULL,
  omega = NULL,
  omega_mu = NULL,
  omega_sigma2 = NULL,
  gamma = NULL,
  lambda = NULL,
  lambda_mu = NULL,
  lambda_sigma2 = NULL,
  nu = NULL,
  nu_mu = NULL,
  nu_sigma2 = NULL,
  zeta = NULL,
  zeta_mu = NULL,
  zeta_sigma2 = NULL,
  kappa = NULL,
  key = NULL,
  link = "probit"
)

Arguments

I

Number of items per condition.

J

Number of conditions.

K

Number of examinees

M

Number of ability (or trait) dimensions.

N

Number of contrasts (should include intercept).

omega

Examinee-level effects of the experimental manipulation (K by MN).

omega_mu

Vector of means for the examinee-level effects of the experimental manipulation (1 by MN).

omega_sigma2

Covariance matrix for the examinee-level effects of the experimental manipulation (MN by MN).

gamma

Matrix of experimental structure parameters (JM by MN).

lambda

Matrix of item structure parameters (IJ by JM).

lambda_mu

Vector of means for the item structure parameters (1 by JM)

lambda_sigma2

Covariance matrix for the item structure parameters (JM by JM)

nu

Matrix of item intercept parameters (K by IJ).

nu_mu

Mean of the item intercept parameters (scalar).

nu_sigma2

Variance of the item intercept parameters (scalar).

zeta

Condition-level effects of the experimental manipulation (K by JM).

zeta_mu

Vector of means for the condition-level effects nested within examinees (1 by JM).

zeta_sigma2

Covariance matrix for the condition-level effects nested within examinees (JM by JM).

kappa

Matrix of item guessing parameters (K by IJ). If kappa is not provided, parameter values are set to 0.

key

Option key where 1 indicates target and 2 indicates distractor.

link

Choose between logit or probit link functions.

Value

y = simulated response matrix; yhatstar = simulated latent response probability matrix; [simulation_parameters]

References

Skrondal, A., & Rabe-Hesketh, S. (2004). Generalized latent variable modeling: Multilevel, longitudinal, and structural equation models. Boca Raton: Chapman & Hall/CRC.

Thomas, M. L., Brown, G. G., Gur, R. C., Moore, T. M., Patt, V. M., Risbrough, V. B., & Baker, D. G. (2018). A signal detection-item response theory model for evaluating neuropsychological measures. Journal of Clinical and Experimental Neuropsychology, 40(8), 745-760.

Examples


# Example 1

I <- 100
J <- 1
K <- 250
M <- 1
N <- 1
omega_mu <- matrix(data = 0, nrow = 1, ncol = M * N)
omega_sigma2 <- diag(x = 1, nrow = M * N)
gamma <- diag(x = 1, nrow = J * M, ncol = M * N)
lambda_mu <- matrix(data = 1, nrow = 1, ncol = M)
lambda_sigma2 <- diag(x = 0.25, nrow = M)
zeta_mu <- matrix(data = rep(x = 0, times = M * J), nrow = 1, ncol = J * M)
zeta_sigma2 <- diag(x = 0, nrow = J * M, ncol = J * M)
nu_mu <- matrix(data = 0, nrow = 1, ncol = 1)
nu_sigma2 <- matrix(data = 1, nrow = 1, ncol = 1)
set.seed(624)
ex1 <- dich_response_sim(I = I, J = J, K = K, M = M, N = N,
                         omega_mu = omega_mu, omega_sigma2 = omega_sigma2,
                         gamma = gamma, lambda_mu = lambda_mu,
                         lambda_sigma2 = lambda_sigma2, nu_mu = nu_mu,
                         nu_sigma2 = nu_sigma2, zeta_mu = zeta_mu,
                         zeta_sigma2 = zeta_sigma2)

# Example 2

I <- 100
J <- 1
K <- 50
M <- 2
N <- 1
omega_mu <- matrix(data = c(3.50, 1.00), nrow = 1, ncol = M * N)
omega_sigma2 <- diag(x = c(0.90, 0.30), nrow = M * N)
gamma <- diag(x = 1, nrow = J * M, ncol = M * N)
key <- rbinom(n = I * J, size = 1, prob = .7) + 1
measure_weights <-
  matrix(data = c(0.5, -1.0, 0.5, 1.0), nrow = 2, ncol = M, byrow = TRUE)
lambda <- matrix(data = 0, nrow = I * J, ncol = J * M)
for(j in 1:J) {
  lambda[(1 + (j - 1) * I):(j * I), (1 + (j - 1) * M):(j * M)] <-
    measure_weights[key, ][(1 + (j - 1) * I):(j * I), ]
}
zeta_mu <- matrix(data = rep(x = 0, times = M * J), nrow = 1, ncol = J * M)
zeta_sigma2 <- diag(x = 0, nrow = J * M, ncol = J * M)
nu_mu <- matrix(data = 0, nrow = 1, ncol = 1)
nu_sigma2 <- matrix(data = .2, nrow = 1, ncol = 1)
set.seed(624)
ex2 <- dich_response_sim(I = I, J = J, K = K, M = M, N = N,
                         omega_mu = omega_mu, omega_sigma2 = omega_sigma2,
                         gamma = gamma, lambda = lambda, nu_mu = nu_mu,
                         nu_sigma2 = nu_sigma2, zeta_mu = zeta_mu,
                         zeta_sigma2 = zeta_sigma2, key = key)

# Example 3

I <- 20
J <- 10
K <- 50
M <- 2
N <- 2
omega_mu <- matrix(data = c(2.50, -2.00, 0.50, 0.00), nrow = 1, ncol = M * N)
omega_sigma2 <- diag(x = c(0.90, 0.70, 0.30, 0.10), nrow = M * N)
contrast_codes <- cbind(1, contr.poly(n = J))[, 1:N]
gamma <- matrix(data = 0, nrow = J * M, ncol = M * N)
for(j in 1:J) {
  for(m in 1:M) {
    gamma[(m + M * (j - 1)), (((m - 1) * N + 1):((m - 1) * N + N))] <-
      contrast_codes[j, ]
  }
}
key <- rbinom(n = I * J, size = 1, prob = .7) + 1
measure_weights <-
  matrix(data = c(0.5, -1.0, 0.5, 1.0), nrow = 2, ncol = M, byrow = TRUE)
lambda <- matrix(data = 0, nrow = I * J, ncol = J * M)
for(j in 1:J) {
  lambda[(1 + (j - 1) * I):(j * I), (1 + (j - 1) * M):(j * M)] <-
    measure_weights[key, ][(1 + (j - 1) * I):(j * I), ]
}
zeta_mu <- matrix(data = rep(x = 0, times = M * J), nrow = 1, ncol = J * M)
zeta_sigma2 <- diag(x = 0.2, nrow = J * M, ncol = J * M)
nu_mu <- matrix(data = c(0.00), nrow = 1, ncol = 1)
nu_sigma2 <- matrix(data = c(0.20), nrow = 1, ncol = 1)
set.seed(624)
ex3 <- dich_response_sim(I = I, J = J, K = K, M = M, N = N,
                         omega_mu = omega_mu, omega_sigma2 = omega_sigma2,
                         gamma = gamma, lambda = lambda, nu_mu = nu_mu,
                         nu_sigma2 = nu_sigma2, zeta_mu = zeta_mu,
                         zeta_sigma2 = zeta_sigma2, key = key)

# Example 4

I <- 30
J <- 2
K <- 500
M <- 1
N <- 2
omega_mu <- matrix(data = c(0, -1), nrow = 1, ncol = M * N)
omega_sigma2 <- diag(x = c(1.00, 0.25), nrow = M * N)
contrast_codes <- cbind(1, contr.treatment(n = J))[, 1:N]
gamma <- matrix(data = 0, nrow = J * M, ncol = M * N)
for(j in 1:J) {
  for(m in 1:M) {
    gamma[(m + M * (j - 1)), (((m - 1) * N + 1):((m - 1) * N + N))] <-
    contrast_codes[j, ]
  }
}
lambda <- matrix(data = 0, nrow = I * J, ncol = J * M)
lam_vals <- rnorm(I, 1.5, .23)
for (j in 1:J) {
  lambda[(1 + (j - 1) * I):(j * I), (1 + (j - 1) * M):(j * M)] <- lam_vals
}
zeta_mu <- matrix(data = rep(x = 0, times = M * J), nrow = 1, ncol = J * M)
zeta_sigma2 <- diag(x = 0.2, nrow = J * M, ncol = J * M)
nu <- matrix(data = rnorm(n = I, mean = 0, sd = .25), nrow = I * J, ncol = 1)
set.seed(624)
ex4 <- dich_response_sim(I = I, J = J, K = K, M = M, N = N,
                         omega_mu = omega_mu, omega_sigma2 = omega_sigma2,
                         gamma = gamma, lambda = lambda, nu = nu,
                         zeta_mu = zeta_mu, zeta_sigma2 = zeta_sigma2)

# Example 5

I <- 20
J <- 10
K <- 1
M <- 2
N <- 2
omega_mu <- matrix(data = c(2.50, -2.00, 0.50, 0.00), nrow = 1, ncol = M * N)
omega_sigma2 <- diag(x = c(0.90, 0.70, 0.30, 0.10), nrow = M * N)
contrast_codes <- cbind(1, contr.poly(n = J))[, 1:N]
gamma <- matrix(data = 0, nrow = J * M, ncol = M * N)
for(j in 1:J) {
  for(m in 1:M) {
    gamma[(m + M * (j - 1)), (((m - 1) * N + 1):((m - 1) * N + N))] <-
      contrast_codes[j, ]
  }
}
key <- rbinom(n = I * J, size = 1, prob = .7) + 1
measure_weights <-
  matrix(data = c(0.5, -1.0, 0.5, 1.0), nrow = 2, ncol = M, byrow = TRUE)
lambda <- matrix(data = 0, nrow = I * J, ncol = J * M)
for(j in 1:J) {
  lambda[(1 + (j - 1) * I):(j * I), (1 + (j - 1) * M):(j * M)] <-
    measure_weights[key, ][(1 + (j - 1) * I):(j * I), ]
}
zeta_mu <- matrix(data = rep(x = 0, times = M * J), nrow = 1, ncol = J * M)
zeta_sigma2 <- diag(x = 0.2, nrow = J * M, ncol = J * M)
nu_mu <- matrix(data = c(0.00), nrow = 1, ncol = 1)
nu_sigma2 <- matrix(data = c(0.20), nrow = 1, ncol = 1)
set.seed(624)
ex5 <- dich_response_sim(I = I, J = J, K = K, M = M, N = N,
                         omega_mu = omega_mu, omega_sigma2 = omega_sigma2,
                         gamma = gamma, lambda = lambda, nu_mu = nu_mu,
                         nu_sigma2 = nu_sigma2, zeta_mu = zeta_mu,
                         zeta_sigma2 = zeta_sigma2, key = key)


mlthom/CogIRT documentation built on Sept. 5, 2024, 8:18 a.m.