Add thread-safe logging functions
[openmx:openmx.git] / src / omxData.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  *  omxData.cc
20  *
21  *  Created: Timothy R. Brick   Date: 2009-07-15
22  *
23  *      Contains code for the omxData class
24  *   omxData objects hold data in whatever form it takes
25  *
26  **********************************************************/
27 #include "omxData.h"
28 #include "npsolWrap.h"
29 #include "omxState.h"
30
31 omxData* omxInitData(omxState* os) {
32
33         omxData *od = Calloc(1, omxData);
34
35         od->currentState = os;
36
37         if(OMX_DEBUG) {mxLog("Data's state object is at 0x%x.", od->currentState);}
38
39         if (os != globalState) error("Too late to create omxData");
40         os->dataList.push_back(od);
41
42         return od;
43
44 }
45
46 omxData* omxDataLookupFromState(SEXP dataObject, omxState* state) {
47         int dataIdx = INTEGER(dataObject)[0];
48
49         return state->dataList[dataIdx];
50 }
51
52 omxData* omxNewDataFromMxData(SEXP dataObject, omxState* state) {
53         if(OMX_DEBUG) {mxLog("Initializing data Element.");}
54         if(dataObject == NULL) {
55                 error("Null Data Object detected.  This is an internal error, and should be reported on the forums.\n");
56         }
57
58         omxData* od = omxInitData(state);
59
60         SEXP dataLoc, dataVal;
61         int numCols;
62
63         // PARSE MxData Structure
64         if(OMX_DEBUG) {mxLog("Processing Data Type.");}
65         PROTECT(dataLoc = GET_SLOT(dataObject, install("type")));
66         if(dataLoc == NULL) { error("Data has no type.  Sorry.\nThis is an internal error, and should be reported on the forums.\n");}
67         PROTECT(dataVal = STRING_ELT(dataLoc,0));
68         od->_type = CHAR(dataVal);
69         if(OMX_DEBUG) {mxLog("Element is type %s.", od->_type);}
70
71         PROTECT(dataLoc = GET_SLOT(dataObject, install("observed")));
72         if(OMX_DEBUG) {mxLog("Processing Data Elements.");}
73         if(isFrame(dataLoc)) {
74                 if(OMX_DEBUG) {mxLog("Data is a frame.");}
75                 // Process Data Frame into Columns
76                 od->cols = length(dataLoc);
77                 if(OMX_DEBUG) {mxLog("Data has %d columns.", od->cols);}
78                 numCols = od->cols;
79                 od->realData = (double**) R_alloc(numCols, sizeof(double*));
80                 OMXZERO(od->realData, numCols);
81                 od->intData = (int**) R_alloc(numCols, sizeof(int*));
82                 OMXZERO(od->intData, numCols);
83                 od->location = (int*) R_alloc(numCols, sizeof(int));
84                 for(int j = 0; j < numCols; j++) {
85                         SEXP rcol;
86                         PROTECT(rcol = VECTOR_ELT(dataLoc, j));
87                         if(isFactor(rcol)) {
88                                 if(OMX_DEBUG) {mxLog("Column %d is a factor.", j);}
89                                 od->intData[j] = INTEGER(rcol);
90                                 od->location[j] = ~j;
91                                 od->numFactor++;
92                         } else if (isInteger(rcol)) {
93                                 error("Internal error: Column %d is in integer format.", j);
94                         } else {
95                                 if(OMX_DEBUG) {mxLog("Column %d is a numeric.", j);}
96                                 od->realData[j] = REAL(rcol);
97                                 od->location[j] = j;
98                                 od->numNumeric++;
99                         }
100                 }
101                 od->rows = length(VECTOR_ELT(dataLoc, 0));
102                 if(OMX_DEBUG) {mxLog("And %d rows.", od->rows);}
103         } else {
104                 if(OMX_DEBUG) {mxLog("Data contains a matrix.");}
105                 od->dataMat = omxNewMatrixFromRPrimitive(dataLoc, od->currentState, 0, 0);
106                 
107                 if (od->dataMat->colMajor && strncmp(od->_type, "raw", 3) == 0) { 
108                         omxToggleRowColumnMajor(od->dataMat);
109                 }
110                 od->cols = od->dataMat->cols;
111                 od->rows = od->dataMat->rows;
112                 od->numNumeric = od->cols;
113         }
114
115         if(OMX_DEBUG) {mxLog("Processing Means Matrix.");}
116         PROTECT(dataLoc = GET_SLOT(dataObject, install("means")));
117         od->meansMat = omxNewMatrixFromRPrimitive(dataLoc, od->currentState, 0, 0);
118         if(od->meansMat->rows == 1 && od->meansMat->cols == 1 && 
119            (!R_finite(omxMatrixElement(od->meansMat, 0, 0)) ||
120             !isfinite(omxMatrixElement(od->meansMat, 0, 0)))) {
121                 omxFreeMatrixData(od->meansMat); // Clear just-allocated memory.
122                 od->meansMat = NULL;  // 1-by-1 matrix of NAs is a null means matrix.
123                 // FIXME: The above check may cause problems for dynamic data if the means
124                 //          originally is a 1x1 that has not yet been calculated.  This should be
125                 //          adjusted.
126         }
127         
128         if(OMX_DEBUG) {
129                 if(od->meansMat == NULL) {mxLog("No means found.");}
130                 else {omxPrint(od->meansMat, "Means Matrix is:");}
131         }
132
133         if(OMX_DEBUG) {mxlog("Processing Asymptotic Covariance Matrix.");}
134         PROTECT(dataLoc = GET_SLOT(dataObject, install("acov")));
135         od->acovMat = omxNewMatrixFromRPrimitive(dataLoc, od->currentState, 0, 0);
136         if(od->acovMat->rows == 1 && od->acovMat->cols == 1 && 
137            (!R_finite(omxMatrixElement(od->acovMat, 0, 0)) ||
138             !isfinite(omxMatrixElement(od->acovMat, 0, 0)))) {
139                 omxFreeMatrixData(od->acovMat); // Clear just-allocated memory.
140                 od->acovMat = NULL;
141         }
142
143         if(OMX_DEBUG) {mxLog("Processing Observed Thresholds Matrix.");}
144         PROTECT(dataLoc = GET_SLOT(dataObject, install("thresholds")));
145         od->obsThresholdsMat = omxNewMatrixFromRPrimitive(dataLoc, od->currentState, 0, 0);
146         if(od->obsThresholdsMat->rows == 1 && od->obsThresholdsMat->cols == 1 && 
147            (!R_finite(omxMatrixElement(od->obsThresholdsMat, 0, 0)) ||
148             !isfinite(omxMatrixElement(od->obsThresholdsMat, 0, 0)))) {
149                 omxFreeMatrixData(od->obsThresholdsMat); // Clear just-allocated memory.
150                 od->obsThresholdsMat = NULL;
151         }
152
153         if(strncmp(od->_type, "raw", 3) != 0) {
154                 if(OMX_DEBUG) {mxLog("Processing Observation Count.");}
155                 PROTECT(dataLoc = GET_SLOT(dataObject, install("numObs")));
156                 od->numObs = REAL(dataLoc)[0];
157         } else {
158                 od->numObs = od->rows;
159                 if(OMX_DEBUG) {mxLog("Processing presort metadata.");}
160                 /* For raw data, process sorting metadata. */
161                 // Process unsorted indices:  // TODO: Generate reverse lookup table
162                 PROTECT(dataLoc = GET_SLOT(dataObject, install("indexVector")));
163                 od->indexVector = INTEGER(dataLoc);
164                 if(od->indexVector[0] == R_NaInt) od->indexVector = NULL;
165                 // Process pre-computed identicality checks
166                 if(OMX_DEBUG) {mxLog("Processing definition variable identicality.");}
167                 PROTECT(dataLoc = GET_SLOT(dataObject, install("identicalDefVars")));
168                 od->identicalDefs = INTEGER(dataLoc);
169                 if(od->identicalDefs[0] == R_NaInt) od->identicalDefs = NULL;
170                 if(OMX_DEBUG) {mxLog("Processing missingness identicality.");}
171                 PROTECT(dataLoc = GET_SLOT(dataObject, install("identicalMissingness")));
172                 od->identicalMissingness = INTEGER(dataLoc);
173                 if(od->identicalMissingness[0] == R_NaInt) od->identicalMissingness = NULL;
174                 if(OMX_DEBUG) {mxLog("Processing row identicality.");}
175                 PROTECT(dataLoc = GET_SLOT(dataObject, install("identicalRows")));
176                 od->identicalRows = INTEGER(dataLoc);
177                 if(od->identicalRows[0] == R_NaInt) od->identicalRows = NULL;
178         }
179
180         return od;
181 }
182
183 void resetDefinitionVariables(double *oldDefs, int numDefs) {
184         int nextDef;
185
186         for(nextDef = 0; nextDef < numDefs; nextDef++) {
187                 oldDefs[nextDef] = NA_REAL;                                     // Def Vars default to NA
188         }
189
190 }
191
192 void omxFreeData(omxData* od) {
193         omxFreeAllMatrixData(od->dataMat);
194         omxFreeAllMatrixData(od->meansMat);
195         omxFreeAllMatrixData(od->acovMat);
196         omxFreeAllMatrixData(od->obsThresholdsMat);
197         Free(od);
198 }
199
200 double omxDoubleDataElement(omxData *od, int row, int col) {
201         if(od->dataMat != NULL) {
202                 return omxMatrixElement(od->dataMat, row, col);
203         }
204         int location = od->location[col];
205         if(location < 0) {
206                 return (double)(od->intData[~location][row]);
207         } else {
208                 return od->realData[location][row];
209         }
210 }
211
212 int omxIntDataElement(omxData *od, int row, int col) {
213         if(od->dataMat != NULL) {
214                 error("Use a data frame for factor data");
215         }
216
217         int location = od->location[col];
218         if(location < 0) {
219                 return (od->intData[~location][row]);
220         } else {
221                 return (int)(od->realData[location][row]);
222         }
223 }
224
225 omxMatrix* omxDataMatrix(omxData *od, omxMatrix* om) {
226         double dataElement;
227
228         if(od->dataMat != NULL) {               // Data was entered as a matrix.
229                 if(om != NULL) {                        // It stays as such
230                         omxCopyMatrix(om, od->dataMat);
231                         return om;
232                 }
233                 return od->dataMat;
234         }
235         // Otherwise, we must construct the matrix.
236         int numRows = od->rows, numCols = od->cols;
237
238         if(om == NULL) {
239                 om = omxInitMatrix(om, numRows, numCols, TRUE, od->currentState);
240         }
241
242         if(om->rows != numRows || om->cols != numCols) {
243                 omxResizeMatrix(om, numRows, numCols, FALSE);
244         }
245
246         for(int j = 0; j < numCols; j++) {
247                 for(int k = 0; k < numRows; k++) {
248                         int location = od->location[j];
249                         if(location < 0) {
250                                 dataElement = (double) od->intData[~location][k];
251                         } else {
252                                 dataElement = od->realData[location][k];
253                         }
254                         omxSetMatrixElement(om, k, j, dataElement);
255                 }
256         }
257         return om;
258 }
259
260 omxMatrix* omxDataAcov(omxData *od, omxMatrix* om) {
261         double dataElement;
262         
263         if(od->acovMat != NULL) {               // acov was entered as a matrix.
264                 if(om != NULL) {                        // It stays as such
265                         omxCopyMatrix(om, od->acovMat);
266                         return om;
267                 }
268                 return od->acovMat;
269         }
270         // Otherwise, we must construct the matrix.
271         int numRows = ( (od->rows)*(od->rows + 1) ) / 2;
272         
273         if(om == NULL) {
274                 om = omxInitMatrix(om, numRows, numRows, TRUE, od->currentState);
275         }
276         
277         if(om->rows != numRows || om->cols != numRows) {
278                 omxResizeMatrix(om, numRows, numRows, FALSE);
279         }
280         
281         // The below is wrong.  I'm unsure how to populate the acov matrix. -MDH
282         for(int j = 0; j < numRows; j++) {
283                 for(int k = 0; k < numRows; k++) {
284                         int location = od->location[j];
285                         if(location < 0) {
286                                 dataElement = (double) od->intData[~location][k];
287                         } else {
288                                 dataElement = od->realData[location][k];
289                         }
290                         omxSetMatrixElement(om, k, j, dataElement);
291                 }
292         }
293         return om;
294 }
295
296 unsigned short int omxDataColumnIsFactor(omxData *od, int col) {
297         if(od->dataMat != NULL) return FALSE;
298         if(col <= od->cols) return (od->location[col] < 0);
299
300         error("Attempted to access column %d of a %d-column data object", col, od->cols);
301         return 0; // not reached
302 }
303
304 omxMatrix* omxDataMeans(omxData *od, omxMatrix* colList, omxMatrix* om) {
305
306         if(od->meansMat == NULL) return NULL;
307
308         if(colList == NULL) {
309                 if(om == NULL) return od->meansMat;
310                 omxCopyMatrix(om, od->meansMat);
311                 return om;
312         }
313
314         int cols = colList->cols;
315
316         if(colList == NULL || cols == 0 || cols > od->cols) {
317                 cols = od->cols;
318                 if(om == NULL) return od->meansMat;
319                 omxCopyMatrix(om, od->meansMat);
320                 return om;
321         }
322
323         if(om == NULL) {
324                 om = omxInitMatrix(om, 1, cols, TRUE, od->currentState);
325         }
326
327         for(int i = 0; i < cols; i++) {
328                 omxSetMatrixElement(om, 1, i, omxVectorElement(od->meansMat, omxVectorElement(colList, i)));
329         }
330
331         return om;
332 }
333
334 //omxThresholdColumn* omxDataThresholds(omxData *od) {
335 //      return ;
336 //}
337
338 void omxSetContiguousDataColumns(omxContiguousData* contiguous, omxData* data, omxMatrix* colList) {
339
340         contiguous->isContiguous = FALSE;   // Assume not contiguous
341
342         if (data->dataMat == NULL) return; // Data has no matrix elements, so skip.
343
344         omxMatrix* dataMat = data->dataMat;
345         if (dataMat->colMajor) return;      // If data matrix is column-major, there's no continuity
346         
347         int colListLength = colList->cols;              // # of columns in the cov matrix
348         double start = omxVectorElement(colList, 0);    // Data col of first column of the covariance
349         contiguous->start = (int) start;                // That's our starting point.
350         contiguous->length = colListLength;             // And the length is ncol(cov)
351         
352         for(int i = 1; i < colListLength; i++) {        // Make sure that the col list is 
353                 double next = omxVectorElement(colList, i); // contiguously increasing in column number
354                 if (next != (start + i)) return;            // If it isn't, it's not contiguous data
355         }
356         
357         contiguous->isContiguous = TRUE;    // Passed.  This is contiguous.
358 }
359
360 void omxContiguousDataRow(omxData *od, int row, int start, int length, omxMatrix* om) {
361         // TODO: Might be better to combine this with omxDataRow to make a single accessor omxDataRow with a second signature that accepts an omxContiguousData argument.
362         if(row >= od->rows) error("Invalid row");
363
364         if(om == NULL) error("Must provide an output matrix");
365         
366         int numcols = od->cols;
367         omxMatrix* dataMat = od->dataMat;
368         double *dest = om->data;
369         double *source = dataMat->data + row * numcols + start;
370         memcpy(dest, source, sizeof(double) * length);
371 }
372
373 void omxDataRow(omxData *od, int row, omxMatrix* colList, omxMatrix* om) {
374
375         if(colList == NULL || row >= od->rows) error("Invalid row or colList");
376
377         if(om == NULL) error("Must provide an output matrix");
378
379         int numcols = om->cols;
380         if(od->dataMat != NULL) { // Matrix Object
381                 omxMatrix* dataMat = od->dataMat;
382                 for(int j = 0; j < numcols; j++) {
383                         omxSetMatrixElement(om, 0, j, omxMatrixElement(dataMat, row, 
384                                                                        omxVectorElement(colList, j)));
385                 }
386         } else {                // Data Frame object
387                 double dataElement;
388                 int* locations = od->location;
389                 int** intDataColumns = od->intData;
390                 double **realDataColumns = od->realData;
391                 for(int j = 0; j < numcols; j++) {
392                         int location = locations[(int)omxVectorElement(colList, j)];
393                         if(location < 0) {
394                                 dataElement = (double) intDataColumns[~location][row];
395                         } else {
396                                 dataElement = realDataColumns[location][row];
397                         }
398                         omxSetMatrixElement(om, 0, j, dataElement);
399                 }
400         }
401 }
402
403 int omxDataIndex(omxData *od, int row) {
404         if(od->indexVector != NULL)
405                 return od->indexVector[row];
406         else return row;
407 }
408
409 int omxDataNumIdenticalRows(omxData *od, int row) {
410         if(od->identicalRows != NULL)
411                 return od->identicalRows[row];
412         else return 1;
413 }
414 int omxDataNumIdenticalMissingness(omxData *od, int row) {
415         if(od->identicalMissingness != NULL)
416                 return od->identicalMissingness[row];
417         else return 1;
418 }
419
420 int omxDataNumIdenticalDefs(omxData *od, int row){
421         if(od->identicalDefs != NULL)
422                 return od->identicalDefs[row];
423         else return 1;
424 }
425
426 int omxDataNumIdenticalContinuousRows(omxData *od, int row) {
427         if(od->numNumeric <= 0) {
428                 return od->rows;
429         }
430         return omxDataNumIdenticalRows(od, row);
431 }
432
433 int omxDataNumIdenticalContinuousMissingness(omxData *od, int row) {
434         if(od->numNumeric <= 0) {
435                 return od->rows;
436         }
437         return omxDataNumIdenticalMissingness(od, row);
438 }
439
440 int omxDataNumIdenticalOrdinalRows(omxData *od, int row) {
441         if(od->numFactor <= 0) {
442                 return od->rows;
443         }
444         return omxDataNumIdenticalRows(od, row);
445 }
446
447 int omxDataNumIdenticalOrdinalMissingness(omxData *od, int row) {
448         if(od->numFactor <= 0) {
449                 return od->rows;
450         }
451         return omxDataNumIdenticalMissingness(od, row);
452 }
453
454
455 double omxDataNumObs(omxData *od) {
456         return od->numObs;
457 }
458
459 int omxDataNumFactor(omxData *od) {
460         return od->numFactor;
461 }
462
463 int omxDataNumNumeric(omxData *od) {
464         return od->numNumeric;
465 }
466
467
468 const char *omxDataType(omxData *od) {
469         return od->_type;
470 }
471
472 int elementEqualsDataframe(SEXP column, int offset1, int offset2) {
473         switch (TYPEOF(column)) {
474         case REALSXP:
475                 if(ISNA(REAL(column)[offset1])) return ISNA(REAL(column)[offset2]);
476                 if(ISNA(REAL(column)[offset2])) return ISNA(REAL(column)[offset1]);
477                 return(REAL(column)[offset1] == REAL(column)[offset2]);
478         case LGLSXP:
479         case INTSXP:
480                 return(INTEGER(column)[offset1] == INTEGER(column)[offset2]);           
481         }
482         return(0);
483 }
484
485 int testRowDataframe(SEXP data, int numrow, int numcol, int i, int *row, int base) {
486         SEXP column;
487         int j, equal = TRUE;
488
489         if (i == numrow) {
490                 equal = FALSE;
491         } else {
492                 for(j = 0; j < numcol && equal; j++) {
493                         column = VECTOR_ELT(data, j);
494                         equal = elementEqualsDataframe(column, base, i);
495                 }
496         }
497
498         if (!equal) {
499                 int gap = i - base;
500                 for(j = 0; j < gap; j++) {
501                         row[base + j] = gap - j;
502                 }
503                 base = i;
504         }
505         return(base);
506 }
507
508 int elementEqualsMatrix(SEXP data, int row1, int row2, int numrow, int col) {
509         int coloffset = col * numrow;
510         switch (TYPEOF(data)) {
511         case REALSXP:
512                 if(ISNA(REAL(data)[row1 + coloffset])) return ISNA(REAL(data)[row2 + coloffset]);
513                 if(ISNA(REAL(data)[row2 + coloffset])) return ISNA(REAL(data)[row1 + coloffset]);
514                 return(REAL(data)[row1 + coloffset] == REAL(data)[row2 + coloffset]);
515         case LGLSXP:
516         case INTSXP:
517                 return(INTEGER(data)[row1 + coloffset] == INTEGER(data)[row2 + coloffset]);
518         }
519         return(0);
520 }
521
522 int testRowMatrix(SEXP data, int numrow, int numcol, int i, int *row, int base) {
523         int j, equal = TRUE;
524
525         if (i == numrow) {
526                 equal = FALSE;
527         } else {
528                 for(j = 0; j < numcol && equal; j++) {
529                         equal = elementEqualsMatrix(data, i, base, numrow, j);
530                 }
531         }
532
533         if (!equal) {
534                 int gap = i - base;
535                 for(j = 0; j < gap; j++) {
536                         row[base + j] = gap - j;
537                 }
538                 base = i;
539         }
540         return(base);
541 }
542
543 SEXP findIdenticalMatrix(SEXP data, SEXP missing, SEXP defvars,
544                          SEXP skipMissingExp, SEXP skipDefvarsExp) {
545
546         SEXP retval, identicalRows, identicalMissing, identicalDefvars;
547         int i, numrow, numcol, defvarcol;
548         int *irows, *imissing, *idefvars;
549         int baserows, basemissing, basedefvars;
550         int skipMissing, skipDefvars;
551
552         skipMissing = LOGICAL(skipMissingExp)[0];
553         skipDefvars = LOGICAL(skipDefvarsExp)[0];
554         numrow = nrows(data);
555         numcol = ncols(data);
556         defvarcol = ncols(defvars);
557         PROTECT(retval = allocVector(VECSXP, 3));
558         PROTECT(identicalRows = allocVector(INTSXP, numrow));
559         PROTECT(identicalMissing = allocVector(INTSXP, numrow));
560         PROTECT(identicalDefvars = allocVector(INTSXP, numrow));
561         irows = INTEGER(identicalRows);
562         imissing = INTEGER(identicalMissing);
563         idefvars = INTEGER(identicalDefvars);
564         if (skipMissing) {
565                 for(i = 0; i < numrow; i++) {
566                         imissing[i] = numrow - i;
567                 }
568         }
569         if (skipDefvars) {
570                 for(i = 0; i < numrow; i++) {
571                         idefvars[i] = numrow - i;
572                 }
573         }
574         baserows = 0;
575         basemissing = 0;
576         basedefvars = 0;
577         for(i = 1; i <= numrow; i++) {
578                 baserows = testRowMatrix(data, numrow, numcol, i, irows, baserows); 
579                 if (!skipMissing) {
580                         basemissing = testRowMatrix(missing, numrow, numcol, i, imissing, basemissing); 
581                 }
582                 if (!skipDefvars) {
583                         basedefvars = testRowMatrix(defvars, numrow, defvarcol, i, idefvars, basedefvars);
584                 }
585         }
586         SET_VECTOR_ELT(retval, 0, identicalRows);
587         SET_VECTOR_ELT(retval, 1, identicalMissing);
588         SET_VECTOR_ELT(retval, 2, identicalDefvars);
589         UNPROTECT(4); // retval, identicalRows, identicalMissing, identicalDefvars
590         return retval;
591 }
592
593 SEXP findIdenticalDataFrame(SEXP data, SEXP missing, SEXP defvars,
594                             SEXP skipMissingExp, SEXP skipDefvarsExp) {
595
596         SEXP retval, identicalRows, identicalMissing, identicalDefvars;
597         int i, numrow, numcol, defvarcol;
598         int *irows, *imissing, *idefvars;
599         int baserows, basemissing, basedefvars;
600         int skipMissing, skipDefvars;
601
602         skipMissing = LOGICAL(skipMissingExp)[0];
603         skipDefvars = LOGICAL(skipDefvarsExp)[0];
604         numrow = length(VECTOR_ELT(data, 0));
605         numcol = length(data);
606         defvarcol = length(defvars);
607         PROTECT(retval = allocVector(VECSXP, 3));
608         PROTECT(identicalRows = allocVector(INTSXP, numrow));
609         PROTECT(identicalMissing = allocVector(INTSXP, numrow));
610         PROTECT(identicalDefvars = allocVector(INTSXP, numrow));
611         irows = INTEGER(identicalRows);
612         imissing = INTEGER(identicalMissing);
613         idefvars = INTEGER(identicalDefvars);
614         if (skipMissing) {
615                 for(i = 0; i < numrow; i++) {
616                         imissing[i] = numrow - i;
617                 }
618         }
619         if (skipDefvars) {
620                 for(i = 0; i < numrow; i++) {
621                         idefvars[i] = numrow - i;
622                 }
623         }
624         baserows = 0;
625         basemissing = 0;
626         basedefvars = 0;
627         for(i = 1; i <= numrow; i++) {
628                 baserows = testRowDataframe(data, numrow, numcol, i, irows, baserows); 
629                 if (!skipMissing) {
630                         basemissing = testRowMatrix(missing, numrow, numcol, i, imissing, basemissing);
631                 }
632                 if (!skipDefvars) {
633                         basedefvars = testRowDataframe(defvars, numrow, defvarcol, i, idefvars, basedefvars);
634                 }
635         }
636         SET_VECTOR_ELT(retval, 0, identicalRows);
637         SET_VECTOR_ELT(retval, 1, identicalMissing);
638         SET_VECTOR_ELT(retval, 2, identicalDefvars);
639         UNPROTECT(4); // retval, identicalRows, identicalMissing, identicalDefvars
640         return retval;
641 }
642
643 SEXP findIdenticalRowsData2(SEXP data, SEXP missing, SEXP defvars,
644                            SEXP skipMissingness, SEXP skipDefvars) {
645         if (isMatrix(data)) {
646                 return(findIdenticalMatrix(data, missing, defvars, skipMissingness, skipDefvars));
647         } else {
648                 return(findIdenticalDataFrame(data, missing, defvars, skipMissingness, skipDefvars));
649         }
650 }
651
652 SEXP findIdenticalRowsData(SEXP data, SEXP missing, SEXP defvars,
653                            SEXP skipMissingness, SEXP skipDefvars)
654 {
655         omxManageProtectInsanity protectManager;
656
657         try {
658                 return findIdenticalRowsData2(data, missing, defvars,
659                                               skipMissingness, skipDefvars);
660         } catch( std::exception& __ex__ ) {
661                 exception_to_try_error( __ex__ );
662         } catch(...) {
663                 string_to_try_error( "c++ exception (unknown reason)" );
664         }
665 }
666
667
668 void omxPrintData(omxData *od, const char *header) {
669         if (!header) error("omxPrintData: header is NULL");
670
671         if (!od) {
672                 mxLog("%s: NULL", header);
673                 return;
674         }
675
676         mxLog("%s(%s): %f observations %d x %d", header, od->_type, od->numObs,
677                 od->rows, od->cols);
678         mxLog("numNumeric %d numFactor %d", od->numNumeric, od->numFactor);
679
680         if (od->location) {
681                 for(int j = 0; j < od->cols; j++) {
682                         int loc = od->location[j];
683                         if (loc < 0) {
684                                 mxLog("Integer[%d]:", j);
685                                 int *val = od->intData[~loc];
686                                 for (int vx=0; vx < od->numObs; vx++) {
687                                         mxLog(" %d", val[vx]);
688                                 }
689                         } else {
690                                 mxLog("Numeric[%d]:", j);
691                                 double *val = od->realData[loc];
692                                 for (int vx=0; vx < od->numObs; vx++) {
693                                         mxLog(" %.3g", val[vx]);
694                                 }
695                         }
696                 }
697         }
698
699         if (od->identicalRows) {
700                 mxLog("\trow\tmissing\tdefvars");
701                 for(int j = 0; j < od->rows; j++) {
702                         mxLog("[%d]\t%d\t%d\t%d", j, od->identicalRows[j],
703                                 od->identicalMissingness[j], od->identicalDefs[j]);
704                 }
705         }
706
707         if (od->dataMat) omxPrintMatrix(od->dataMat, "dataMat");
708         if (od->meansMat) omxPrintMatrix(od->meansMat, "meansMat");
709 }
710