2 # Copyright 2012 The OpenMx Project
4 # Licensed under the Apache License, Version 2.0 (the "License");
5 # you may not use this file except in compliance with the License.
6 # You may obtain a copy of the License at
8 # http://www.apache.org/licenses/LICENSE-2.0
10 # Unless required by applicable law or agreed to in writing, software
11 # distributed under the License is distributed on an "AS IS" BASIS,
12 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 # See the License for the specific language governing permissions and
14 # limitations under the License.
17 setClass(Class = "MxExpectationBA81",
18 representation = representation(
20 ItemParam = "MxCharOrNumber",
21 EItemParam = "MxOptionalMatrix",
22 CustomPrior = "MxOptionalCharOrNumber",
23 design = "MxOptionalMatrix",
28 scores.out = "matrix",
29 mean = "MxCharOrNumber",
30 cov = "MxCharOrNumber",
31 empirical.mean = "numeric",
32 empirical.cov = "matrix",
33 patternLikelihood = "numeric",
34 em.expected = "numeric",
38 contains = "MxBaseExpectation")
40 setMethod("initialize", "MxExpectationBA81",
41 function(.Object, ItemSpec, ItemParam, EItemParam, CustomPrior, design,
42 qpoints, qwidth, cache, mean, cov, scores, verbose,
43 name = 'expectation') {
45 .Object@ItemSpec <- ItemSpec
46 .Object@ItemParam <- ItemParam
47 .Object@EItemParam <- EItemParam
48 .Object@CustomPrior <- CustomPrior
49 .Object@design <- design
50 .Object@qpoints <- qpoints
51 .Object@qwidth <- qwidth
52 .Object@cache <- cache
53 .Object@scores <- scores
54 .Object@data <- as.integer(NA)
57 .Object@scores.out <- matrix()
58 .Object@verbose <- verbose
63 setMethod("genericExpDependencies", signature("MxExpectationBA81"),
64 function(.Object, dependencies) {
65 sources <- c(.Object@mean, .Object@cov,
66 .Object@ItemParam, .Object@CustomPrior)
67 dependencies <- imxAddDependency(sources, .Object@name, dependencies)
71 setMethod("genericExpFunConvert", signature("MxExpectationBA81"),
72 function(.Object, flatModel, model, labelsData, defVars, dependencies) {
73 modelname <- imxReverseIdentifier(model, .Object@name)[[1]]
74 if(is.na(.Object@data)) {
75 msg <- paste(typeof(.Object),
76 "does not have a dataset associated with it in model",
78 stop(msg, call.=FALSE)
81 for (s in c("data", "ItemParam", "CustomPrior",
83 if (is.null(slot(.Object, s))) next;
85 imxLocateIndex(flatModel, slot(.Object, s), name)
87 .Object@dims <- colnames(flatModel@datasets[[.Object@data + 1]]@observed)
91 setMethod("qualifyNames", signature("MxExpectationBA81"),
92 function(.Object, modelname, namespace) {
93 .Object@name <- imxIdentifier(modelname, .Object@name)
94 for (s in c("ItemParam", "CustomPrior", "mean", "cov")) {
95 if (is.null(slot(.Object, s))) next;
97 imxConvertIdentifier(slot(.Object, s), modelname, namespace)
102 setMethod("genericExpRename", signature("MxExpectationBA81"),
103 function(.Object, oldname, newname) {
104 # not sure what goes here yet
108 ##' Create a Bock & Aitkin (1981) expectation
110 ##' The standard Normal distribution of the quadrature acts like a
111 ##' prior distribution for difficulty. It is not necessary to impose
112 ##' any additional Bayesian prior on difficulty estimates (Baker &
113 ##' Kim, 2004, p. 196).
115 ##' @param ItemParam one column for each item with parameters starting
116 ##' at row 1 and extra rows filled with NA
117 ##' @param design one column per item, assignment of person abilities
118 ##' to item dimensions (optional)
119 ##' @param qpoints number of points to use for rectangular quadrature integrations (default 49)
120 ##' See Seong (1990) for some considerations on specifying this parameter.
121 ##' @param cache whether to cache part of the expectation calculation
122 ##' (enabled by default).
124 ##' Bock, R. D., & Aitkin, M. (1981). Marginal maximum likelihood estimation of item
125 ##' parameters: Application of an EM algorithm. Psychometrika, 46, 443-459.
127 ##' Cai, L. (2010). A two-tier full-information item factor analysis
128 ##' model with applications. Psychometrika, 75, 581-612.
130 ##' Seong, T. J. (1990). Sensitivity of marginal maximum likelihood
131 ##' estimation of item and ability parameters to the characteristics
132 ##' of the prior ability distributions. Applied Psychological
133 ##' Measurement, 14(3), 299-311.
135 # change default to cache=FALSE or just remove cache? TODO
136 mxExpectationBA81 <- function(ItemSpec, ItemParam, CustomPrior=NULL, design=NULL,
137 qpoints=NULL, qwidth=6.0, cache=TRUE, mean=NULL, cov=NULL,
138 scores="omit", verbose=FALSE, EItemParam=NULL) {
140 if (missing(qpoints)) qpoints <- 49
142 stop("qpoints should be 3 or greater")
144 if (qpoints %% 2 == 0) {
145 warning(paste("An even number of qpoints can obtain a better than true fit",
146 "in a single group model; Pick an odd number of qpoints"))
148 if (missing(qwidth)) qwidth <- 6
150 stop("qwidth must be positive")
153 score.options <- c("omit", "unique", "full")
154 if (!match(scores, score.options)) {
155 stop(paste("Valid score options are", deparse(score.options)))
158 if (!missing(design) && !is.integer(design)) {
159 stop("Design must be an integer matrix")
162 return(new("MxExpectationBA81", ItemSpec, ItemParam, EItemParam, CustomPrior, design,
163 qpoints, qwidth, cache, mean, cov, scores, verbose))