File: TestRowObjectiveExistenceVector.R

package info (click to toggle)
r-cran-openmx 2.21.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 14,412 kB
  • sloc: cpp: 36,577; ansic: 13,811; fortran: 2,001; sh: 1,440; python: 350; perl: 21; makefile: 5
file content (75 lines) | stat: -rw-r--r-- 2,695 bytes parent folder | download | duplicates (3)
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
#
#   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.


# -----------------------------------------------------------------------
# Program: TestRowObjectiveExistenceVector.R  
#  Author: tbrick
#    Date: 2011-05-04
#
# Test of the OpenMx Row Objective Existence Vector
#
# Revision History
#     Timothy R. Brick -- Created
# -----------------------------------------------------------------------

require(OpenMx)
set.seed(200)
pctMissing=50
n = 200

# Generate data
# -----------------------------------------------------------------------
xes = cbind( rnorm(n, 0, 1), runif(n, 0, 1))
dimnames(xes) = list(NULL, c("x1", "x2"))
tSelect <- xes[,2] < (pctMissing/100)
xes[tSelect,2] <- NA
data = data.frame(xes)

# The objective is the count of non-missing values.
# -----------------------------------------------------------------------
sumModel = mxModel("sumModel",
	mxAlgebra(existenceVector, name="rowAlgebra"),
	mxAlgebra(sum(rowResults), name="reduceAlgebra"),
	mxData(data, type="raw"),
	mxFitFunctionRow(
		rowAlgebra='rowAlgebra',
		reduceAlgebra='reduceAlgebra',
		dimnames=c('x1','x2'),
	)
)
sumFit = mxRun(sumModel)
# The objective is the count of non-missing values.
# -----------------------------------------------------------------------
countModel = mxModel("countModel",
    mxMatrix("Full", 1, 2, free=FALSE, values=1, name="Unity"),
	mxAlgebra(sum(omxSelectCols(Unity, existenceVector)), name="rowAlgebra"),
	mxAlgebra(sum(rowResults), name="reduceAlgebra"),
	mxData(data, type="raw"),
	mxFitFunctionRow(
		rowAlgebra='rowAlgebra',
		reduceAlgebra='reduceAlgebra',
		dimnames=c('x1','x2'),
	)
)
countFit = mxRun(countModel)
# Correct answer: the count of all nonmissing values.
# -----------------------------------------------------------------------
realCount = sum(sum(!is.na(xes)))

omxCheckCloseEnough(realCount, as.vector(mxEval(objective, sumFit)))
omxCheckCloseEnough(!is.na(xes), mxEval(rowResults, sumFit))
omxCheckCloseEnough(realCount, as.vector(mxEval(objective, countFit)))
omxCheckCloseEnough(apply(!is.na(xes), 1, sum), as.vector(mxEval(rowResults, countFit)))