Add thread-safe logging functions
[openmx:openmx.git] / src / omxExpectation.cpp
1 /*
2  *  Copyright 2007-2013 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 /***********************************************************
18
19 *  omxExpectation.cc
20 *
21 *  Created: Timothy R. Brick    Date: 2008-11-13 12:33:06
22 *
23 *       Expectation objects carry distributional expectations
24 *               for the model.  Because they have no requirement
25 *               to produce a single matrix of output, they are
26 *               not a subclass of mxMatrix, but rather their own
27 *               strange beast.
28 *       // TODO:  Create a multi-matrix Algebra type, and make
29 *       //      MxExpectation a subtype of that.
30 *
31 **********************************************************/
32
33 #include "omxExpectation.h"
34
35 typedef struct omxExpectationTableEntry omxExpectationTableEntry;
36
37 struct omxExpectationTableEntry {
38         char name[32];
39         void (*initFun)(omxExpectation*);
40 };
41
42 void omxInitNormalExpectation(omxExpectation *ox);
43 void omxInitLISRELExpectation(omxExpectation *ox);
44 void omxInitStateSpaceExpectation(omxExpectation *ox);
45 void omxInitRAMExpectation(omxExpectation *ox);
46
47 static const omxExpectationTableEntry omxExpectationSymbolTable[] = {
48         {"MxExpectationLISREL",                 &omxInitLISRELExpectation},
49         {"MxExpectationStateSpace",                     &omxInitStateSpaceExpectation},
50         {"MxExpectationNormal",                 &omxInitNormalExpectation},
51         {"MxExpectationRAM",                    &omxInitRAMExpectation}
52 };
53
54 void omxFreeExpectationArgs(omxExpectation *ox) {
55         if(ox==NULL) return;
56     
57         /* Completely destroy the Expectation function tree */
58         if(OMX_DEBUG) {mxLog("Freeing %s Expectation object at 0x%x.", (ox->expType == NULL?"untyped":ox->expType), ox);}
59         if(ox->destructFun != NULL) {
60                 if(OMX_DEBUG) {mxLog("Calling Expectation destructor for 0x%x.", ox);}
61                 ox->destructFun(ox);
62         }
63         Free(ox->submodels);
64         Free(ox);
65 }
66
67 void omxExpectationRecompute(omxExpectation *ox) {
68         if(OMX_DEBUG_ALGEBRA) { 
69             mxLog("Expectation recompute: 0x%0x", ox);
70         }
71
72         omxExpectationCompute(ox);
73 }
74
75 void omxExpectationCompute(omxExpectation *ox) {
76         if (!ox) return;
77
78         if(OMX_DEBUG_ALGEBRA) { 
79             mxLog("Expectation compute: 0x%0x", ox);
80         }
81
82         ox->computeFun(ox);
83 }
84
85 omxMatrix* omxGetExpectationComponent(omxExpectation* ox, omxFitFunction* off, const char* component) {
86
87         if(component == NULL) return NULL;
88
89         /* Hard-wired expectation components */
90         if(!strncmp("dataColumns", component, 11)) {
91                 return ox->dataColumns;
92         }
93
94         if(ox->componentFun == NULL) return NULL;
95
96         return(ox->componentFun(ox, off, component));
97         
98 }
99
100 void omxSetExpectationComponent(omxExpectation* ox, omxFitFunction* off, const char* component, omxMatrix* om) {
101         if(!strcmp(ox->expType, "MxExpectationStateSpace")) {
102                 ox->mutateFun(ox, off, component, om);
103         }
104 }
105
106 omxExpectation* omxDuplicateExpectation(const omxExpectation *src, omxState* newState) {
107
108         if(OMX_DEBUG) {mxLog("Duplicating Expectation 0x%x", src);}
109
110         return omxNewIncompleteExpectation(src->rObj, src->expNum, newState);
111 }
112
113 omxExpectation* omxNewIncompleteExpectation(SEXP rObj, int expNum, omxState* os) {
114
115         SEXP ExpectationClass;
116         PROTECT(ExpectationClass = STRING_ELT(getAttrib(rObj, install("class")), 0));
117         const char* expType = CHAR(ExpectationClass);
118
119         omxExpectation* expect = omxNewInternalExpectation(expType, os);
120
121         expect->rObj = rObj;
122         expect->expNum = expNum;
123         
124         return expect;
125 }
126
127 omxExpectation* omxExpectationFromIndex(int expIndex, omxState* os)
128 {
129         omxExpectation* ox = os->expectationList.at(expIndex);
130         if (!ox->isComplete) omxCompleteExpectation(ox);
131         return ox;
132 }
133
134 void omxExpectationProcessDataStructures(omxExpectation* ox, SEXP rObj){
135
136         int index, numDefs, nextDef, numCols, numOrdinal=0;
137         SEXP nextMatrix, itemList, nextItem, threshMatrix; 
138         
139         if(rObj == NULL) return;
140
141         if(OMX_DEBUG) { mxLog("Retrieving data."); }
142         PROTECT(nextMatrix = GET_SLOT(rObj, install("data")));
143         ox->data = omxDataLookupFromState(nextMatrix, ox->currentState);
144
145         if(OMX_DEBUG && ox->currentState->parentState == NULL) {
146                 mxLog("Accessing variable mapping structure.");
147         }
148
149         if (R_has_slot(rObj, install("dataColumns"))) {
150                 PROTECT(nextMatrix = GET_SLOT(rObj, install("dataColumns")));
151                 ox->dataColumns = omxNewMatrixFromRPrimitive(nextMatrix, ox->currentState, 0, 0);
152                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
153                         omxPrint(ox->dataColumns, "Variable mapping");
154                 }
155         
156                 numCols = ox->dataColumns->cols;
157
158                 if (R_has_slot(rObj, install("thresholds"))) {
159                         if(OMX_DEBUG && ox->currentState->parentState == NULL) {
160                                 mxLog("Accessing Threshold matrix.");
161                         }
162                         PROTECT(threshMatrix = GET_SLOT(rObj, install("thresholds")));
163
164                         if(INTEGER(threshMatrix)[0] != NA_INTEGER) {
165                                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
166                                         mxLog("Accessing Threshold Mappings.");
167                                 }
168         
169                                 /* Process the data and threshold mapping structures */
170                                 /* if (threshMatrix == NA_INTEGER), then we could ignore the slot "thresholdColumns"
171                                  * and fill all the thresholds with {NULL, 0, 0}.
172                                  * However the current path does not have a lot of overhead. */
173                                 PROTECT(nextMatrix = GET_SLOT(rObj, install("thresholdColumns")));
174                                 PROTECT(itemList = GET_SLOT(rObj, install("thresholdLevels")));
175                                 int* thresholdColumn, *thresholdNumber;
176                                 thresholdColumn = INTEGER(nextMatrix);
177                                 thresholdNumber = INTEGER(itemList);
178                                 ox->thresholds = (omxThresholdColumn *) R_alloc(numCols, sizeof(omxThresholdColumn));
179                                 for(index = 0; index < numCols; index++) {
180                                         if(thresholdColumn[index] == NA_INTEGER) {      // Continuous variable
181                                                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
182                                                         mxLog("Column %d is continuous.", index);
183                                                 }
184                                                 ox->thresholds[index].matrix = NULL;
185                                                 ox->thresholds[index].column = 0;
186                                                 ox->thresholds[index].numThresholds = 0;
187                                         } else {
188                                                 ox->thresholds[index].matrix = omxMatrixLookupFromState1(threshMatrix, 
189                                                                                                        ox->currentState);
190                                                 ox->thresholds[index].column = thresholdColumn[index];
191                                                 ox->thresholds[index].numThresholds = thresholdNumber[index];
192                                                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
193                                                         mxLog("Column %d is ordinal with %d thresholds in threshold column %d.", 
194                                                                 index, thresholdColumn[index], thresholdNumber[index]);
195                                                 }
196                                                 numOrdinal++;
197                                         }
198                                 }
199                                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
200                                         mxLog("%d threshold columns processed.", numOrdinal);
201                                 }
202                                 ox->numOrdinal = numOrdinal;
203                         } else {
204                                 if (OMX_DEBUG && ox->currentState->parentState == NULL) {
205                                         mxLog("No thresholds matrix; not processing thresholds.");
206                                 }
207                                 ox->thresholds = NULL;
208                                 ox->numOrdinal = 0;
209                         }
210                 }
211         }
212
213         if(!R_has_slot(rObj, install("definitionVars"))) {
214                 ox->numDefs = 0;
215                 ox->defVars = NULL;
216         } else {        
217                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
218                         mxLog("Accessing definition variables structure.");
219                 }
220                 PROTECT(nextMatrix = GET_SLOT(rObj, install("definitionVars")));
221                 numDefs = length(nextMatrix);
222                 ox->numDefs = numDefs;
223                 if(OMX_DEBUG && ox->currentState->parentState == NULL) {
224                         mxLog("Number of definition variables is %d.", numDefs);
225                 }
226                 ox->defVars = (omxDefinitionVar *) R_alloc(numDefs, sizeof(omxDefinitionVar));
227                 for(nextDef = 0; nextDef < numDefs; nextDef++) {
228                         SEXP dataSource, columnSource, depsSource; 
229                         int nextDataSource, numDeps;
230
231                         PROTECT(itemList = VECTOR_ELT(nextMatrix, nextDef));
232                         PROTECT(dataSource = VECTOR_ELT(itemList, 0));
233                         nextDataSource = INTEGER(dataSource)[0];
234                         if(OMX_DEBUG && ox->currentState->parentState == NULL) {
235                                 mxLog("Data source number is %d.", nextDataSource);
236                         }
237                         ox->defVars[nextDef].data = nextDataSource;
238                         ox->defVars[nextDef].source = ox->currentState->dataList[nextDataSource];
239                         PROTECT(columnSource = VECTOR_ELT(itemList, 1));
240                         if(OMX_DEBUG && ox->currentState->parentState == NULL) {
241                                 mxLog("Data column number is %d.", INTEGER(columnSource)[0]);
242                         }
243                         ox->defVars[nextDef].column = INTEGER(columnSource)[0];
244                         PROTECT(depsSource = VECTOR_ELT(itemList, 2));
245                         numDeps = LENGTH(depsSource);
246                         ox->defVars[nextDef].numDeps = numDeps;
247                         ox->defVars[nextDef].deps = (int*) R_alloc(numDeps, sizeof(int));
248                         for(int i = 0; i < numDeps; i++) {
249                                 ox->defVars[nextDef].deps[i] = INTEGER(depsSource)[i];
250                         }
251
252                         ox->defVars[nextDef].numLocations = length(itemList) - 3;
253                         ox->defVars[nextDef].matrices = (int *) R_alloc(length(itemList) - 3, sizeof(int));
254                         ox->defVars[nextDef].rows = (int *) R_alloc(length(itemList) - 3, sizeof(int));
255                         ox->defVars[nextDef].cols = (int *) R_alloc(length(itemList) - 3, sizeof(int));
256                         for(index = 3; index < length(itemList); index++) {
257                                 PROTECT(nextItem = VECTOR_ELT(itemList, index));
258                                 ox->defVars[nextDef].matrices[index-3] = INTEGER(nextItem)[0];
259                                 ox->defVars[nextDef].rows[index-3] = INTEGER(nextItem)[1];
260                                 ox->defVars[nextDef].cols[index-3] = INTEGER(nextItem)[2];
261                         }
262                 }
263         }
264         
265 }
266
267 void omxCompleteExpectation(omxExpectation *ox) {
268         
269         if(ox->isComplete) return;
270
271         if(OMX_DEBUG) {mxLog("Completing Expectation 0x%x, type %s.", 
272                 ox, ((ox==NULL || ox->expType==NULL)?"Untyped":ox->expType));}
273                 
274         omxState* os = ox->currentState;
275
276         if (ox->rObj) {
277                 SEXP slot;
278                 PROTECT(slot = GET_SLOT(ox->rObj, install("container")));
279                 if (length(slot) == 1) {
280                         int ex = INTEGER(slot)[0];
281                         ox->container = os->expectationList.at(ex);
282                 }
283
284                 PROTECT(slot = GET_SLOT(ox->rObj, install("submodels")));
285                 if (length(slot)) {
286                         ox->numSubmodels = length(slot);
287                         ox->submodels = Realloc(NULL, length(slot), omxExpectation*);
288                         int *submodel = INTEGER(slot);
289                         for (int ex=0; ex < ox->numSubmodels; ex++) {
290                                 int sx = submodel[ex];
291                                 ox->submodels[ex] = omxExpectationFromIndex(sx, os);
292                                 omxCompleteExpectation(ox->submodels[ex]);
293                         }
294                 }
295
296                 omxExpectationProcessDataStructures(ox, ox->rObj);
297         }
298
299         ox->initFun(ox);
300
301         if(ox->computeFun == NULL) {
302                 // Should never happen
303                 error("Could not initialize Expectation function %s", ox->expType);
304         }
305
306         ox->isComplete = TRUE;
307
308 }
309
310 omxExpectation *
311 omxNewInternalExpectation(const char *expType, omxState* os)
312 {
313         omxExpectation* expect = Calloc(1, omxExpectation);
314
315         /* Switch based on Expectation type. */ 
316         for (size_t ex=0; ex < OMX_STATIC_ARRAY_SIZE(omxExpectationSymbolTable); ex++) {
317                 const omxExpectationTableEntry *entry = omxExpectationSymbolTable + ex;
318                 if(strncmp(expType, entry->name, MAX_STRING_LEN) == 0) {
319                         expect->expType = entry->name;
320                         expect->initFun = entry->initFun;
321                         break;
322                 }
323         }
324
325         if(!expect->initFun) {
326                 Free(expect);
327                 error("Expectation %s not implemented", expType);
328         }
329
330         expect->currentState = os;
331
332         return expect;
333 }
334
335 void omxExpectationPrint(omxExpectation* ox, char* d) {
336         if(ox->printFun != NULL) {
337                 ox->printFun(ox);
338         } else {
339                 mxLog("(Expectation, type %s) ", (ox->expType==NULL?"Untyped":ox->expType));
340         }
341 }