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;
}
}
}
}
