Add multigroup tests
[openmx:openmx.git] / R / MxFitFunctionMultigroup.R
1 #
2 #   Copyright 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 = "MxFitFunctionMultigroup",
17          representation = representation(
18            groups = "MxOptionalCharOrNumber"),
19          contains = "MxBaseFitFunction")
20
21 setMethod("initialize", "MxFitFunctionMultigroup",
22         function(.Object, groups, name = 'fitfunction') {
23                 .Object@name <- name
24                 .Object@groups <- groups
25                 return(.Object)
26         }
27 )
28
29 setMethod("genericFitDependencies", signature("MxFitFunctionMultigroup"),
30         function(.Object, flatModel, dependencies) {
31         dependencies <- callNextMethod()
32         dependencies <- imxAddDependency(.Object@groups, .Object@name, dependencies)
33         return(dependencies)
34 })
35
36 setMethod("qualifyNames", signature("MxFitFunctionMultigroup"), 
37         function(.Object, modelname, namespace) {
38                 .Object@name <- imxIdentifier(modelname, .Object@name)
39                 return(.Object)
40 })
41
42 # "model.algebra" or "model" for "model.fitfunction"
43 setMethod("genericFitFunConvert", "MxFitFunctionMultigroup", 
44         function(.Object, flatModel, model, labelsData, defVars, dependencies) {
45                 name <- .Object@name
46                 if (length(.Object@groups)) .Object@groups <- vapply(.Object@groups, function(group) {
47                         path <- unlist(strsplit(group, imxSeparatorChar, fixed = TRUE))
48                         if (length(path) == 1) {
49                                 ff <- paste(path, "fitfunction", sep=".")
50                                 length(model@algebras) + imxLocateIndex(flatModel, ff, name)
51                         } else if (length(path) == 2) {
52                                 # restrict to algebra or fitfunction TODO
53                                 imxLocateIndex(flatModel, group, name)
54                         }
55                 }, 1L)
56                 return(.Object)
57 })
58
59
60 mxFitFunctionMultigroup <- function(groups) {
61         return(new("MxFitFunctionMultigroup", groups))
62 }