Added hand written mxFitFunctionMultigroup.Rd (was jumbled up)
[openmx:openmx.git] / R / MxFitFunctionMultigroup.R
1 setClass(Class = "MxFitFunctionMultigroup",
2          representation = representation(
3            groups = "MxOptionalCharOrNumber",
4              verbose= "integer"),
5          contains = "MxBaseFitFunction")
6
7 setMethod("initialize", "MxFitFunctionMultigroup",
8         function(.Object, groups, verbose, name = 'fitfunction') {
9                 .Object@name <- name
10                 .Object@groups <- groups
11                 .Object@verbose <- verbose
12                 return(.Object)
13         }
14 )
15
16 setMethod("genericFitDependencies", signature("MxFitFunctionMultigroup"),
17         function(.Object, flatModel, dependencies) {
18         dependencies <- callNextMethod()
19         dependencies <- imxAddDependency(.Object@groups, .Object@name, dependencies)
20         return(dependencies)
21 })
22
23 setMethod("qualifyNames", signature("MxFitFunctionMultigroup"), 
24         function(.Object, modelname, namespace) {
25                 .Object@name <- imxIdentifier(modelname, .Object@name)
26                 return(.Object)
27 })
28
29 # "model.algebra" or "model" for "model.fitfunction"
30 setMethod("genericFitFunConvert", "MxFitFunctionMultigroup", 
31         function(.Object, flatModel, model, labelsData, defVars, dependencies) {
32                 name <- .Object@name
33                 if (length(.Object@groups)) .Object@groups <- vapply(.Object@groups, function(group) {
34                         path <- unlist(strsplit(group, imxSeparatorChar, fixed = TRUE))
35                         if (length(path) == 1) {
36                                 ff <- paste(path, "fitfunction", sep=".")
37                                 length(model@algebras) + imxLocateIndex(flatModel, ff, name)
38                         } else if (length(path) == 2) {
39                                 # restrict to algebra or fitfunction TODO
40                                 imxLocateIndex(flatModel, group, name)
41                         }
42                 }, 1L)
43                 return(.Object)
44 })
45
46 mxFitFunctionMultigroup <- function(groups, ..., verbose=0L) {
47         garbageArguments <- list(...)
48         if (length(garbageArguments) > 0) {
49                 stop("mxFitFunctionMultigroup does not accept values for the '...' argument")
50         }
51
52         if (length(groups) == 0) stop("mxFitFunctionMultigroup: at least 1 fitfunction must be provided")
53
54         return(new("MxFitFunctionMultigroup", groups, verbose))
55 }