-
Notifications
You must be signed in to change notification settings - Fork 0
/
lca_cor.R
71 lines (59 loc) · 2.54 KB
/
lca_cor.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#' guesstimate
#' @title Calculate item level and aggregate learning
#' @param transmatrix transition matrix returned from \code{\link{multi_transmat}}
#' @param nodk_priors Optional. Vector of length 4. Priors for the parameters for model that fits data without Don't Knows
#' @param dk_priors Optional. Vector of length 8. Priors for the parameters for model that fits data with Don't Knows
#' @return list with two items: parameter estimates and estimates of learning
#' @export
#' @examples
#' # Without DK
#' pre_test <- data.frame(item1 = c(1, 0, 0, 1, 0), item2 = c(1, NA, 0, 1, 0))
#' pst_test <- pre_test + cbind(c(0, 1, 1, 0, 0), c(0, 1, 0, 0, 1))
#' transmatrix <- multi_transmat(pre_test, pst_test)
#' res <- lca_cor(transmatrix)
lca_cor <- function(transmatrix = NULL, nodk_priors = c(.3, .1, .1, .25),
dk_priors = c(.3, .1, .2, .05, .1, .1, .05, .25)) {
# Initialize results mat
nitems <- nrow(transmatrix)
nparams <- ifelse(ncol(transmatrix) == 4, 4, 8)
est.opt <- matrix(ncol = nitems, nrow = nparams)
# priors
nodk_priors <- nodk_priors
dk_priors <- dk_priors
# effects
effects <- matrix(ncol = nitems, nrow = 1)
# calculating parameter estimates
if (nparams == 4) {
for (i in 1:nitems) {
est.opt[, i] <- tryCatch(solnp(nodk_priors,
guess_lik,
eqfun = eqn1,
eqB = c(1),
LB = rep(0, 4),
UB = rep(1, 4),
data = transmatrix[i, ])[[1]],
error = function(e) NULL)
}
effects[, 1:nitems] <- est.opt[2, ]
} else {
for (i in 1:nitems) {
est.opt[, i] <- tryCatch(solnp(dk_priors,
guessdk_lik,
eqfun = eqn1dk,
eqB = c(1),
LB = rep(0, 8),
UB = rep(1, 8),
data = transmatrix[i, ])[[1]],
error = function(e) rep(NA, 8))
}
effects[, 1:nitems] <- est.opt[2, ] + est.opt[6, ]
}
# Assign row names
if (nrow(est.opt) == 8) {
row.names(est.opt) <-
c("lgg", "lgk", "lgc", "lkk", "lcg", "lck", "lcc", "gamma")
} else {
row.names(est.opt) <- c("lgg", "lgk", "lkk", "gamma")
}
list(param.lca = est.opt, est.learning = effects)
}