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;
}
void omxInitFIMLFitFunction(omxFitFunction* off)
{
if(OMX_DEBUG) {
mxLog("Initializing FIML fit function function.");
}
off->canDuplicate = TRUE;
SEXP rObj = off->rObj;
int numOrdinal = 0, numContinuous = 0;
omxMatrix *cov, *means;
omxFIMLFitFunction *newObj = new omxFIMLFitFunction;
omxExpectation* expectation = off->expectation;
if(expectation == NULL) {
omxRaiseError("FIML cannot fit without model expectations.");
return;
}
cov = omxGetExpectationComponent(expectation, "cov");
if(cov == NULL) {
omxRaiseError("No covariance expectation in FIML evaluation.");
return;
}
means = omxGetExpectationComponent(expectation, "means");
if(OMX_DEBUG) {
mxLog("FIML Initialization Completed.");
}
newObj->cov = cov;
newObj->means = means;
newObj->smallMeans = NULL;
newObj->ordMeans = NULL;
newObj->contRow = NULL;
newObj->ordRow = NULL;
newObj->ordCov = NULL;
newObj->ordContCov = NULL;
newObj->halfCov = NULL;
newObj->reduceCov = NULL;
off->computeFun = CallFIMLFitFunction;
newObj->corList = NULL;
newObj->weights = NULL;
newObj->SingleIterFn = omxFIMLSingleIterationJoint;
off->destructFun = omxDestroyFIMLFitFunction;
off->populateAttrFun = omxPopulateFIMLAttributes;
if(OMX_DEBUG) {
mxLog("Accessing data source.");
}
newObj->data = off->expectation->data;
if(OMX_DEBUG) {
mxLog("Accessing row likelihood option.");
}
newObj->returnRowLikelihoods = Rf_asInteger(R_do_slot(rObj, Rf_install("vector")));
newObj->rowLikelihoods = omxInitMatrix(newObj->data->rows, 1, TRUE, off->matrix->currentState);
newObj->rowLogLikelihoods = omxInitMatrix(newObj->data->rows, 1, TRUE, off->matrix->currentState);
if(OMX_DEBUG) {
mxLog("Accessing row likelihood population option.");
}
newObj->populateRowDiagnostics = Rf_asInteger(R_do_slot(rObj, Rf_install("rowDiagnostics")));
if(OMX_DEBUG) {
mxLog("Accessing variable mapping structure.");
}
newObj->dataColumns = off->expectation->dataColumns;
if(OMX_DEBUG) {
mxLog("Accessing Threshold matrix.");
}
numOrdinal = off->expectation->numOrdinal;
numContinuous = newObj->dataColumns->cols - numOrdinal;
omxSetContiguousDataColumns(&(newObj->contiguous), newObj->data, newObj->dataColumns);
/* Temporary storage for calculation */
int covCols = newObj->cov->cols;
if(OMX_DEBUG){mxLog("Number of columns found is %d", covCols);}
// int ordCols = omxDataNumFactor(newObj->data); // Unneeded, since we don't use it.
// int contCols = omxDataNumNumeric(newObj->data);
newObj->smallRow = omxInitMatrix(1, covCols, TRUE, off->matrix->currentState);
newObj->smallCov = omxInitMatrix(covCols, covCols, TRUE, off->matrix->currentState);
newObj->RCX = omxInitMatrix(1, covCols, TRUE, off->matrix->currentState);
// newObj->zeros = omxInitMatrix(1, newObj->cov->cols, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->smallCov, newObj->cov); // Will keep its aliased state from here on.
if (means) {
newObj->smallMeans = omxInitMatrix(covCols, 1, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->smallMeans, newObj->means);
newObj->ordMeans = omxInitMatrix(covCols, 1, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->ordMeans, newObj->means);
}
newObj->contRow = omxInitMatrix(covCols, 1, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->contRow, newObj->smallRow );
newObj->ordCov = omxInitMatrix(covCols, covCols, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->ordCov, newObj->cov);
newObj->ordRow = omxInitMatrix(covCols, 1, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->ordRow, newObj->smallRow );
newObj->Infin = (int*) R_alloc(covCols, sizeof(int));
off->argStruct = (void*)newObj;
//if (strEQ(expectation->expType, "MxExpectationStateSpace")) {
// newObj->SingleIterFn = omxFIMLSingleIteration; // remove this TODO
//}
if(numOrdinal > 0 && numContinuous <= 0) {
if(OMX_DEBUG) {
mxLog("Ordinal Data detected. Using Ordinal FIML.");
}
newObj->weights = (double*) R_alloc(covCols, sizeof(double));
newObj->corList = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
newObj->smallCor = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
newObj->lThresh = (double*) R_alloc(covCols, sizeof(double));
newObj->uThresh = (double*) R_alloc(covCols, sizeof(double));
} else if(numOrdinal > 0) {
if(OMX_DEBUG) {
mxLog("Ordinal and Continuous Data detected. Using Joint Ordinal/Continuous FIML.");
}
newObj->weights = (double*) R_alloc(covCols, sizeof(double));
newObj->ordContCov = omxInitMatrix(covCols, covCols, TRUE, off->matrix->currentState);
newObj->halfCov = omxInitMatrix(covCols, covCols, TRUE, off->matrix->currentState);
newObj->reduceCov = omxInitMatrix(covCols, covCols, TRUE, off->matrix->currentState);
omxCopyMatrix(newObj->ordContCov, newObj->cov);
newObj->corList = (double*) R_alloc(covCols * (covCols + 1) / 2, sizeof(double));
newObj->lThresh = (double*) R_alloc(covCols, sizeof(double));
newObj->uThresh = (double*) R_alloc(covCols, sizeof(double));
}
}
