Starting changes to LISREL to type='LISREL' and to expectations for mxEval(model...
[openmx:openmx.git] / R / MxLISRELModel.R
1 #
2 #   Copyright 2007-2013 The OpenMx Project
3 #
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
7
8 #        http://www.apache.org/licenses/LICENSE-2.0
9
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.
15
16 setClass(Class = "MxLISRELModel",
17         representation = representation(),
18         contains = "MxModel")
19
20 imxModelTypes[['LISREL']] <- "MxLISRELModel"
21
22 # imxVariableTypes <- c(imxVariableTypes, "exogenous", "endogenous")
23
24
25 #--------------------------------------------------------------------
26 # Define generic functions
27
28 setMethod("imxTypeName", "MxLISRELModel", 
29         function(model) { "LISREL" }
30 )
31
32 setMethod("imxInitModel", "MxLISRELModel", 
33         function(model) {
34                 stop("Not implemented")
35                 #TODO change this to return an ML fitfunction and an expectation with all NA matrices
36                 # Then later add matrices when I know what dims they have.
37                 
38                 if (is.null(model[['LX']])) {
39                         model[['LX']] <- createMatrixLX(model)
40                 }
41                 if (is.null(model[['LY']])) {
42                         model[['LY']] <- createMatrixLY(model)
43                 }
44                 if (is.null(model[['BE']])) {
45                         model[['BE']] <- createMatrixBE(model)
46                 }
47                 if (is.null(model[['GA']])) {
48                         model[['GA']] <- createMatrixGA(model)
49                 }
50                 if (is.null(model[['PH']])) {
51                         model[['PH']] <- createMatrixPH(model)
52                 }
53                 if (is.null(model[['PS']])) {
54                         model[['PS']] <- createMatrixPS(model)
55                 }
56                 if (is.null(model[['TD']])) {
57                         model[['TD']] <- createMatrixTD(model)
58                 }
59                 if (is.null(model[['TE']])) {
60                         model[['TE']] <- createMatrixTE(model)
61                 }
62                 if (is.null(model[['TH']])) {
63                         model[['TH']] <- createMatrixTH(model)
64                 }
65                 if (is.null(model[['TX']])) {
66                         model[['TX']] <- createMatrixTX(model)
67                 }
68                 if (is.null(model[['TY']])) {
69                         model[['TY']] <- createMatrixTY(model)
70                 }
71                 if (is.null(model[['KA']])) {
72                         model[['KA']] <- createMatrixKA(model)
73                 }
74                 if (is.null(model[['AL']])) {
75                         model[['AL']] <- createMatrixAL(model)
76                 }
77                 if (is.null(model[['expectation']])) {
78                         model[['expectation']] <- mxExpectationLISREL('LX', 'LY', 'BE', 'GA', 'PH', 'PS', 'TD', 'TE', 'TH', 'TX', 'TY', 'KA', 'AL')
79                 }
80                 if (is.null(model[['fitfunction']])) {
81                         model[['fitfunction']] <- mxFitFunctionML()
82                 }
83                 return(model)
84         }
85 )
86
87
88 createMatrixLX <- function(model){
89         lvariables <- c(model@latentVars$exogenous)
90         mvariables <- c(model@maifestVars$exogenous)
91         llen <- length(lvariables)
92         mlen <- length(mvariables)
93         names <- list(mvariables, lvariables)
94         values <- matrix(0, mlen, llen)
95         free <- matrix(FALSE, mlen, llen)
96         labels <- matrix(as.character(NA), mlen, llen)
97         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "LX")
98         dimnames(retval) <- names
99         return(retval)
100 }
101
102 createMatrixLY <- function(model){
103         lvariables <- c(model@latentVars$endogenous)
104         mvariables <- c(model@maifestVars$endogenous)
105         llen <- length(lvariables)
106         mlen <- length(mvariables)
107         names <- list(mvariables, lvariables)
108         values <- matrix(0, mlen, llen)
109         free <- matrix(FALSE, mlen, llen)
110         labels <- matrix(as.character(NA), mlen, llen)
111         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "LY")
112         dimnames(retval) <- names
113         return(retval)
114 }
115
116 createMatrixBE <- function(model){
117         variables <- c(model@latentVars$endogenous)
118         len <- length(variables)
119         names <- list(variables, variables)
120         values <- matrix(0, len, len)
121         free <- matrix(FALSE, len, len)
122         labels <- matrix(as.character(NA), len, len)
123         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "BE")
124         dimnames(retval) <- names
125         return(retval)
126 }
127
128 createMatrixGA <- function(model){
129         xvariables <- c(model@latentVars$exogenous)
130         yvariables <- c(model@latentVars$endogenous)
131         xlen <- length(xvariables)
132         ylen <- length(yvariables)
133         names <- list(yvariables, xvariables)
134         values <- matrix(0, ylen, xlen)
135         free <- matrix(FALSE, ylen, xlen)
136         labels <- matrix(as.character(NA), ylen, xlen)
137         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "GA")
138         dimnames(retval) <- names
139         return(retval)
140 }
141
142 # TODO Fill in the rest of the createMatrix* functions
143
144 createMatrixPH <- function(model){} #Latent cov of xi
145 createMatrixPS <- function(model){} #Latent cov of eta
146 createMatrixTD <- function(model){} #residu cov of x
147 createMatrixTE <- function(model){} #residu cov of y
148 createMatrixTH <- function(model){} #residu cov of xy
149 createMatrixTX <- function(model){} #interc of x
150 createMatrixTY <- function(model){} #interc of y
151 createMatrixKA <- function(model){} #mean of xi
152 createMatrixAL <- function(model){} #mean of eta
153
154 # TODO See if there is a way to change an mxMatrix's type.  E.g. TD & TE are often but not always diagonal, and should(?) be stored as diagonal if possible.
155
156
157 setMethod("imxModelBuilder", "MxLISRELModel", 
158         function(model, lst, name, 
159                 manifestVars, latentVars, submodels, remove, independent) {
160                 stop("Not implemented")
161         }
162 )
163
164 setMethod("imxVerifyModel", "MxLISRELModel",
165         function(model) {
166                 # TODO somewhere in here add check that at least one of LX or LY exist
167                 return(TRUE)
168         }
169 )
170
171
172 setReplaceMethod("[[", "MxLISRELModel",
173         function(x, i, j, value) {
174                 stop("Not implemented")
175         }
176 )
177
178 setReplaceMethod("$", "MxLISRELModel",
179         function(x, name, value) {
180                 stop("Not implemented")
181         }
182 )