void omxInitRowFitFunction(omxFitFunction* oo) { if(OMX_DEBUG) { mxLog("Initializing Row/Reduce fit function."); } SEXP rObj = oo->rObj; SEXP nextMatrix, nextItem; int numDeps; omxRowFitFunction *newObj = new omxRowFitFunction; if(OMX_DEBUG) {mxLog("Accessing data source."); } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("data"))); newObj->data = omxDataLookupFromState(nextMatrix, oo->matrix->currentState); if(newObj->data == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No data provided to omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("rowAlgebra"))); newObj->rowAlgebra = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState); if(newObj->rowAlgebra == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No row-wise algebra in omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } } { ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("units"))); oo->setUnitsFromName(CHAR(STRING_ELT(nextMatrix, 0))); } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("filteredDataRow"))); newObj->filteredDataRow = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState); } if(newObj->filteredDataRow == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No row results matrix in omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } // Create the original data row from which to filter. newObj->dataRow = omxInitMatrix(newObj->filteredDataRow->rows, newObj->filteredDataRow->cols, TRUE, oo->matrix->currentState); omxCopyMatrix(newObj->filteredDataRow, newObj->dataRow); {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("existenceVector"))); newObj->existenceVector = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState); } // Do we allow NULL existence? (Whoa, man. That's, like, deep, or something.) if(newObj->existenceVector == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No existance matrix in omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("rowResults"))); newObj->rowResults = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState); } if(newObj->rowResults == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No row results matrix in omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("reduceAlgebra"))); newObj->reduceAlgebra = omxMatrixLookupFromState1(nextMatrix, oo->matrix->currentState); } if(newObj->reduceAlgebra == NULL) { char *errstr = (char*) calloc(250, sizeof(char)); sprintf(errstr, "No row reduction algebra in omxRowFitFunction."); omxRaiseError(errstr); free(errstr); } if(OMX_DEBUG) {mxLog("Accessing variable mapping structure."); } {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("dataColumns"))); newObj->dataColumns = omxNewMatrixFromRPrimitive(nextMatrix, oo->matrix->currentState, 0, 0); } if(OMX_DEBUG) { omxPrint(newObj->dataColumns, "Variable mapping"); } if(OMX_DEBUG) {mxLog("Accessing data row dependencies."); } { ScopedProtect p1(nextItem, R_do_slot(rObj, Rf_install("dataRowDeps"))); numDeps = LENGTH(nextItem); newObj->numDataRowDeps = numDeps; newObj->dataRowDeps = (int*) R_alloc(numDeps, sizeof(int)); for(int i = 0; i < numDeps; i++) { newObj->dataRowDeps[i] = INTEGER(nextItem)[i]; } } /* Set up data columns */ EigenVectorAdaptor dc(newObj->dataColumns); omxSetContiguousDataColumns(&(newObj->contiguous), newObj->data, dc); oo->computeFun = omxCallRowFitFunction; oo->destructFun = omxDestroyRowFitFunction; oo->canDuplicate = true; oo->openmpUser = true; oo->argStruct = (void*) newObj; }
static void omxExpectationProcessDataStructures(omxExpectation* ox, SEXP rObj) { int index, numCols, numOrdinal=0; SEXP nextMatrix, itemList, threshMatrix; if(rObj == NULL) return; if(OMX_DEBUG) { mxLog("Accessing variable mapping structure."); } if (R_has_slot(rObj, Rf_install("dataColumns"))) { {ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("dataColumns"))); ox->dataColumns = omxNewMatrixFromRPrimitive(nextMatrix, ox->currentState, 0, 0); } if(OMX_DEBUG) { omxPrint(ox->dataColumns, "Variable mapping"); } numCols = ox->dataColumns->cols; if (R_has_slot(rObj, Rf_install("thresholds"))) { if(OMX_DEBUG) { mxLog("Accessing Threshold matrix."); } ScopedProtect p1(threshMatrix, R_do_slot(rObj, Rf_install("thresholds"))); if(INTEGER(threshMatrix)[0] != NA_INTEGER) { if(OMX_DEBUG) { mxLog("Accessing Threshold Mappings."); } /* Process the data and threshold mapping structures */ /* if (threshMatrix == NA_INTEGER), then we could ignore the slot "thresholdColumns" * and fill all the thresholds with {NULL, 0, 0}. * However the current path does not have a lot of overhead. */ int* thresholdColumn, *thresholdNumber; {ScopedProtect pc(nextMatrix, R_do_slot(rObj, Rf_install("thresholdColumns"))); thresholdColumn = INTEGER(nextMatrix); } {ScopedProtect pi(itemList, R_do_slot(rObj, Rf_install("thresholdLevels"))); thresholdNumber = INTEGER(itemList); } ox->thresholds.reserve(numCols); for(index = 0; index < numCols; index++) { if(thresholdColumn[index] == NA_INTEGER) { // Continuous variable if(OMX_DEBUG) { mxLog("Column %d is continuous.", index); } omxThresholdColumn col; ox->thresholds.push_back(col); } else { omxThresholdColumn col; col.matrix = omxMatrixLookupFromState1(threshMatrix, ox->currentState); col.column = thresholdColumn[index]; col.numThresholds = thresholdNumber[index]; ox->thresholds.push_back(col); if(OMX_DEBUG) { mxLog("Column %d is ordinal with %d thresholds in threshold column %d.", index, thresholdNumber[index], thresholdColumn[index]); } numOrdinal++; } } if(OMX_DEBUG) { mxLog("%d threshold columns processed.", numOrdinal); } ox->numOrdinal = numOrdinal; } else { if (OMX_DEBUG) { mxLog("No thresholds matrix; not processing thresholds."); } ox->numOrdinal = 0; } } } }