Move all fitfunction args to expectation
[openmx:openmx.git] / models / passing / ifa-missingdata.R
1 #options(error = utils::recover)
2 library(OpenMx)
3 library(rpf)
4
5 mcar <- function(data, pct) {
6         size <- prod(dim(data))
7         erase <- rep(TRUE, size * pct)
8         mask <- c(erase, rep(FALSE, size - length(erase)))[order(runif(size))]
9         shaped.mask <- array(mask, dim=dim(data))
10         data[shaped.mask] <- NA
11         data <- data[apply(is.na(data), 1, sum) != dim(data)[2],]  # remove when all items are missing
12         data
13 }
14
15 set.seed(8)
16
17 numItems <- 5
18 i1 <- rpf.nrm(3, T.c=diag(2))
19 items <- vector("list", numItems)
20 correct <- vector("list", numItems)
21 for (ix in 1:numItems) {
22   items[[ix]] <- i1
23   correct[[ix]] <- rpf.rparam(i1)
24 }
25 correct.mat <- simplify2array(correct)
26 correct.mat[2,] <- 1
27 correct.mat[3,] <- 0
28
29 good.data <- rpf.sample(250, items, correct.mat)
30 data <- mcar(good.data, 1/3)
31 #head(data)
32
33 ip.mat <- mxMatrix(name="itemParam", nrow=5, ncol=numItems,
34                    values=c(1,1,0,0,0),
35                    free=c(TRUE,FALSE,FALSE,TRUE,TRUE))
36
37 eip.mat <- mxAlgebra(itemParam, name="EItemParam")
38
39 m.mat <- mxMatrix(name="mean", nrow=1, ncol=1, values=0, free=FALSE)
40 cov.mat <- mxMatrix(name="cov", nrow=1, ncol=1, values=1, free=FALSE)
41
42 m2 <- mxModel(model="test3", ip.mat, m.mat, cov.mat, eip.mat,
43               mxData(observed=data, type="raw"),
44               mxExpectationBA81(mean="mean", cov="cov",
45                                 ItemSpec=items,
46                                 EItemParam="EItemParam", ItemParam="itemParam"),
47               mxFitFunctionBA81(),
48               mxComputeIterate(steps=list(
49                 mxComputeOnce("EItemParam"),
50                 mxComputeOnce('expectation', context='EM'),
51                                    mxComputeNewtonRaphson(free.set='itemParam'),
52 #                mxComputeGradientDescent(free.set='itemParam'),
53                 mxComputeOnce('expectation'),
54                 mxComputeOnce('fitfunction'))))
55
56         m2 <- mxOption(m2, "Analytic Gradients", 'Yes')
57         m2 <- mxOption(m2, "Verify level", '-1')
58 m2 <- mxOption(m2, "Function precision", '1.0E-5')
59 m2 <- mxRun(m2)
60
61 got <- cor(c(m2@matrices$itemParam@values[c(1,4,5),]),
62            c(correct.mat[c(1,4,5),]))
63 omxCheckCloseEnough(got, .936, .01)