Remove most instances of setFinalReturns
[openmx:openmx.git] / R / MxFitFunction.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
17 #
18 # The virtual base class for all fit functions
19 #
20 setClass(Class = "MxBaseFitFunction", 
21          representation = representation(
22            info = "list",
23                 dependencies = "integer",
24                 expectation = "integer",
25                 result = "matrix", "VIRTUAL"),
26          contains = "MxBaseNamed")
27
28 setClassUnion("MxFitFunction", c("NULL", "MxBaseFitFunction"))
29
30 setGeneric("genericFitDependencies",
31         function(.Object, flatModel, dependencies) {
32         return(standardGeneric("genericFitDependencies"))
33 })
34
35 setGeneric("genericFitRename",
36         function(.Object, oldname, newname) {
37         return(standardGeneric("genericFitRename"))
38 })
39
40 setGeneric("genericFitInitialMatrix",
41         function(.Object, flatModel) {
42         return(standardGeneric("genericFitInitialMatrix"))
43 })
44
45 setGeneric("genericFitNewEntities",
46         function(.Object) {
47         return(standardGeneric("genericFitNewEntities"))
48 })
49
50
51 setGeneric("genericFitFunConvert", 
52         function(.Object, flatModel, model, labelsData, defVars, dependencies) {
53         return(standardGeneric("genericFitFunConvert")) 
54 })
55
56 setMethod("genericFitInitialMatrix", "MxBaseFitFunction",
57         function(.Object, flatModel) {
58                 return(matrix(as.double(NA), 1, 1))
59 })
60
61 setMethod("genericFitInitialMatrix", "NULL",
62         function(.Object, flatModel) {
63                 return(NULL)
64 })
65
66 ##' Add dependencies
67 ##'
68 ##' If there is an expectation, then the fitfunction should always
69 ##' depend on it. Hence, subclasses that implement this method must
70 ##' ignore the passed-in dependencies and use "dependencies <-
71 ##' callNextMethod()" instead.
72 ##'
73 ##' @param .Object
74 ##' @param flatModel
75 ##' @param dependencies accumulated dependency relationships
76
77 setMethod("genericFitDependencies", "MxBaseFitFunction",
78         function(.Object, flatModel, dependencies) {
79         name <- .Object@name
80         modelname <- imxReverseIdentifier(model, .Object@name)[[1]]
81         expectName <- paste(modelname, "expectation", sep=".")
82         if (!is.null(flatModel[[expectName]])) {
83             dependencies <- imxAddDependency(expectName, .Object@name, dependencies)
84         }
85                 return(dependencies)
86 })
87
88 setMethod("genericFitDependencies", "NULL",
89         function(.Object, flatModel, dependencies) {
90                 return(dependencies)
91 })
92
93 setMethod("genericFitRename", "MxBaseFitFunction",
94         function(.Object, oldname, newname) {
95                 return(.Object)
96 })
97
98 setMethod("genericFitRename", "NULL",
99         function(.Object, oldname, newname) {
100                 return(NULL)
101 })
102
103 setMethod("genericFitNewEntities", "MxBaseFitFunction",
104         function(.Object) {
105                 return(NULL)
106 })
107
108 setGeneric("genericFitConvertEntities",
109         function(.Object, flatModel, namespace, labelsData) {
110         return(standardGeneric("genericFitConvertEntities"))
111 })
112
113 setGeneric("genericFitAddEntities",
114         function(.Object, job, flatJob, labelsData) {
115         return(standardGeneric("genericFitAddEntities"))
116 })
117
118 setMethod("genericFitConvertEntities", "MxBaseFitFunction",
119         function(.Object, flatModel, namespace, labelsData) {
120                 return(flatModel)
121 })
122
123 setMethod("genericFitConvertEntities", "NULL",
124         function(.Object, flatModel, namespace, labelsData) {
125                 return(flatModel)
126 })
127
128 setMethod("genericFitAddEntities", "MxBaseFitFunction",
129         function(.Object, job, flatJob, labelsData) {
130                 return(job)
131 })
132
133 setMethod("genericFitAddEntities", "NULL",
134         function(.Object, job, flatJob, labelsData) {
135                 return(job)
136 })
137
138 fitFunctionAddEntities <- function(model, flatModel, labelsData) {
139
140         fitfunctions <- flatModel@fitfunctions
141
142         if (length(fitfunctions) == 0) {
143                 return(model)
144         }
145
146         for(i in 1:length(fitfunctions)) {
147                 model <- genericFitAddEntities(fitfunctions[[i]], model, flatModel, labelsData)
148         }
149
150         return(model)
151 }
152
153 fitFunctionModifyEntities <- function(flatModel, namespace, labelsData) {
154
155         fitfunctions <- flatModel@fitfunctions
156
157         if (length(fitfunctions) == 0) {
158                 return(flatModel)
159         }
160
161         for(i in 1:length(fitfunctions)) {
162                 flatModel <- genericFitConvertEntities(fitfunctions[[i]], flatModel, namespace, labelsData)
163         }
164
165         return(flatModel)
166 }
167
168 convertFitFunctions <- function(flatModel, model, labelsData, defVars, dependencies) {
169         retval <- lapply(flatModel@fitfunctions, genericFitFunConvert, 
170                 flatModel, model, labelsData, defVars, dependencies)
171         return(retval)
172 }