Revert "Refrain from duplicating the model unless required by the fitfunction"
[openmx:openmx.git] / src / omxFIMLFitFunction.c
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 "omxFIMLFitFunction.h"
28 #include "omxFIMLSingleIteration.h"
29 #include "omxSadmvnWrapper.h"
30
31 #define max(a,b) \
32    ({ __typeof__ (a) _a = (a); \
33        __typeof__ (b) _b = (b); \
34      _a > _b ? _a : _b; })
35
36 /* FIML Function body */
37 void omxDestroyFIMLFitFunction(omxFitFunction *off) {
38         if(OMX_DEBUG) { Rprintf("Destroying FIML fit function object.\n"); }
39         omxFIMLFitFunction *argStruct = (omxFIMLFitFunction*) (off->argStruct);
40
41         if(argStruct->smallMeans != NULL) omxFreeMatrixData(argStruct->smallMeans);
42         if(argStruct->ordMeans != NULL) omxFreeMatrixData(argStruct->ordMeans);
43         if(argStruct->contRow != NULL) omxFreeMatrixData(argStruct->contRow);
44         if(argStruct->ordRow != NULL) omxFreeMatrixData(argStruct->ordRow);
45         if(argStruct->ordCov != NULL) omxFreeMatrixData(argStruct->ordCov);
46         if(argStruct->ordContCov != NULL) omxFreeMatrixData(argStruct->ordContCov);
47         if(argStruct->halfCov != NULL) omxFreeMatrixData(argStruct->halfCov);
48         if(argStruct->reduceCov != NULL) omxFreeMatrixData(argStruct->reduceCov);
49
50         if(argStruct->smallRow != NULL) omxFreeMatrixData(argStruct->smallRow);
51         if(argStruct->smallCov != NULL) omxFreeMatrixData(argStruct->smallCov);
52         if(argStruct->RCX != NULL)              omxFreeMatrixData(argStruct->RCX);
53     if(argStruct->rowLikelihoods != NULL) omxFreeMatrixData(argStruct->rowLikelihoods);
54     if(argStruct->rowLogLikelihoods != NULL) omxFreeMatrixData(argStruct->rowLogLikelihoods);
55         if(off->expectation == NULL) {
56                 if(argStruct->cov != NULL) omxFreeMatrixData(argStruct->cov);
57                 if(argStruct->means != NULL) omxFreeMatrixData(argStruct->means);
58         }
59 }
60
61 void omxPopulateFIMLAttributes(omxFitFunction *off, SEXP algebra) {
62         omxFIMLFitFunction *argStruct = ((omxFIMLFitFunction*)off->argStruct);
63         SEXP expCovExt, expMeanExt, rowLikelihoodsExt;
64         omxMatrix *expCovInt, *expMeanInt, *rowLikelihoodsInt;
65         expCovInt = argStruct->cov;
66         expMeanInt = argStruct->means;
67         rowLikelihoodsInt = argStruct->rowLikelihoods;
68
69         PROTECT(expCovExt = allocMatrix(REALSXP, expCovInt->rows, expCovInt->cols));
70         for(int row = 0; row < expCovInt->rows; row++)
71                 for(int col = 0; col < expCovInt->cols; col++)
72                         REAL(expCovExt)[col * expCovInt->rows + row] =
73                                 omxMatrixElement(expCovInt, row, col);
74         if (expMeanInt != NULL) {
75                 PROTECT(expMeanExt = allocMatrix(REALSXP, expMeanInt->rows, expMeanInt->cols));
76                 for(int row = 0; row < expMeanInt->rows; row++)
77                         for(int col = 0; col < expMeanInt->cols; col++)
78                                 REAL(expMeanExt)[col * expMeanInt->rows + row] =
79                                         omxMatrixElement(expMeanInt, row, col);
80         } else {
81                 PROTECT(expMeanExt = allocMatrix(REALSXP, 0, 0));               
82         }
83         PROTECT(rowLikelihoodsExt = allocVector(REALSXP, rowLikelihoodsInt->rows));
84         for(int row = 0; row < rowLikelihoodsInt->rows; row++)
85                 REAL(rowLikelihoodsExt)[row] = omxMatrixElement(rowLikelihoodsInt, row, 0);
86
87         setAttrib(algebra, install("expCov"), expCovExt);
88         setAttrib(algebra, install("expMean"), expMeanExt);
89         setAttrib(algebra, install("likelihoods"), rowLikelihoodsExt);
90
91         UNPROTECT(3); // expCovExp, expCovInt, rowLikelihoodsExt
92 }
93
94 omxRListElement* omxSetFinalReturnsFIMLFitFunction(omxFitFunction *off, int *numReturns) {
95
96         omxFIMLFitFunction* ofiml = (omxFIMLFitFunction *) (off->argStruct);
97
98         omxRListElement* retVal;
99
100         *numReturns = 1;
101
102         if(!ofiml->returnRowLikelihoods) {
103                 retVal = (omxRListElement*) R_alloc(1, sizeof(omxRListElement));
104         } else {
105                 retVal = (omxRListElement*) R_alloc(2, sizeof(omxRListElement));
106         }
107
108         retVal[0].numValues = 1;
109         retVal[0].values = (double*) R_alloc(1, sizeof(double));
110         strncpy(retVal[0].label, "Minus2LogLikelihood", 20);
111         retVal[0].values[0] = omxMatrixElement(off->matrix, 0, 0);
112
113
114         if(ofiml->returnRowLikelihoods) {
115                 omxData* data = ofiml->data;
116                 retVal[1].numValues = data->rows;
117                 retVal[1].values = (double*) R_alloc(data->rows, sizeof(double));
118         }
119
120         return retVal;
121 }
122
123 void markDefVarDependencies(omxState* os, omxDefinitionVar* defVar) {
124
125         int numDeps = defVar->numDeps;
126         int *deps = defVar->deps;
127
128         omxMatrix** matrixList = os->matrixList;
129         omxMatrix** algebraList = os->algebraList;
130
131         for (int i = 0; i < numDeps; i++) {
132                 int value = deps[i];
133
134                 if(value < 0) {
135                         omxMarkDirty(matrixList[~value]);
136                 } else {
137                         omxMarkDirty(algebraList[value]);
138                 }
139         }
140
141 }
142
143 int handleDefinitionVarList(omxData* data, omxState *state, int row, omxDefinitionVar* defVars, double* oldDefs, int numDefs) {
144
145         if(OMX_DEBUG_ROWS(row)) { Rprintf("Processing Definition Vars.\n"); }
146         
147         int numVarsFilled = 0;
148
149         /* Fill in Definition Var Estimates */
150         for(int k = 0; k < numDefs; k++) {
151                 if(defVars[k].source != data) {
152                         omxRaiseError(data->currentState, -1, 
153                                         "Internal error: definition variable population into incorrect data source");
154                         error("Internal error: definition variable population into incorrect data source"); // Kept for historical reasons
155                         continue; //Do not populate this variable.
156                 }
157                 double newDefVar = omxDoubleDataElement(data, row, defVars[k].column);
158                 if(ISNA(newDefVar)) {
159                         omxRaiseError(data->currentState, -1, "Error: NA value for a definition variable is Not Yet Implemented.");
160                         error("Error: NA value for a definition variable is Not Yet Implemented."); // Kept for historical reasons
161                         return -1;
162                 }
163                 if(newDefVar == oldDefs[k]) {
164                         continue;       // NOTE: Potential speedup vs accuracy tradeoff here using epsilon comparison
165                 }
166                 oldDefs[k] = newDefVar;
167                 numVarsFilled++;
168
169                 for(int l = 0; l < defVars[k].numLocations; l++) {
170                         if(OMX_DEBUG_ROWS(row)) {
171                                 Rprintf("Populating column %d (value %3.2f) into matrix %d.\n", defVars[k].column, omxDoubleDataElement(defVars[k].source, row, defVars[k].column), defVars[k].matrices[l]);
172                         }
173                         int matrixNumber = defVars[k].matrices[l];
174                         int matrow = defVars[k].rows[l];
175                         int matcol = defVars[k].cols[l];
176                         omxMatrix *matrix = state->matrixList[matrixNumber];
177                         omxSetMatrixElement(matrix, matrow, matcol, newDefVar);
178                 }
179                 markDefVarDependencies(state, &(defVars[k]));
180         }
181         return numVarsFilled;
182 }
183
184 static void omxCallJointFIMLFitFunction(omxFitFunction *off, int want, double *gradient) {      
185         // TODO: Figure out how to give access to other per-iteration structures.
186         // TODO: Current implementation is slow: update by filtering correlations and thresholds.
187         // TODO: Current implementation does not implement speedups for sorting.
188         // TODO: Current implementation may fail on all-continuous-missing or all-ordinal-missing rows.
189         
190     if(OMX_DEBUG) { 
191             Rprintf("Beginning Joint FIML Evaluation.\n");
192     }
193         // Requires: Data, means, covariances, thresholds
194
195         int numDefs;
196
197         int returnRowLikelihoods = 0;
198
199         omxMatrix *cov, *means, *dataColumns;
200
201         omxThresholdColumn *thresholdCols;
202         omxData* data;
203         
204         omxExpectation* expectation;
205
206         omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*)off->argStruct);
207         omxMatrix* fitMatrix  = off->matrix;
208         omxState* parentState = fitMatrix->currentState;
209         int numChildren = parentState->numChildren;
210
211         cov             = ofiml->cov;
212         means           = ofiml->means;
213         data            = ofiml->data;                            //  read-only
214         numDefs         = ofiml->numDefs;                         //  read-only
215         dataColumns     = ofiml->dataColumns;
216         thresholdCols = ofiml->thresholdCols;
217
218         returnRowLikelihoods = ofiml->returnRowLikelihoods;   //  read-only
219         expectation = off->expectation;
220
221
222     if(numDefs == 0) {
223         if(OMX_DEBUG) {Rprintf("Precalculating cov and means for all rows.\n");}
224                 omxExpectationRecompute(expectation);
225                 // MCN Also do the threshold formulae!
226                 
227                 for(int j=0; j < dataColumns->cols; j++) {
228                         int var = omxVectorElement(dataColumns, j);
229                         if(omxDataColumnIsFactor(data, j) && thresholdCols[var].numThresholds > 0) { // j is an ordinal column
230                                 omxMatrix* nextMatrix = thresholdCols[var].matrix;
231                                 omxRecompute(nextMatrix);
232                                 checkIncreasing(nextMatrix, thresholdCols[var].column);
233                                 for(int index = 0; index < numChildren; index++) {
234                                         omxMatrix *target = omxLookupDuplicateElement(parentState->childList[index], nextMatrix);
235                                         omxCopyMatrix(target, nextMatrix);
236                                 }
237             }
238         }
239                 for(int index = 0; index < numChildren; index++) {
240                         omxMatrix *childFit = omxLookupDuplicateElement(parentState->childList[index], fitMatrix);
241                         omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
242                         omxCopyMatrix(childOfiml->cov, cov);
243                         omxCopyMatrix(childOfiml->means, means);
244                 }
245         if(OMX_DEBUG) { omxPrintMatrix(cov, "Cov"); }
246         if(OMX_DEBUG) { omxPrintMatrix(means, "Means"); }
247     }
248
249         memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
250     
251         int parallelism = (numChildren == 0) ? 1 : numChildren;
252
253         if (parallelism > data->rows) {
254                 parallelism = data->rows;
255         }
256
257         if (parallelism > 1) {
258                 int stride = (data->rows / parallelism);
259
260                 #pragma omp parallel for num_threads(parallelism) 
261                 for(int i = 0; i < parallelism; i++) {
262                         omxMatrix *childMatrix = omxLookupDuplicateElement(parentState->childList[i], fitMatrix);
263                         omxFitFunction *childFit = childMatrix->fitFunction;
264                         if (i == parallelism - 1) {
265                                 omxFIMLSingleIterationJoint(childFit, off, stride * i, data->rows - stride * i);
266                         } else {
267                                 omxFIMLSingleIterationJoint(childFit, off, stride * i, stride);
268                         }
269                 }
270
271                 for(int i = 0; i < parallelism; i++) {
272                         if (parentState->childList[i]->statusCode < 0) {
273                                 parentState->statusCode = parentState->childList[i]->statusCode;
274                                 strncpy(parentState->statusMsg, parentState->childList[i]->statusMsg, 249);
275                                 parentState->statusMsg[249] = '\0';
276                         }
277                 }
278
279         } else {
280                 omxFIMLSingleIterationJoint(off, off, 0, data->rows);
281         }
282
283         if(!returnRowLikelihoods) {
284                 double val, sum = 0.0;
285                 // floating-point addition is not associative,
286                 // so we serialized the following reduction operation.
287                 for(int i = 0; i < data->rows; i++) {
288                         val = omxVectorElement(ofiml->rowLogLikelihoods, i);
289 //                      Rprintf("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
290                         sum += val;
291                 }       
292                 if(OMX_VERBOSE || OMX_DEBUG) {Rprintf("Total Likelihood is %3.3f\n", sum);}
293                 omxSetMatrixElement(off->matrix, 0, 0, sum);
294         }
295
296 }
297
298 static void omxCallFIMLFitFunction(omxFitFunction *off, int want, double *gradient) {   // TODO: Figure out how to give access to other per-iteration structures.
299
300         if(OMX_DEBUG) { Rprintf("Beginning FIML Evaluation.\n"); }
301         // Requires: Data, means, covariances.
302         // Potential Problem: Definition variables currently are assumed to be at the end of the data matrix.
303
304         int numDefs, returnRowLikelihoods;      
305         omxExpectation* expectation;
306         
307         omxMatrix *cov, *means;//, *oldInverse;
308         omxData *data;
309
310         omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*) off->argStruct);
311         omxMatrix* objMatrix  = off->matrix;
312         omxState* parentState = objMatrix->currentState;
313         int numChildren = parentState->numChildren;
314
315         // Locals, for readability.  Should compile out.
316         cov             = ofiml->cov;
317         means           = ofiml->means;
318         data            = ofiml->data;                            //  read-only
319         numDefs         = ofiml->numDefs;                         //  read-only
320         returnRowLikelihoods = ofiml->returnRowLikelihoods;   //  read-only
321         expectation = off->expectation;
322
323         if(numDefs == 0 && strcmp(expectation->expType, "omxStateSpaceExpectation")) {
324                 if(OMX_DEBUG) {Rprintf("Precalculating cov and means for all rows.\n");}
325                 omxExpectationCompute(expectation);
326                 
327                 for(int index = 0; index < numChildren; index++) {
328                         omxMatrix *childFit = omxLookupDuplicateElement(parentState->childList[index], objMatrix);
329                         omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
330                         omxCopyMatrix(childOfiml->cov, cov);
331                         omxCopyMatrix(childOfiml->means, means);
332                 }
333
334                 if(OMX_DEBUG) { omxPrintMatrix(cov, "Cov"); }
335                 if(OMX_DEBUG) { omxPrintMatrix(means, "Means"); }
336         }
337
338         memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
339     
340         int parallelism = (numChildren == 0) ? 1 : numChildren;
341
342         if (parallelism > data->rows) {
343                 parallelism = data->rows;
344         }
345
346         if (parallelism > 1) {
347                 int stride = (data->rows / parallelism);
348
349                 #pragma omp parallel for num_threads(parallelism) 
350                 for(int i = 0; i < parallelism; i++) {
351                         omxMatrix *childMatrix = omxLookupDuplicateElement(parentState->childList[i], objMatrix);
352                         omxFitFunction *childFit = childMatrix->fitFunction;
353                         if (i == parallelism - 1) {
354                                 omxFIMLSingleIteration(childFit, off, stride * i, data->rows - stride * i);
355                         } else {
356                                 omxFIMLSingleIteration(childFit, off, stride * i, stride);
357                         }
358                 }
359
360                 for(int i = 0; i < parallelism; i++) {
361                         if (parentState->childList[i]->statusCode < 0) {
362                                 parentState->statusCode = parentState->childList[i]->statusCode;
363                                 strncpy(parentState->statusMsg, parentState->childList[i]->statusMsg, 249);
364                                 parentState->statusMsg[249] = '\0';
365                         }
366                 }
367
368         } else {
369                 omxFIMLSingleIteration(off, off, 0, data->rows);
370         }
371
372         if(!returnRowLikelihoods) {
373                 double val, sum = 0.0;
374                 // floating-point addition is not associative,
375                 // so we serialized the following reduction operation.
376                 for(int i = 0; i < data->rows; i++) {
377                         val = omxVectorElement(ofiml->rowLogLikelihoods, i);
378 //                      Rprintf("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
379                         sum += val;
380                 }       
381                 if(OMX_VERBOSE || OMX_DEBUG) {Rprintf("Total Likelihood is %3.3f\n", sum);}
382                 omxSetMatrixElement(off->matrix, 0, 0, sum);
383         }
384 }
385
386 static void omxCallFIMLOrdinalFitFunction(omxFitFunction *off, int want, double *gradient) {    // TODO: Figure out how to give access to other per-iteration structures.
387         /* TODO: Current implementation is slow: update by filtering correlations and thresholds. */
388         if(OMX_DEBUG) { Rprintf("Beginning Ordinal FIML Evaluation.\n");}
389         // Requires: Data, means, covariances, thresholds
390
391         int numDefs;
392         int returnRowLikelihoods = 0;
393
394         omxMatrix *cov, *means, *dataColumns;
395         omxThresholdColumn *thresholdCols;
396         omxData* data;
397         double *corList, *weights;
398         
399         omxExpectation* expectation;
400
401         omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*)off->argStruct);
402         omxMatrix* objMatrix  = off->matrix;
403         omxState* parentState = objMatrix->currentState;
404         int numChildren = parentState->numChildren;
405
406         // Locals, for readability.  Compiler should cut through this.
407         cov             = ofiml->cov;
408         means           = ofiml->means;
409         data            = ofiml->data;
410         dataColumns     = ofiml->dataColumns;
411         numDefs         = ofiml->numDefs;
412
413         corList         = ofiml->corList;
414         weights         = ofiml->weights;
415         thresholdCols = ofiml->thresholdCols;
416         returnRowLikelihoods = ofiml->returnRowLikelihoods;
417         
418         expectation = off->expectation;
419         
420         if(numDefs == 0) {
421                 if(OMX_DEBUG_ALGEBRA) { Rprintf("No Definition Vars: precalculating."); }
422                 omxExpectationCompute(expectation);
423                 for(int j = 0; j < dataColumns->cols; j++) {
424                         if(thresholdCols[j].numThresholds > 0) { // Actually an ordinal column
425                                 omxMatrix* nextMatrix = thresholdCols[j].matrix;
426                                 omxRecompute(nextMatrix);
427                                 checkIncreasing(nextMatrix, thresholdCols[j].column);
428                                 for(int index = 0; index < numChildren; index++) {
429                                         omxMatrix *target = omxLookupDuplicateElement(parentState->childList[index], nextMatrix);
430                                         omxCopyMatrix(target, nextMatrix);
431                                 }
432                         }
433                 }
434                 omxStandardizeCovMatrix(cov, corList, weights); // Calculate correlation and covariance
435                 for(int index = 0; index < numChildren; index++) {
436                         omxMatrix *childFit = omxLookupDuplicateElement(parentState->childList[index], objMatrix);
437                         omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
438                         omxCopyMatrix(childOfiml->cov, cov);
439                         omxCopyMatrix(childOfiml->means, means);
440                         memcpy(childOfiml->weights, weights, sizeof(double) * cov->rows);
441                         memcpy(childOfiml->corList, corList, sizeof(double) * (cov->rows * (cov->rows - 1)) / 2);
442                 }
443         }
444
445         memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
446
447         int parallelism = (numChildren == 0) ? 1 : numChildren;
448
449         if (parallelism > data->rows) {
450                 parallelism = data->rows;
451         }
452
453         if (parallelism > 1) {
454                 int stride = (data->rows / parallelism);
455
456                 #pragma omp parallel for num_threads(parallelism) 
457                 for(int i = 0; i < parallelism; i++) {
458                         omxMatrix *childMatrix = omxLookupDuplicateElement(parentState->childList[i], objMatrix);
459                         omxFitFunction *childFit = childMatrix->fitFunction;
460                         if (i == parallelism - 1) {
461                                 omxFIMLSingleIterationOrdinal(childFit, off, stride * i, data->rows - stride * i);
462                         } else {
463                                 omxFIMLSingleIterationOrdinal(childFit, off, stride * i, stride);
464                         }
465                 }
466
467                 for(int i = 0; i < parallelism; i++) {
468                         if (parentState->childList[i]->statusCode < 0) {
469                                 parentState->statusCode = parentState->childList[i]->statusCode;
470                                 strncpy(parentState->statusMsg, parentState->childList[i]->statusMsg, 249);
471                                 parentState->statusMsg[249] = '\0';
472                         }
473                 }
474
475         } else {
476                 omxFIMLSingleIterationOrdinal(off, off, 0, data->rows);
477         }
478
479         if(!returnRowLikelihoods) {
480                 double val, sum = 0.0;
481                 // floating-point addition is not associative,
482                 // so we serialized the following reduction operation.
483                 for(int i = 0; i < data->rows; i++) {
484                         val = omxVectorElement(ofiml->rowLogLikelihoods, i);
485 //                      Rprintf("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
486                         sum += val;
487                 }       
488                 if(OMX_VERBOSE || OMX_DEBUG) {Rprintf("Total Likelihood is %3.3f\n", sum);}
489                 omxSetMatrixElement(off->matrix, 0, 0, sum);
490         }
491 }
492
493 void omxInitFIMLFitFunction(omxFitFunction* off, SEXP rObj) {
494
495         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
496                 Rprintf("Initializing FIML fit function function.\n");
497         }
498
499         SEXP nextMatrix;
500         int numOrdinal = 0, numContinuous = 0;
501         omxMatrix *cov, *means;
502
503         omxFIMLFitFunction *newObj = (omxFIMLFitFunction*) R_alloc(1, sizeof(omxFIMLFitFunction));
504         omxExpectation* expectation = off->expectation;
505         if(expectation == NULL) {
506                 omxRaiseError(off->matrix->currentState, -1, "FIML cannot fit without model expectations.");
507                 return;
508         }
509
510         cov = omxGetExpectationComponent(expectation, off, "cov");
511         if(cov == NULL) { 
512                 omxRaiseError(off->matrix->currentState, -1, "No covariance expectation in FIML evaluation.");
513                 return;
514         }
515
516         means = omxGetExpectationComponent(expectation, off, "means");
517         
518         if(means == NULL) { 
519                 omxRaiseError(off->matrix->currentState, -1, "No means model in FIML evaluation.");
520                 return;
521         }
522
523         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
524                 Rprintf("FIML Initialization Completed.");
525         }
526         
527     newObj->cov = cov;
528     newObj->means = means;
529     newObj->smallMeans = NULL;
530     newObj->ordMeans   = NULL;
531     newObj->contRow    = NULL;
532     newObj->ordRow     = NULL;
533     newObj->ordCov     = NULL;
534     newObj->ordContCov = NULL;
535     newObj->halfCov    = NULL;
536     newObj->reduceCov  = NULL;
537     
538     /* Set default FitFunction calls to FIML FitFunction Calls */
539         off->computeFun = omxCallFIMLFitFunction;
540         off->fitType = "omxFIMLFitFunction";
541         off->setFinalReturns = omxSetFinalReturnsFIMLFitFunction;
542         off->destructFun = omxDestroyFIMLFitFunction;
543         off->populateAttrFun = omxPopulateFIMLAttributes;
544         off->repopulateFun = NULL;
545         
546
547         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
548                 Rprintf("Accessing data source.\n");
549         }
550         newObj->data = off->expectation->data;
551
552         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
553                 Rprintf("Accessing row likelihood option.\n");
554         }
555         PROTECT(nextMatrix = AS_INTEGER(GET_SLOT(rObj, install("vector")))); // preparing the object by using the vector to populate and the flag
556         newObj->returnRowLikelihoods = INTEGER(nextMatrix)[0];
557         if(newObj->returnRowLikelihoods) {
558            omxResizeMatrix(off->matrix, newObj->data->rows, 1, FALSE); // 1=column matrix, FALSE=discards memory as this is a one time resize
559     }
560     newObj->rowLikelihoods = omxInitMatrix(NULL, newObj->data->rows, 1, TRUE, off->matrix->currentState);
561     newObj->rowLogLikelihoods = omxInitMatrix(NULL, newObj->data->rows, 1, TRUE, off->matrix->currentState);
562         UNPROTECT(1); // nextMatrix
563
564         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
565                 Rprintf("Accessing variable mapping structure.\n");
566         }
567         newObj->dataColumns = off->expectation->dataColumns;
568
569         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
570                 Rprintf("Accessing Threshold matrix.\n");
571         }
572         newObj->thresholdCols = off->expectation->thresholds;
573         numOrdinal = off->expectation->numOrdinal;
574         numContinuous = newObj->dataColumns->cols - off->expectation->numOrdinal;
575
576         omxSetContiguousDataColumns(&(newObj->contiguous), newObj->data, newObj->dataColumns);
577         
578         newObj->numDefs = off->expectation->numDefs;
579         newObj->defVars = off->expectation->defVars;
580         newObj->oldDefs = (double *) R_alloc(newObj->numDefs, sizeof(double));          // Storage for Def Vars
581
582         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
583                 Rprintf("Accessing definition variables structure.\n");
584         }
585         newObj->oldDefs = (double *) R_alloc(newObj->numDefs, sizeof(double));          // Storage for Def Vars
586         memset(newObj->oldDefs, NA_REAL, sizeof(double) * newObj->numDefs);                     // Does this work?
587         // for(nextDef = 0; nextDef < newObj->numDefs; nextDef++) {
588         //      newObj->oldDefs[nextDef] = NA_REAL;                                     // Def Vars default to NA
589         // }
590
591     /* Temporary storage for calculation */
592     int covCols = newObj->cov->cols;
593         if(OMX_DEBUG){Rprintf("Number of columns found is %d", covCols);}
594     // int ordCols = omxDataNumFactor(newObj->data);        // Unneeded, since we don't use it.
595     // int contCols = omxDataNumNumeric(newObj->data);
596     newObj->smallRow = omxInitMatrix(NULL, 1, covCols, TRUE, off->matrix->currentState);
597     newObj->smallCov = omxInitMatrix(NULL, covCols, covCols, TRUE, off->matrix->currentState);
598     newObj->RCX = omxInitMatrix(NULL, 1, covCols, TRUE, off->matrix->currentState);
599 //  newObj->zeros = omxInitMatrix(NULL, 1, newObj->cov->cols, TRUE, off->matrix->currentState);
600
601     omxAliasMatrix(newObj->smallCov, newObj->cov);          // Will keep its aliased state from here on.
602     off->argStruct = (void*)newObj;
603
604     if(numOrdinal > 0 && numContinuous <= 0) {
605         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
606             Rprintf("Ordinal Data detected.  Using Ordinal FIML.");
607         }
608         newObj->weights = (double*) R_alloc(covCols, sizeof(double));
609         newObj->smallMeans = omxInitMatrix(NULL, covCols, 1, TRUE, off->matrix->currentState);
610         omxAliasMatrix(newObj->smallMeans, newObj->means);
611         newObj->corList = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
612         newObj->smallCor = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
613         newObj->lThresh = (double*) R_alloc(covCols, sizeof(double));
614         newObj->uThresh = (double*) R_alloc(covCols, sizeof(double));
615         newObj->Infin = (int*) R_alloc(covCols, sizeof(int));
616
617         off->computeFun = omxCallFIMLOrdinalFitFunction;
618     } else if(numOrdinal > 0) {
619         if(OMX_DEBUG && off->matrix->currentState->parentState == NULL) {
620             Rprintf("Ordinal and Continuous Data detected.  Using Joint Ordinal/Continuous FIML.");
621         }
622
623         newObj->weights = (double*) R_alloc(covCols, sizeof(double));
624         newObj->smallMeans = omxInitMatrix(NULL, covCols, 1, TRUE, off->matrix->currentState);
625         newObj->ordMeans = omxInitMatrix(NULL, covCols, 1, TRUE, off->matrix->currentState);
626         newObj->contRow = omxInitMatrix(NULL, covCols, 1, TRUE, off->matrix->currentState);
627         newObj->ordRow = omxInitMatrix(NULL, covCols, 1, TRUE, off->matrix->currentState);
628         newObj->ordCov = omxInitMatrix(NULL, covCols, covCols, TRUE, off->matrix->currentState);
629         newObj->ordContCov = omxInitMatrix(NULL, covCols, covCols, TRUE, off->matrix->currentState);
630         newObj->halfCov = omxInitMatrix(NULL, covCols, covCols, TRUE, off->matrix->currentState);
631         newObj->reduceCov = omxInitMatrix(NULL, covCols, covCols, TRUE, off->matrix->currentState);
632         omxAliasMatrix(newObj->smallMeans, newObj->means);
633         omxAliasMatrix(newObj->ordMeans, newObj->means);
634         omxAliasMatrix(newObj->contRow, newObj->smallRow );
635         omxAliasMatrix(newObj->ordRow, newObj->smallRow );
636         omxAliasMatrix(newObj->ordCov, newObj->cov);
637         omxAliasMatrix(newObj->ordContCov, newObj->cov);
638         omxAliasMatrix(newObj->smallMeans, newObj->means);
639         newObj->corList = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
640         newObj->lThresh = (double*) R_alloc(covCols, sizeof(double));
641         newObj->uThresh = (double*) R_alloc(covCols, sizeof(double));
642         newObj->Infin = (int*) R_alloc(covCols, sizeof(int));
643
644         off->computeFun = omxCallJointFIMLFitFunction;
645     }
646 }