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 omxRowFitFunctionSingleIteration(omxFitFunction *localobj, omxFitFunction *sharedobj, int rowbegin, int rowcount,
FitContext *fc) {
omxRowFitFunction* oro = ((omxRowFitFunction*) localobj->argStruct);
omxRowFitFunction* shared_oro = ((omxRowFitFunction*) sharedobj->argStruct);
omxMatrix *rowAlgebra, *rowResults;
omxMatrix *filteredDataRow, *dataRow, *existenceVector;
omxMatrix *dataColumns;
omxData *data;
int isContiguous, contiguousStart, contiguousLength;
int numCols, numRemoves;
rowAlgebra = oro->rowAlgebra;
rowResults = shared_oro->rowResults;
data = oro->data;
dataColumns = oro->dataColumns;
dataRow = oro->dataRow;
filteredDataRow = oro->filteredDataRow;
existenceVector = oro->existenceVector;
isContiguous = oro->contiguous.isContiguous;
contiguousStart = oro->contiguous.start;
contiguousLength = oro->contiguous.length;
Eigen::VectorXd oldDefs;
oldDefs.resize(data->defVars.size());
oldDefs.setConstant(NA_REAL);
numCols = dataColumns->cols;
int *toRemove = (int*) malloc(sizeof(int) * dataColumns->cols);
int *zeros = (int*) calloc(dataColumns->cols, sizeof(int));
for(int row = rowbegin; row < data->rows && (row - rowbegin) < rowcount; row++) {
data->handleDefinitionVarList(localobj->matrix->currentState, row, oldDefs.data());
omxStateNextRow(localobj->matrix->currentState); // Advance row
// Populate data row
numRemoves = 0;
if (isContiguous) {
omxContiguousDataRow(data, row, contiguousStart, contiguousLength, dataRow);
} else {
omxDataRow(data, row, dataColumns, dataRow); // Populate data row
}
markDataRowDependencies(localobj->matrix->currentState, oro);
for(int j = 0; j < dataColumns->cols; j++) {
double dataValue = omxVectorElement(dataRow, j);
if(std::isnan(dataValue)) {
numRemoves++;
toRemove[j] = 1;
omxSetVectorElement(existenceVector, j, 0);
} else {
toRemove[j] = 0;
omxSetVectorElement(existenceVector, j, 1);
}
}
// TODO: Determine if this is the correct response.
if(numRemoves == numCols) {
char *errstr = (char*) calloc(250, sizeof(char));
sprintf(errstr, "Row %d completely missing. omxRowFitFunction cannot have completely missing rows.", omxDataIndex(data, row));
omxRaiseError(errstr);
free(errstr);
continue;
}
omxCopyMatrix(filteredDataRow, dataRow);
omxRemoveRowsAndColumns(filteredDataRow, 0, numRemoves, zeros, toRemove);
omxRecompute(rowAlgebra, fc);
omxCopyMatrixToRow(rowAlgebra, omxDataIndex(data, row), rowResults);
}
free(toRemove);
free(zeros);
}
void omxInitWLSFitFunction(omxFitFunction* oo) {
omxMatrix *cov, *means, *weights;
if(OMX_DEBUG) { mxLog("Initializing WLS FitFunction function."); }
int vectorSize = 0;
omxSetWLSFitFunctionCalls(oo);
if(OMX_DEBUG) { mxLog("Retrieving expectation.\n"); }
if (!oo->expectation) { Rf_error("%s requires an expectation", oo->fitType); }
if(OMX_DEBUG) { mxLog("Retrieving data.\n"); }
omxData* dataMat = oo->expectation->data;
if (dataMat->hasDefinitionVariables()) Rf_error("%s: def vars not implemented", oo->name());
if(!strEQ(omxDataType(dataMat), "acov") && !strEQ(omxDataType(dataMat), "cov")) {
char *errstr = (char*) calloc(250, sizeof(char));
sprintf(errstr, "WLS FitFunction unable to handle data type %s. Data must be of type 'acov'.\n", omxDataType(dataMat));
omxRaiseError(errstr);
free(errstr);
if(OMX_DEBUG) { mxLog("WLS FitFunction unable to handle data type %s. Aborting.", omxDataType(dataMat)); }
return;
}
omxWLSFitFunction *newObj = (omxWLSFitFunction*) R_alloc(1, sizeof(omxWLSFitFunction));
OMXZERO(newObj, 1);
oo->argStruct = (void*)newObj;
oo->units = FIT_UNITS_SQUARED_RESIDUAL;
/* Get Expectation Elements */
newObj->expectedCov = omxGetExpectationComponent(oo->expectation, "cov");
newObj->expectedMeans = omxGetExpectationComponent(oo->expectation, "means");
// FIXME: threshold structure should be asked for by omxGetExpectationComponent
/* Read and set expected means, variances, and weights */
cov = omxDataCovariance(dataMat);
means = omxDataMeans(dataMat);
weights = omxDataAcov(dataMat);
newObj->observedCov = cov;
newObj->observedMeans = means;
newObj->weights = weights;
newObj->n = omxDataNumObs(dataMat);
// NOTE: If there are any continuous columns then these vectors
// will not match because eThresh is indexed by column number
// not by ordinal column number.
std::vector< omxThresholdColumn > &oThresh = omxDataThresholds(oo->expectation->data);
std::vector< omxThresholdColumn > &eThresh = oo->expectation->thresholds;
// Error Checking: Observed/Expected means must agree.
// ^ is XOR: true when one is false and the other is not.
if((newObj->expectedMeans == NULL) ^ (newObj->observedMeans == NULL)) {
if(newObj->expectedMeans != NULL) {
omxRaiseError("Observed means not detected, but an expected means matrix was specified.\n If you wish to model the means, you must provide observed means.\n");
return;
} else {
omxRaiseError("Observed means were provided, but an expected means matrix was not specified.\n If you provide observed means, you must specify a model for the means.\n");
return;
}
}
if((eThresh.size()==0) ^ (oThresh.size()==0)) {
if (eThresh.size()) {
omxRaiseError("Observed thresholds not detected, but an expected thresholds matrix was specified.\n If you wish to model the thresholds, you must provide observed thresholds.\n ");
return;
} else {
omxRaiseError("Observed thresholds were provided, but an expected thresholds matrix was not specified.\nIf you provide observed thresholds, you must specify a model for the thresholds.\n");
return;
}
}
/* Error check weight matrix size */
int ncol = newObj->observedCov->cols;
vectorSize = (ncol * (ncol + 1) ) / 2;
if(newObj->expectedMeans != NULL) {
vectorSize = vectorSize + ncol;
}
for(int i = 0; i < int(oThresh.size()); i++) {
vectorSize = vectorSize + oThresh[i].numThresholds;
}
if(OMX_DEBUG) { mxLog("Intial WLSFitFunction vectorSize comes to: %d.", vectorSize); }
if(weights != NULL && (weights->rows != weights->cols || weights->cols != vectorSize)) {
omxRaiseError("Developer Error in WLS-based FitFunction object: WLS-based expectation specified an incorrectly-sized weight matrix.\nIf you are not developing a new expectation type, you should probably post this to the OpenMx forums.");
return;
}
// FIXME: More Rf_error checking for incoming Fit Functions
/* Temporary storage for calculation */
newObj->observedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->expectedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->standardExpectedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->P = omxInitMatrix(1, vectorSize, TRUE, oo->matrix->currentState);
newObj->B = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->standardExpectedCov = omxInitMatrix(ncol, ncol, TRUE, oo->matrix->currentState);
if (oo->expectation->thresholdsMat) {
newObj->standardExpectedThresholds = omxInitMatrix(oo->expectation->thresholdsMat->rows, oo->expectation->thresholdsMat->cols, TRUE, oo->matrix->currentState);
}
if(means){
newObj->standardExpectedMeans = omxInitMatrix(1, ncol, TRUE, oo->matrix->currentState);
}
omxMatrix *obsThresholdsMat = oo->expectation->data->obsThresholdsMat;
flattenDataToVector(newObj->observedCov, newObj->observedMeans, obsThresholdsMat, oThresh, newObj->observedFlattened);
flattenDataToVector(newObj->expectedCov, newObj->expectedMeans, oo->expectation->thresholdsMat,
eThresh, newObj->expectedFlattened);
}
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));
}
}
