# Setup for Examples 1 and 2 ------------------------------------------------
# Settings
set.seed(0) # seed for reproducibility
N <- 50 # number of persons
n <- 40 # number of items
# Randomly select 10% sources and 10% copiers
s <- sample(1:N, size = N * 0.10)
c <- sample(setdiff(1:N, s), size = N * 0.10)
# Create vector of indicators (1 = copying pair, 0 = non-copying pair)
pair <- t(combn(N, 2))
pair <- rbind(pair, pair[, 2:1])
ind <- ifelse(1:nrow(pair) %in% apply(
rbind(cbind(s, c), cbind(c, s)), 1, function(p)
which(pair[, 1] == p[1] & pair[, 2] == p[2])), 1, 0)
names(ind) <- paste(pair[, 1], pair[, 2], sep = "-")
# Example 1: Item Scores ----------------------------------------------------
# Generate person parameters for the 3PL model
xi <- cbind(theta = rnorm(N, mean = 0.00, sd = 1.00))
# Generate item parameters for the 3PL model
psi <- cbind(
a = rlnorm(n, meanlog = 0.00, sdlog = 0.25),
b = rnorm(n, mean = 0.00, sd = 1.00),
c = runif(n, min = 0.05, max = 0.30)
)
# Simulate uncontaminated data
x <- sim(psi, xi)$x
# Modify contaminated data by replacing 40% of the copier scores with source
# scores
for (v in 1:length(c)) {
ci <- sample(1:n, size = n * 0.40)
x[c[v], ci] <- x[s[v], ci]
}
# Detect answer copying
out <- detect_ac(
method = c("OMG_S", "GBT_S"),
psi = psi,
x = x
)
# Example 2: Item Responses -------------------------------------------------
# Generate person parameters for the nominal response model
xi <- cbind(eta = rnorm(N, mean = 0.00, sd = 1.00))
# Generate item parameters for the nominal response model
psi <- cbind(
lambda1 = rnorm(n, mean = -0.50, sd = 0.50),
lambda2 = rnorm(n, mean = -0.50, sd = 0.50),
lambda3 = rnorm(n, mean = -0.50, sd = 0.50),
lambda4 = rnorm(n, mean = 1.50, sd = 0.50),
zeta1 = rnorm(n, mean = -0.50, sd = 0.50),
zeta2 = rnorm(n, mean = -0.50, sd = 0.50),
zeta3 = rnorm(n, mean = -0.50, sd = 0.50),
zeta4 = rnorm(n, mean = 1.50, sd = 0.50)
)
# Simulate uncontaminated data
r <- sim(psi, xi)$r
# Modify contaminated data by replacing 40% of the copier responses with
# source responses
for (v in 1:length(c)) {
ci <- sample(1:n, size = n * 0.40)
r[c[v], ci] <- r[s[v], ci]
}
# Detect answer copying
out <- detect_ac(
method = c("OMG_R", "GBT_R"),
psi = psi,
r = r
)
Run the code above in your browser using DataLab