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