Implemented omxGenerateValueList.
[openmx:openmx.git] / R / MxModel.R
1 setClass(Class = "MxModel",
2         representation = representation(
3                 matrices = "list",
4                 algebras = "list"))
5                 
6 setMethod("initialize", "MxModel",
7         function(.Object, matrices=list(), algebras=list()) {
8                 .Object@matrices = matrices
9                 .Object@algebras = algebras
10                 return(.Object)
11         }
12 )
13
14 setMethod("[[", "MxModel",
15         function(x, i, j, ..., drop = FALSE) {
16                 first <- x@matrices[[i]]
17                 second <- x@algebras[[i]]
18                 if (is.null(first)) {
19                         return(second)
20                 } else {
21                         return(first)
22                 }       
23         }
24 )
25
26 setReplaceMethod("[[", "MxModel",
27         function(x, i, j, value) {
28                 if (is(value,"MxMatrix")) {
29                         if (!is.null(x@algebras[[i]])) {
30                                 stop(paste(i, "is already an MxAlgebra object"))
31                         }
32                         x@matrices[[i]] <- value
33                 } else if (is(value,"MxAlgebra")) {
34                         if (!is.null(x@matrices[[i]])) {
35                                 stop(paste(i, "is already an MxMatrix object"))
36                         }
37                         x@algebras[[i]] <- value                
38                 } else {
39                         stop(paste("Unknown type of value", value))
40                 }
41                 return(x)
42         }
43 )
44
45 omxGenerateMatrixList <- function(mxModel) {
46         return(lapply(mxModel@matrices, generateMatrixListHelper))
47 }
48
49 omxGenerateSimpleMatrixList <- function(mxModel) {
50         retval <- lapply(mxModel@matrices, generateMatrixListHelper)
51         return(lapply(retval, as.matrix))
52 }
53
54 omxGenerateParameterList <- function(mxModel) {
55         result <- list()
56         for(i in 1:length(mxModel@matrices)) {
57                 result <- generaterParameterListHelper(mxModel@matrices[[i]], result, i - 1)
58         }       
59         return(result)
60 }
61
62 omxGenerateValueList <- function(mxModel) {
63         mList <- omxGenerateMatrixList(mxModel)
64         pList <- omxGenerateParameterList(mxModel)
65         retval <- vector()
66         for(i in 1:length(pList)) {
67                 parameter <- pList[[i]]
68                 if (length(parameter) > 1) {
69                         values <- sapply(parameter, generateValueHelper, mList)
70                         if (!all(values == values[[1]])) {
71                                 warning(paste('Parameter',i,'has multiple start values.',
72                                         'Selecting', values[[1]]))
73                         }
74                         retval[i] <- values[[1]]
75                 } else {
76                         retval[i] <- generateValueHelper(parameter[[1]], mList)
77                 }
78     }
79         return(retval)  
80 }
81
82 generateValueHelper <- function(triple, mList) {
83         mat <- triple[1] + 1
84         row <- triple[2]
85         col <- triple[3]
86         return(mList[[mat]][row,col])
87 }