Added license information to R source files.
[openmx:openmx.git] / R / MxConstraint.R
1 #
2 #   Copyright 2007-2009 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 setClass(Class = "MxConstraint",
18         representation = representation(
19                 name = "character",
20                 alg1 = "MxCharOrNumber",
21                 alg2 = "MxCharOrNumber",
22                 relation = "MxCharOrNumber"
23         ))
24         
25 setMethod("initialize", "MxConstraint",
26         function(.Object, name, alg1, alg2, relation) {
27                 .Object@name <- name
28                 .Object@alg1 <- alg1
29                 .Object@alg2 <- alg2
30                 .Object@relation <- relation
31                 return(.Object)
32         }
33 )
34
35 mxConstraint <- function(alg1, relation, alg2, name = NA) {
36         if (is.na(name)) {
37                 name <- omxUntitledName()
38         }
39         if (typeof(name) != "character") {
40                 stop(paste("Name argument is not a string",
41                 "(the name of the objective function)"))
42         }
43         if (missing(alg1) || typeof(alg1) != "character") {
44                 stop(paste("Alg1 argument is not a string",
45                 "(the name of the first algebra)"))             
46         }               
47         if (missing(alg2) || typeof(alg2) != "character") {
48                 stop(paste("Alg2 argument is not a string",
49                 "(the name of the second algebra)"))
50         }
51         if (missing(relation) || typeof(relation) != "character") {
52                 stop(paste("Relation argument is not a string",
53                 "(<, =, or >)"))
54         }
55         if (!(relation %in% omxConstraintRelations)) {
56                         clist <- paste(omxConstraintRelations, 
57                                 collapse = ", ")
58                         msg <- paste("Relation must be in the list:",
59                                 clist)
60                         stop(msg)
61                 }
62         return(new("MxConstraint", name, alg1, alg2, relation))
63 }
64
65 omxConvertConstraints <- function(flatModel) {
66         return(lapply(flatModel@constraints, function(x) {
67                 omxConvertSingleConstraint(x, flatModel)}))
68 }
69
70
71 omxConvertSingleConstraint <- function(constraint, flatModel) {
72         index1 <- omxLocateIndex(flatModel, constraint@alg1,
73                 constraint@name)
74         index2 <- omxLocateIndex(flatModel, constraint@alg2,
75                 constraint@name)
76         index3 <- match(constraint@relation, omxConstraintRelations)
77         if(is.na(index3)) {
78                 clist <- paste(omxConstraintRelations, 
79                                 collapse = ",")         
80                 msg <- paste("The relation for constraint", 
81                         omxQuotes(constraint@name),
82                         "is not in the following list:",
83                         clist)
84                 stop(msg, call.=FALSE)
85         }
86         return(list(index1,index2,index3 - 1))
87 }
88
89 omxConstraintRelations <- c("<", "=", ">")