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
|
#
# Copyright 2007-2018 by the individuals mentioned in the source code history
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#options(error = utils::recover)
require(OpenMx)
data(multiData1)
manifests <- c("x1", "y")
uniRegModelRaw <- mxModel("uniRegModelRaw",
type="RAM",
manifestVars=manifests,
mxPath(from="x1", to="y", arrows=1,
free=TRUE, values=.2, labels="b1"),
mxPath(from=manifests,
arrows=2, free=TRUE, values=.8,
labels=c("VarX1", "VarE")),
mxPath(from="one", to=manifests,
arrows=1, free=TRUE, values=.1,
labels=c("MeanX1", "MeanY")),
mxData(observed=multiData1, type="raw"),
mxFitFunctionML(vector=TRUE) # should fail
)
varNames <- c('x')
data1 <- mxData(matrix(1, dimnames = list(varNames,varNames)), type="cov", numObs=100)
data2 <- mxData(matrix(2, dimnames = list(varNames,varNames)), type="cov", numObs=100)
mat1 <- mxMatrix("Full",2,free=TRUE, nrow=1, ncol=1, name="mat1")
mat2 <- mxMatrix("Full",1,free=TRUE, nrow=1, ncol=1, name="mat2")
obj1 <- mxExpectationNormal("mat1", dimnames = varNames)
obj2 <- mxExpectationNormal("mat2", dimnames = varNames)
model1 <- mxModel("model1", data1, mat1, obj1, mxFitFunctionML())
model2 <- mxModel("model2", data2, mat2, obj2, mxFitFunctionML())
#output1 <- mxRun(model1, suppressWarnings = TRUE)
#output2 <- mxRun(model2, suppressWarnings = TRUE)
#output1$output
#output2$output
omxCheckError(mxFitFunctionMultigroup(groups=c()),
message="mxFitFunctionMultigroup: at least 1 fitfunction must be provided")
alg <- mxAlgebra(model1.objective + model2.objective, name="alg")
if (1) {
obj <- mxFitFunctionMultigroup(paste("model", 1:2, sep=""))
model <- mxModel("both", obj, model1, model2)
model.est <- mxRun(model, suppressWarnings = TRUE)
omxCheckCloseEnough(model.est$output$estimate, 99/100*c(1, 2), 0.001)
}
if (1) {
obj <- mxFitFunctionMultigroup("both.alg")
model <- mxModel("both", obj, model1, model2, alg)
model.est <- mxRun(model, suppressWarnings = TRUE)
omxCheckCloseEnough(model.est$output$estimate, 99/100*c(1, 2), 0.001)
}
if (1) {
obj <- mxFitFunctionAlgebra("alg")
model <- mxModel("both", obj, model1, model2, alg)
model.est <- mxRun(model, suppressWarnings = TRUE)
omxCheckCloseEnough(model.est$output$estimate, 99/100*c(1, 2), 0.001)
}
if (1) {
obj <- mxFitFunctionMultigroup(c("uniRegModelRaw", paste("model", 1:2, sep="")))
model <- mxModel(model="vector", obj, model1, model2, uniRegModelRaw)
omxCheckError(mxRun(model, suppressWarnings = TRUE), "vector.fitfunction: cannot combine units Pr and -2lnL (from model1.fitfunction)")
}
model <- mxModel(model="fail", mxFitFunctionMultigroup("noExisto"))
omxCheckError(mxRun(model), "fail.fitfunction: cannot locate algebra/fitfunction 'noExisto'")
|
