Started moving files into the subversion trunk. Created a makefile.
[openmx:openmx.git] / R / MxModel.R
1
2
3 setConstructorS3("MxModel", function() { 
4
5   freeVariablesList <- list();
6   
7   extend(Object(), "MxModel",
8     .freeVariablesList=freeVariablesList
9   );
10
11 })
12
13
14
15 setMethodS3("$<-", "MxModel", function(this, name, value) {
16   memberAccessorOrder <- attr(this, ".memberAccessorOrder");
17   if (is.null(memberAccessorOrder))
18     memberAccessorOrder <- c(1,2,3,4,5);
19
20   #
21   # This portion of the method is specific to OpenMx
22   # Michael Spiegel, May 2, 2007
23   #
24   if (inherits(value,"MxMatrix")) {
25     transformMatrix(value, length(this$.freeVariablesList))
26   }
27
28   for (memberAccessor in memberAccessorOrder) {
29     if (memberAccessor == 1) {
30       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
31       # Search for a set<Name>() method
32       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
33       if (is.null(attr(this, "disableSetMethods"))) {
34         firstChar <- substr(name, 1,1);
35         # Do not try to access private fields using a set<Name>() method,
36         # because such a functionality means that the user *expects* that
37         # there actually is a field called '.<name>', which he or she
38         # should not do since it is a private field!
39         # Is it a private field?
40         if (!identical(firstChar, ".")) {
41           # Field names can not contain spaces...
42           if (regexpr(" ", name) == -1) {
43             # 1. Is it a set<Name>() method?
44             capitalizedName <- name;
45             substr(capitalizedName,1,1) <- toupper(firstChar);
46             setMethodNames <- paste("set", capitalizedName, ".", class(this), sep="");
47             for (setMethodName in setMethodNames) {
48               if (exists(setMethodName, mode="function")) {
49                 ref <- this;
50                 attr(ref, "disableSetMethods") <- TRUE;
51                 get(setMethodName, mode="function")(ref, value);
52                 return(invisible(this));
53               }
54             }
55           } # if ("no space in the name")
56         } # if ("is private field")
57       } # if (is.null(attr(this, "disableSetMethods")))
58     } else if (memberAccessor == 2) {
59       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
60       # Search for a <name> field
61       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
62       # 2. If there exists a field, assign the value to that field.
63       envir <- attr(this, ".env");
64       if (exists(name, envir=envir)) {
65         assign(name, value, envir=envir);
66
67         #
68         # This portion of the method is specific to OpenMx
69         # Michael Spiegel, May 2, 2007
70         #
71         if (inherits(value,"MxMatrix")) {
72           this$updateFreeVariablesList();
73         }
74         
75         return(invisible(this));
76       }
77     } else if (memberAccessor == 3) {
78       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
79       # Search for a <name> attribute.   /Should this be removed?
80       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
81       # 3. If there exists an attribute field, assign the value to that field.
82       if (is.element(name, names(attributes(this)))) {
83         attr(this, name) <- value;
84         return(invisible(this));
85       }
86     } else if (memberAccessor == 4) {
87       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
88       # Search for a static <name> field
89       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
90       # 4. If not, it might be that it is a static field
91       static <- getStaticInstance(get(class(this)[1]));
92       static.envir <- attr(static, ".env");
93       # For static method calls, e.g. Object$load, 'this' has no
94       # environment assigned and therefore, for now, no static
95       # fields.
96       if (!is.null(static.envir) && exists(name, envir=static.envir, inherit=FALSE)) {
97         assign(name, value, envir=static.envir);
98         return(invisible(this));
99       }
100     } else if (memberAccessor == 5) {
101       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
102       # Create a new field <name>
103       # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
104       # 5. Otherwise, assign the value to a new field.
105       assign(name, value, envir=envir);
106       
107       #
108       # This portion of the method is specific to OpenMx
109       # Michael Spiegel, May 2, 2007
110       #
111       if (inherits(value,"MxMatrix")) {
112         this$updateFreeVariablesList();
113       }
114             
115       return(invisible(this));
116     }
117   } # for (memberAccessor in memberAccessorOrder)
118
119   invisible(this);
120 }, createGeneric=FALSE) # $<-()
121
122 setMethodS3("[[<-", "MxModel", function(this, name, value) {
123   UseMethod("$<-");
124 #   "$<-"(this, name, value);
125 }, createGeneric=FALSE) # "[[<-"()
126