View source: R/dich_response_sim.R
dich_response_sim | R Documentation |
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.
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"
)
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. |
y = simulated response matrix; yhatstar = simulated latent response probability matrix; [simulation_parameters]
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.
# 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)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.