Added mxJob interface.
[openmx:openmx.git] / R / MxModelFunctions.R
1 omxGenerateMatrixList <- function(mxModel) {
2         return(lapply(mxModel@matrices, generateMatrixListHelper))
3 }
4
5 omxGenerateSimpleMatrixList <- function(mxModel) {
6         retval <- lapply(mxModel@matrices, generateMatrixListHelper)
7         return(lapply(retval, as.matrix))
8 }
9
10 omxGenerateAlgebraList <- function(mxModel) {
11     mList <- omxGenerateMatrixList(mxModel)
12     retval <- lapply(mxModel@algebras, generateAlgebraHelper, names(mList))
13     return(retval)
14 }
15
16 omxGenerateParameterList <- function(mxModel) {
17         result <- list()
18         if (length(mxModel@matrices) == 0) {
19                 return(result)
20         }
21         for(i in 1:length(mxModel@matrices)) {
22                 result <- generaterParameterListHelper(mxModel@matrices[[i]], result, i - 1)
23         }       
24         return(result)
25 }
26
27 omxGenerateValueList <- function(mxModel) {
28         mList <- omxGenerateMatrixList(mxModel)
29         pList <- omxGenerateParameterList(mxModel)
30         retval <- vector()
31         if (length(pList) == 0) {
32                 return(retval)
33         }
34         for(i in 1:length(pList)) {
35                 parameter <- pList[[i]]
36                 if (length(parameter) > 1) {
37                         values <- sapply(parameter, generateValueHelper, mList)
38                         if (!all(values == values[[1]])) {
39                                 warning(paste('Parameter',i,'has multiple start values.',
40                                         'Selecting', values[[1]]))
41                         }
42                         retval[i] <- values[[1]]
43                 } else {
44                         retval[i] <- generateValueHelper(parameter[[1]], mList)
45                 }
46     }
47         return(retval)  
48 }
49
50 generateValueHelper <- function(triple, mList) {
51         mat <- triple[1] + 1
52         row <- triple[2]
53         col <- triple[3]
54         return(mList[[mat]][row,col])
55 }
56
57 omxUpdateModelValues <- function(mxModel, values) {
58         pList <- omxGenerateParameterList(mxModel)
59         if(length(pList) != length(values)) {
60                 stop(paste("This model has", length(pList), 
61                         "parameters, but you have given me", length(values),
62                         "values"))
63         }
64         if (length(pList) == 0) {
65                 return(mxModel)
66         }
67         for(i in 1:length(pList)) {
68                 mxModel <- updateModelValueHelper(pList[[i]], values[[i]], mxModel)
69     }
70         return(mxModel)
71 }
72
73 updateModelValueHelper <- function(triples, value, mxModel) {
74         for(i in 1:length(triples)) {
75                 triple <- triples[[i]]
76                 mat <- triple[1] + 1
77                 row <- triple[2]
78                 col <- triple[3]
79                 mxModel@matrices[[mat]]@values[row,col] <- value                        
80         }
81         return(mxModel)
82 }
83
84 omxLocateIndex <- function(model, name) {
85         matrixNumber <- match(name, names(model@matrices))
86         algebraNumber <- match(name, names(model@algebras))
87         if (is.na(matrixNumber) && is.na(algebraNumber)) {
88                 return(NA)
89         } else if (is.na(algebraNumber)) {
90                 return(- matrixNumber)
91         } else {
92                 return(algebraNumber - 1)
93         }
94 }