Add thread-safe logging functions
[openmx:openmx.git] / src / omxRowFitFunction.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 #include <R.h>
18 #include <Rinternals.h>
19 #include <Rdefines.h>
20 #include <R_ext/Rdynload.h>
21 #include <R_ext/BLAS.h>
22 #include <R_ext/Lapack.h>
23 #include "omxDefines.h"
24 #include "omxAlgebraFunctions.h"
25 #include "omxSymbolTable.h"
26 #include "omxData.h"
27 #include "omxRowFitFunction.h"
28 #include "omxFIMLFitFunction.h"
29
30 void omxDestroyRowFitFunction(omxFitFunction *oo) {
31
32         omxRowFitFunction* argStruct = (omxRowFitFunction*)(oo->argStruct);
33
34         omxFreeMatrixData(argStruct->dataRow);
35 }
36
37 omxRListElement* omxSetFinalReturnsRowFitFunction(omxFitFunction *oo, int *numReturns) {
38         *numReturns = 0;
39         omxRListElement* retVal = (omxRListElement*) R_alloc(1, sizeof(omxRListElement));
40
41         retVal[0].numValues = 0;
42
43         return retVal;
44 }
45
46
47 void omxCopyMatrixToRow(omxMatrix* source, int row, omxMatrix* target) {
48         
49         int i;
50         for(i = 0; i < source->cols; i++) {
51                 omxSetMatrixElement(target, row, i, omxMatrixElement(source, 0, i));
52         }
53
54 }
55
56 void markDataRowDependencies(omxState* os, omxRowFitFunction* orff) {
57
58         int numDeps = orff->numDataRowDeps;
59         int *deps = orff->dataRowDeps;
60
61         for (int i = 0; i < numDeps; i++) {
62                 int value = deps[i];
63
64                 if(value < 0) {
65                         omxMarkDirty(os->matrixList[~value]);
66                 } else {
67                         omxMarkDirty(os->algebraList[value]);
68                 }
69         }
70
71 }
72
73 void omxRowFitFunctionSingleIteration(omxFitFunction *localobj, omxFitFunction *sharedobj, int rowbegin, int rowcount) {
74
75     omxRowFitFunction* oro = ((omxRowFitFunction*) localobj->argStruct);
76     omxRowFitFunction* shared_oro = ((omxRowFitFunction*) sharedobj->argStruct);
77
78         int numDefs;
79
80     omxMatrix *rowAlgebra, *rowResults;
81     omxMatrix *filteredDataRow, *dataRow, *existenceVector;
82     omxMatrix *dataColumns;
83         omxDefinitionVar* defVars;
84         omxData *data;
85         int isContiguous, contiguousStart, contiguousLength;
86     double* oldDefs;
87     int numCols, numRemoves;
88
89         rowAlgebra          = oro->rowAlgebra;
90         rowResults          = shared_oro->rowResults;
91         data                = oro->data;
92         defVars             = oro->defVars;
93         numDefs             = oro->numDefs;
94     oldDefs         = oro->oldDefs;
95     dataColumns     = oro->dataColumns;
96     dataRow         = oro->dataRow;
97     filteredDataRow = oro->filteredDataRow;
98     existenceVector = oro->existenceVector;
99     
100     isContiguous    = oro->contiguous.isContiguous;
101         contiguousStart = oro->contiguous.start;
102         contiguousLength = oro->contiguous.length;
103
104         numCols = dataColumns->cols;
105         int *toRemove = (int*) malloc(sizeof(int) * dataColumns->cols);
106         int *zeros = (int*) calloc(dataColumns->cols, sizeof(int));
107
108     resetDefinitionVariables(oldDefs, numDefs);
109
110         for(int row = rowbegin; row < data->rows && (row - rowbegin) < rowcount; row++) {
111
112                 // Handle Definition Variables.
113         if(OMX_DEBUG_ROWS(row)) { mxLog("numDefs is %d", numDefs);}
114                 if(numDefs != 0) {              // With defs, just copy repeatedly to the rowResults matrix.
115                         handleDefinitionVarList(data, localobj->matrix->currentState, row, defVars, oldDefs, numDefs);
116                 }
117
118                 omxStateNextRow(localobj->matrix->currentState);                                                // Advance row
119                 
120         // Populate data row
121                 numRemoves = 0;
122         
123                 if (isContiguous) {
124                         omxContiguousDataRow(data, row, contiguousStart, contiguousLength, dataRow);
125                 } else {
126                         omxDataRow(data, row, dataColumns, dataRow);    // Populate data row
127                 }
128
129                 markDataRowDependencies(localobj->matrix->currentState, oro);
130                 
131                 for(int j = 0; j < dataColumns->cols; j++) {
132                         double dataValue = omxVectorElement(dataRow, j);
133                         if(isnan(dataValue)) {
134                                 numRemoves++;
135                                 toRemove[j] = 1;
136                 omxSetVectorElement(existenceVector, j, 0);
137                         } else {
138                             toRemove[j] = 0;
139                 omxSetVectorElement(existenceVector, j, 1);
140                         }
141                 }               
142                 // TODO: Determine if this is the correct response.
143                 
144                 if(numRemoves == numCols) {
145                         char *errstr = (char*) calloc(250, sizeof(char));
146                         sprintf(errstr, "Row %d completely missing.  omxRowFitFunction cannot have completely missing rows.", omxDataIndex(data, row));
147                         omxRaiseError(localobj->matrix->currentState, -1, errstr);
148                         free(errstr);
149                         continue;
150                 }
151
152                 omxResetAliasedMatrix(filteredDataRow);                         // Reset the row
153                 omxRemoveRowsAndColumns(filteredDataRow, 0, numRemoves, zeros, toRemove);
154
155                 omxRecompute(rowAlgebra);                                                       // Compute this row
156
157                 omxCopyMatrixToRow(rowAlgebra, omxDataIndex(data, row), rowResults);
158         }
159         free(toRemove);
160         free(zeros);
161 }
162
163 static void omxCallRowFitFunction(omxFitFunction *oo, int want, double *gradient) {     // TODO: Figure out how to give access to other per-iteration structures.
164     if(OMX_DEBUG) { mxLog("Beginning Row Evaluation.");}
165         // Requires: Data, means, covariances.
166
167         omxMatrix* objMatrix  = oo->matrix;
168         omxState* parentState = objMatrix->currentState;
169         int numChildren = parentState->numChildren;
170
171     omxMatrix *reduceAlgebra;
172         omxData *data;
173
174     omxRowFitFunction* oro = ((omxRowFitFunction*) oo->argStruct);
175
176         reduceAlgebra   = oro->reduceAlgebra;
177         data                = oro->data;
178
179         /* Michael Spiegel, 7/31/12
180         * The demo "RowFitFunctionSimpleExamples" will fail in the parallel 
181         * Hessian calculation if the resizing operation is performed.
182         *
183         omxMatrix *rowAlgebra, *rowResults
184         rowAlgebra          = oro->rowAlgebra;
185         rowResults          = oro->rowResults;
186
187         if(rowResults->cols != rowAlgebra->cols || rowResults->rows != data->rows) {
188                 if(OMX_DEBUG_ROWS(1)) { 
189                         mxLog("Resizing rowResults from %dx%d to %dx%d.", 
190                                 rowResults->rows, rowResults->cols, 
191                                 data->rows, rowAlgebra->cols); 
192                 }
193                 omxResizeMatrix(rowResults, data->rows, rowAlgebra->cols, FALSE);
194         }
195         */
196                 
197     int parallelism = (numChildren == 0) ? 1 : numChildren;
198
199         if (parallelism > data->rows) {
200                 parallelism = data->rows;
201         }
202
203         if (parallelism > 1) {
204                 int stride = (data->rows / parallelism);
205
206                 #pragma omp parallel for num_threads(parallelism) 
207                 for(int i = 0; i < parallelism; i++) {
208                         omxMatrix *childMatrix = omxLookupDuplicateElement(parentState->childList[i], objMatrix);
209                         omxFitFunction *childFit = childMatrix->fitFunction;
210                         if (i == parallelism - 1) {
211                                 omxRowFitFunctionSingleIteration(childFit, oo, stride * i, data->rows - stride * i);
212                         } else {
213                                 omxRowFitFunctionSingleIteration(childFit, oo, stride * i, stride);
214                         }
215                 }
216
217                 for(int i = 0; i < parallelism; i++) {
218                         if (isErrorRaised(parentState->childList[i])) {
219                                 strncpy(parentState->statusMsg, parentState->childList[i]->statusMsg, MAX_STRING_LEN);
220                         }
221                 }
222
223         } else {
224                 omxRowFitFunctionSingleIteration(oo, oo, 0, data->rows);
225         }
226
227         omxRecompute(reduceAlgebra);
228
229         omxCopyMatrix(oo->matrix, reduceAlgebra);
230
231 }
232
233 void omxInitRowFitFunction(omxFitFunction* oo) {
234
235         if(OMX_DEBUG) { mxLog("Initializing Row/Reduce fit function."); }
236
237         SEXP rObj = oo->rObj;
238         SEXP nextMatrix, itemList, nextItem;
239         int nextDef, index, numDeps;
240
241         omxRowFitFunction *newObj = (omxRowFitFunction*) R_alloc(1, sizeof(omxRowFitFunction));
242
243         if(OMX_DEBUG) {mxLog("Accessing data source."); }
244         PROTECT(nextMatrix = GET_SLOT(rObj, install("data")));
245         newObj->data = omxDataLookupFromState(nextMatrix, oo->matrix->currentState);
246         if(newObj->data == NULL) {
247                 char *errstr = (char*) calloc(250, sizeof(char));
248                 sprintf(errstr, "No data provided to omxRowFitFunction.");
249                 omxRaiseError(oo->matrix->currentState, -1, errstr);
250                 free(errstr);
251         }
252         UNPROTECT(1); // nextMatrix
253
254         PROTECT(nextMatrix = GET_SLOT(rObj, install("rowAlgebra")));
255         newObj->rowAlgebra = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState);
256         if(newObj->rowAlgebra == NULL) {
257                 char *errstr = (char*) calloc(250, sizeof(char));
258                 sprintf(errstr, "No row-wise algebra in omxRowFitFunction.");
259                 omxRaiseError(oo->matrix->currentState, -1, errstr);
260                 free(errstr);
261         }
262         UNPROTECT(1);// nextMatrix
263
264         PROTECT(nextMatrix = GET_SLOT(rObj, install("filteredDataRow")));
265         newObj->filteredDataRow = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState);
266         if(newObj->filteredDataRow == NULL) {
267                 char *errstr = (char*) calloc(250, sizeof(char));
268                 sprintf(errstr, "No row results matrix in omxRowFitFunction.");
269                 omxRaiseError(oo->matrix->currentState, -1, errstr);
270                 free(errstr);
271         }
272         // Create the original data row from which to filter.
273     newObj->dataRow = omxInitMatrix(NULL, newObj->filteredDataRow->rows, newObj->filteredDataRow->cols, TRUE, oo->matrix->currentState);
274     omxAliasMatrix(newObj->filteredDataRow, newObj->dataRow);
275         UNPROTECT(1);// nextMatrix
276
277         PROTECT(nextMatrix = GET_SLOT(rObj, install("existenceVector")));
278         newObj->existenceVector = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState);
279     // Do we allow NULL existence?  (Whoa, man. That's, like, deep, or something.)
280         if(newObj->existenceVector == NULL) {
281                 char *errstr = (char*) calloc(250, sizeof(char));
282                 sprintf(errstr, "No existance matrix in omxRowFitFunction.");
283                 omxRaiseError(oo->matrix->currentState, -1, errstr);
284                 free(errstr);
285         }
286         UNPROTECT(1);// nextMatrix
287
288
289         PROTECT(nextMatrix = GET_SLOT(rObj, install("rowResults")));
290         newObj->rowResults = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState);
291         if(newObj->rowResults == NULL) {
292                 char *errstr = (char*) calloc(250, sizeof(char));
293                 sprintf(errstr, "No row results matrix in omxRowFitFunction.");
294                 omxRaiseError(oo->matrix->currentState, -1, errstr);
295                 free(errstr);
296         }
297         UNPROTECT(1);// nextMatrix
298
299         PROTECT(nextMatrix = GET_SLOT(rObj, install("reduceAlgebra")));
300         newObj->reduceAlgebra = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState);
301         if(newObj->reduceAlgebra == NULL) {
302                 char *errstr = (char*) calloc(250, sizeof(char));
303                 sprintf(errstr, "No row reduction algebra in omxRowFitFunction.");
304                 omxRaiseError(oo->matrix->currentState, -1, errstr);
305                 free(errstr);
306         }
307         UNPROTECT(1);// nextMatrix
308         
309         if(OMX_DEBUG) {mxLog("Accessing variable mapping structure."); }
310         PROTECT(nextMatrix = GET_SLOT(rObj, install("dataColumns")));
311         newObj->dataColumns = omxNewMatrixFromRPrimitive(nextMatrix, oo->matrix->currentState, 0, 0);
312         if(OMX_DEBUG) { omxPrint(newObj->dataColumns, "Variable mapping"); }
313         UNPROTECT(1);
314
315         if(OMX_DEBUG) {mxLog("Accessing data row dependencies."); }
316         PROTECT(nextItem = GET_SLOT(rObj, install("dataRowDeps")));
317         numDeps = LENGTH(nextItem);
318         newObj->numDataRowDeps = numDeps;
319         newObj->dataRowDeps = (int*) R_alloc(numDeps, sizeof(int));
320         for(int i = 0; i < numDeps; i++) {
321                 newObj->dataRowDeps[i] = INTEGER(nextItem)[i];
322         }
323         UNPROTECT(1);
324
325         if(OMX_DEBUG) {mxLog("Accessing definition variables structure."); }
326         PROTECT(nextMatrix = GET_SLOT(rObj, install("definitionVars")));
327         newObj->numDefs = length(nextMatrix);
328         newObj->oldDefs = (double *) R_alloc(newObj->numDefs, sizeof(double));          // Storage for Def Vars
329         if(OMX_DEBUG) {mxLog("Number of definition variables is %d.", newObj->numDefs); }
330         newObj->defVars = (omxDefinitionVar *) R_alloc(newObj->numDefs, sizeof(omxDefinitionVar));
331         for(nextDef = 0; nextDef < newObj->numDefs; nextDef++) {
332                 SEXP dataSource, columnSource, depsSource; 
333
334                 PROTECT(itemList = VECTOR_ELT(nextMatrix, nextDef));
335                 PROTECT(dataSource = VECTOR_ELT(itemList, 0));
336                 if(OMX_DEBUG) {mxLog("Data source number is %d.", INTEGER(dataSource)[0]); }
337                 newObj->defVars[nextDef].data = INTEGER(dataSource)[0];
338                 newObj->defVars[nextDef].source = oo->matrix->currentState->dataList[INTEGER(dataSource)[0]];
339                 PROTECT(columnSource = VECTOR_ELT(itemList, 1));
340                 if(OMX_DEBUG) {mxLog("Data column number is %d.", INTEGER(columnSource)[0]); }
341                 newObj->defVars[nextDef].column = INTEGER(columnSource)[0];
342                 PROTECT(depsSource = VECTOR_ELT(itemList, 2));
343                 numDeps = LENGTH(depsSource);
344                 newObj->defVars[nextDef].numDeps = numDeps;
345                 newObj->defVars[nextDef].deps = (int*) R_alloc(numDeps, sizeof(int));
346                 for(int i = 0; i < numDeps; i++) {
347                         newObj->defVars[nextDef].deps[i] = INTEGER(depsSource)[i];
348                 }
349                 UNPROTECT(3); // unprotect dataSource, columnSource, and depsSource
350
351                 newObj->defVars[nextDef].numLocations = length(itemList) - 3;
352                 newObj->defVars[nextDef].matrices = (int *) R_alloc(length(itemList) - 3, sizeof(int));
353                 newObj->defVars[nextDef].rows = (int *) R_alloc(length(itemList) - 3, sizeof(int));
354                 newObj->defVars[nextDef].cols = (int *) R_alloc(length(itemList) - 3, sizeof(int));
355
356                 for(index = 3; index < length(itemList); index++) {
357                         PROTECT(nextItem = VECTOR_ELT(itemList, index));
358                         newObj->defVars[nextDef].matrices[index-3] = INTEGER(nextItem)[0];
359                         newObj->defVars[nextDef].rows[index-3]     = INTEGER(nextItem)[1];
360                         newObj->defVars[nextDef].cols[index-3]     = INTEGER(nextItem)[2];
361                         UNPROTECT(1); // unprotect nextItem
362                 }
363                 UNPROTECT(1); // unprotect itemList
364         }
365         UNPROTECT(1); // unprotect nextMatrix
366         
367         /* Set up data columns */
368         omxSetContiguousDataColumns(&(newObj->contiguous), newObj->data, newObj->dataColumns);
369
370         oo->computeFun = omxCallRowFitFunction;
371         oo->setFinalReturns = omxSetFinalReturnsRowFitFunction;
372         oo->destructFun = omxDestroyRowFitFunction;
373         oo->repopulateFun = handleFreeVarList;
374         oo->usesChildModels = TRUE;
375
376         oo->argStruct = (void*) newObj;
377 }
378
379