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
|
library(OpenMx)
library(testthat)
context("naAction")
suppressWarnings(RNGversion("3.5"))
data(demoOneFactor)
dof <- demoOneFactor
dof$x5 <- as.integer(dof$x5) # test autoconversion to numeric
mask <- matrix(as.logical(rbinom(prod(dim(dof)), size = 1, .1)),
nrow=nrow(dof), ncol=ncol(dof))
dof[mask] <- NA
manifests <- names(dof)
latents <- c("G")
model <- mxModel("OneFactor",
type="LISREL",
manifestVars=list(exo=manifests),
latentVars=list(exo=latents),
mxPath(from=latents, to=manifests),
mxPath(from=manifests, arrows=2, values=1.0),
mxPath(from=latents, arrows=2, free=FALSE, values=1.0),
mxPath(from='one', to=manifests),
mxData(observed=dof, type="raw", naAction = 'fail'))
expect_error(mxRun(model),
"contains at least one NA")
model$data$observed <- dof[rowSums(mask) == 0,]
fit <- mxRun(model)
fit1 <- fit$output$fit
model$data$observed <- dof
model$data$naAction <- 'omit'
d1 <- mxRun(model)
expect_equal(d1$output$fit, fit1, 1e-9)
set.seed(1)
b1 <- mxBootstrap(d1, 10)
expect_equal(sd(b1$compute$output$raw[,'fit']), 28, 1)
model$data$naAction <- 'exclude'
d2 <- mxRun(model)
expect_equal(d2$output$fit, fit1, 1e-9)
set.seed(1)
b2 <- mxBootstrap(d2, 10)
expect_equal(b1$compute$output$raw[,'fit'], b2$compute$output$raw[,'fit'], 1e-9)
# ----
numSets <- 4
ob <- list()
for (rep in 1:numSets) {
v <- rnorm(nrow(dof))
v[as.logical(rbinom(nrow(dof), size = 1, .1))] <- NA
ob[[rep]] <- v
}
ob <- as.data.frame(ob, col.names=paste0('V',1:numSets))
m1 <- mxModel(
model,
mxFitFunctionWLS(allContinuousMethod = "marginals"),
mxComputeLoop(list(
LD=mxComputeLoadData("OneFactor", column="x5", method="data.frame",
byrow=FALSE, observed=ob),
mxComputeSetOriginalStarts(),
mxComputeOnce('fitfunction','fit'),
CP=mxComputeCheckpoint(toReturn = TRUE, parameters=FALSE, sampleSize = TRUE))))
m1 <- mxRun(m1)
expect_equal(m1$compute$steps$LD$output$rowsAvailable, ncol(ob))
m2 <- m1
m2$data$naAction <- 'omit'
m2 <- mxRun(m2)
expect_equal(m2$compute$steps$CP$log$objective, m1$compute$steps$CP$log$objective)
# exclude doesn't change sample size
expect_equal(m1$compute$steps$CP$log$OneFactor.data.nrow, rep(500, numSets))
# omit does
expect_true(length(table(m2$compute$steps$CP$log$OneFactor.data.nrow)) > 1)
# ----
m3 <- m1
m3$data$observed[['freq']] <- 1L + rpois(nrow(dof), .5)
m3$data$frequency <- 'freq'
m3$data$naAction <- 'exclude'
m4 <- m3
m3 <- mxRun(m3)
m4$data$naAction <- 'omit'
m4 <- mxRun(m4)
expect_equal(m3$compute$steps$CP$log$objective,
m4$compute$steps$CP$log$objective)
expect_equal(nrow(m3$data$observed), 500)
expect_equal(m3$compute$steps$CP$log$OneFactor.data.nrow, rep(500, numSets))
#
expect_true(length(table(m4$compute$steps$CP$log$OneFactor.data.nrow)) > 1)
expect_equal(nrow(m4$data$observed), 300,10)
# ----
numSets <- 4
ob <- list()
for (rep in 1:numSets) {
ob[[rep]] <- rnorm(nrow(dof))
}
ob <- as.data.frame(ob, col.names=paste0('V',1:numSets))
m1 <- mxModel(
model,
mxFitFunctionWLS(allContinuousMethod = "marginals"),
mxComputeLoop(list(
LD=mxComputeLoadData("OneFactor", column="x5", method="data.frame",
byrow=FALSE, observed=ob),
mxComputeSetOriginalStarts(),
mxComputeOnce('fitfunction','fit'),
CP=mxComputeCheckpoint(toReturn = TRUE, parameters=FALSE, sampleSize = TRUE))))
m1 <- mxRun(m1)
m2 <- m1
m2$data$naAction <- 'omit'
m2 <- mxRun(m2)
expect_equal(m2$compute$steps$CP$log$objective, m1$compute$steps$CP$log$objective)
expect_equal(m1$compute$steps$CP$log$OneFactor.data.nrow, rep(500, numSets))
expect_equal(length(table(m2$compute$steps$CP$log$OneFactor.data.nrow)), 1)
expect_true(m2$compute$steps$CP$log$OneFactor.data.nrow[1] < 500)
# ----
|
