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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
##' Convert an OpenMx MxModel object into an IFA group
##'
##' When \dQuote{minItemsPerScore} is passed, EAP scores will be computed
##' from the data and stored. Scores are required for some diagnostic
##' tests. See discussion of \dQuote{minItemsPerScore} in \link{EAPscores}.
##'
##' @template detail-group
##' @param mxModel MxModel object
##' @param data observed data (otherwise the data will be taken from the mxModel)
##' @param container an MxModel in which to search for the latent distribution matrices
##' @template arg-dots
##' @param minItemsPerScore minimum number of items required to compute a score (also see description)
##' @return a groups with item parameters and latent distribution
##' @seealso \href{https://cran.r-project.org/package=ifaTools}{ifaTools}
as.IFAgroup <- function(mxModel, data=NULL, container=NULL, ..., minItemsPerScore=NULL) {
if (length(list(...)) > 0) {
stop(paste("Remaining parameters must be passed by name", deparse(list(...))))
}
expectation <- mxModel$expectation
if (!is(expectation, "MxExpectationBA81")) {
stop(paste("Don't know how to create an IFA group from",
class(expectation)))
}
if (missing(container)) {
container <- mxModel
}
mat <- expectation$item
if (length(grep("\\.", mat))) {
stop(paste("Don't know how to obtain the item matrix", mat))
}
itemMat <- mxModel[[mat]]
if (is.null(itemMat)) {
stop(paste("Item matrix", mat, "not found"))
}
ret <- list(spec = expectation$ItemSpec,
param = itemMat$values,
free = itemMat$free,
labels = itemMat$labels,
# TODO maybe should include free variables in latent distribution?
uniqueFree = length(unique(itemMat$labels[itemMat$free], incomparables=NA)),
qpoints = expectation$qpoints,
qwidth = expectation$qwidth)
mat <- expectation$mean
if (length(grep("\\.", mat))) {
meanMat <- eval(substitute(mxEval(theExpression, container),
list(theExpression = parse(text = mat)[[1]])))
if (is.null(meanMat)) {
stop(paste("Don't know how to obtain the mean matrix", mat))
}
ret$mean <- meanMat
} else {
mxMat <- mxModel[[mat]]
if (!is.null(mxMat)) {
ret$mean <- mxMat$values
}
}
mat <- expectation$cov
if (length(grep("\\.", mat))) {
covMat <- eval(substitute(mxEval(theExpression, container),
list(theExpression = parse(text = mat)[[1]])))
if (is.null(covMat)) {
stop(paste("Don't know how to obtain the cov matrix", mat))
}
ret$cov <- covMat
} else {
mxMat <- mxModel[[mat]]
if (!is.null(mxMat)) {
ret$cov <- mxMat$values
}
}
if (!missing(data)) {
ret$data <- data
} else if (!is.null(mxModel$data)) {
mxData <- mxModel$data
if (mxData$type != "raw") {
stop(paste("Not sure how to handle data of type", mxData$type))
}
if (!is.null(mxData$frequency) && !is.na(mxData$frequency)) {
ret$freqColumn <- mxData$frequency
}
if (!is.null(mxData$weight) && !is.na(mxData$weight)) {
ret$weightColumn <- mxData$weight
}
ret$data <- mxData$observed
}
if (!is.na(expectation$weightColumn)) {
ret$weightColumn <- expectation$weightColumn
ret$observedStats <- nrow(ret$data) - 1
} else {
if (ncol(ret$param) == ncol(ret$data)) {
freq <- tabulateRows(ret$data[orderCompletely(ret$data),])
ret$observedStats <- length(freq) - 1L
}
}
if (max(sapply(ret$spec, function(s) s$factors)) > 0 && !missing(minItemsPerScore)) {
ret$minItemsPerScore <- minItemsPerScore
ret$score <- EAPscores(ret, compressed=TRUE)
}
ret
}
#' Strip data and scores from an IFA group
#'
#' In addition, the freqColumn and weightColumn are reset to NULL.
#'
#' @template arg-grp
#' @template detail-group
#' @return
#' The same group without associated data.
#' @examples
#' spec <- list()
#' spec[1:3] <- list(rpf.grm(outcomes=3))
#' param <- sapply(spec, rpf.rparam)
#' data <- rpf.sample(5, spec, param)
#' colnames(param) <- colnames(data)
#' grp <- list(spec=spec, param=param, data=data, minItemsPerScore=1L)
#' grp$score <- EAPscores(grp)
#' str(grp)
#' grp <- stripData(grp)
#' str(grp)
stripData <- function(grp) {
grp$data <- NULL
grp$score <- NULL
grp$weightColumn <- NULL
grp$freqColumn <- NULL
grp
}
|
