void MarkovExpectation::compute(FitContext *fc, const char *what, const char *how)
{
if (fc) {
for (auto c1 : components) {
c1->compute(fc, what, how);
}
}
omxRecompute(initial, fc);
if (initialV != omxGetMatrixVersion(initial)) {
omxCopyMatrix(scaledInitial, initial);
EigenVectorAdaptor Ei(scaledInitial);
if (scale == SCALE_SOFTMAX) Ei.derived() = Ei.array().exp();
if (scale != SCALE_NONE) {
Ei /= Ei.sum();
}
if (verbose >= 2) mxPrintMat("initial", Ei);
initialV = omxGetMatrixVersion(initial);
}
if (transition) {
omxRecompute(transition, fc);
if (transitionV != omxGetMatrixVersion(transition)) {
omxCopyMatrix(scaledTransition, transition);
EigenArrayAdaptor Et(scaledTransition);
if (scale == SCALE_SOFTMAX) Et.derived() = Et.array().exp();
if (scale != SCALE_NONE) {
Eigen::ArrayXd v = Et.colwise().sum();
Et.rowwise() /= v.transpose();
}
if (verbose >= 2) mxPrintMat("transition", Et);
transitionV = omxGetMatrixVersion(transition);
}
}
}
omxMatrix* omxDuplicateMatrix(omxMatrix* src, omxState* newState) {
omxMatrix* newMat;
if(src == NULL) return NULL;
newMat = omxInitMatrix(src->rows, src->cols, TRUE, newState);
omxCopyMatrix(newMat, src);
newMat->hasMatrixNumber = src->hasMatrixNumber;
newMat->matrixNumber = src->matrixNumber;
newMat->nameStr = src->nameStr;
newMat->rownames = src->rownames;
newMat->colnames = src->colnames;
return newMat;
}
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;
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;
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++) {
mxLogSetCurrentRow(row);
data->loadDefVars(localobj->matrix->currentState, row);
// Populate data row
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++) {
if(omxDataElementMissing(data, row, j)) {
toRemove[j] = 1;
omxSetVectorElement(existenceVector, j, 0);
} else {
toRemove[j] = 0;
omxSetVectorElement(existenceVector, j, 1);
}
}
omxCopyMatrix(filteredDataRow, dataRow);
omxRemoveRowsAndColumns(filteredDataRow, zeros, toRemove);
omxRecompute(rowAlgebra, fc);
omxCopyMatrixToRow(rowAlgebra, row, rowResults);
}
free(toRemove);
free(zeros);
}
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 omxCallRowFitFunction(omxFitFunction *oo, int want, FitContext *fc)
{
if (want & (FF_COMPUTE_INITIAL_FIT | FF_COMPUTE_PREOPTIMIZE)) return;
if(OMX_DEBUG) { mxLog("Beginning Row Evaluation.");}
// Requires: Data, means, covariances.
omxMatrix* objMatrix = oo->matrix;
int numChildren = fc? fc->childList.size() : 0;
omxMatrix *reduceAlgebra;
omxData *data;
omxRowFitFunction* oro = ((omxRowFitFunction*) oo->argStruct);
reduceAlgebra = oro->reduceAlgebra;
data = oro->data;
/* Michael Spiegel, 7/31/12
* The demo "RowFitFunctionSimpleExamples" will fail in the parallel
* Hessian calculation if the resizing operation is performed.
*
omxMatrix *rowAlgebra, *rowResults
rowAlgebra = oro->rowAlgebra;
rowResults = oro->rowResults;
if(rowResults->cols != rowAlgebra->cols || rowResults->rows != data->rows) {
if(OMX_DEBUG_ROWS(1)) {
mxLog("Resizing rowResults from %dx%d to %dx%d.",
rowResults->rows, rowResults->cols,
data->rows, rowAlgebra->cols);
}
omxResizeMatrix(rowResults, data->rows, rowAlgebra->cols);
}
*/
int parallelism = (numChildren == 0) ? 1 : numChildren;
if (parallelism > data->rows) {
parallelism = data->rows;
}
if (parallelism > 1) {
int stride = (data->rows / parallelism);
#pragma omp parallel for num_threads(parallelism)
for(int i = 0; i < parallelism; i++) {
FitContext *kid = fc->childList[i];
omxMatrix *childMatrix = kid->lookupDuplicate(objMatrix);
omxFitFunction *childFit = childMatrix->fitFunction;
if (i == parallelism - 1) {
omxRowFitFunctionSingleIteration(childFit, oo, stride * i, data->rows - stride * i, fc);
} else {
omxRowFitFunctionSingleIteration(childFit, oo, stride * i, stride, fc);
}
}
} else {
omxRowFitFunctionSingleIteration(oo, oo, 0, data->rows, fc);
}
omxRecompute(reduceAlgebra, fc);
omxCopyMatrix(oo->matrix, reduceAlgebra);
}
static void omxCallWLSFitFunction(omxFitFunction *oo, int want, FitContext *fc) {
if (want & (FF_COMPUTE_INITIAL_FIT | FF_COMPUTE_PREOPTIMIZE)) return;
if(OMX_DEBUG) { mxLog("Beginning WLS Evaluation.");}
// Requires: Data, means, covariances.
double sum = 0.0;
omxMatrix *eCov, *eMeans, *P, *B, *weights, *oFlat, *eFlat;
omxMatrix *seCov, *seMeans, *seThresholdsMat, *seFlat;
omxWLSFitFunction *owo = ((omxWLSFitFunction*)oo->argStruct);
/* Locals for readability. Compiler should cut through this. */
eCov = owo->expectedCov;
eMeans = owo->expectedMeans;
std::vector< omxThresholdColumn > &eThresh = oo->expectation->thresholds;
oFlat = owo->observedFlattened;
eFlat = owo->expectedFlattened;
weights = owo->weights;
B = owo->B;
P = owo->P;
seCov = owo->standardExpectedCov;
seMeans = owo->standardExpectedMeans;
seThresholdsMat = owo->standardExpectedThresholds;
seFlat = owo->standardExpectedFlattened;
int onei = 1;
omxExpectation* expectation = oo->expectation;
/* Recompute and recopy */
if(OMX_DEBUG) { mxLog("WLSFitFunction Computing expectation"); }
omxExpectationCompute(fc, expectation, NULL);
omxMatrix *expThresholdsMat = expectation->thresholdsMat;
standardizeCovMeansThresholds(eCov, eMeans, expThresholdsMat, eThresh,
seCov, seMeans, seThresholdsMat);
if(expThresholdsMat != NULL){
flattenDataToVector(seCov, seMeans, seThresholdsMat, eThresh, eFlat);
} else {
flattenDataToVector(eCov, eMeans, expThresholdsMat, eThresh, eFlat);
}
omxCopyMatrix(B, oFlat);
//if(OMX_DEBUG) {omxPrintMatrix(B, "....WLS Observed Vector: "); }
if(OMX_DEBUG) {omxPrintMatrix(eFlat, "....WLS Expected Vector: "); }
omxDAXPY(-1.0, eFlat, B);
//if(OMX_DEBUG) {omxPrintMatrix(B, "....WLS Observed - Expected Vector: "); }
if(weights != NULL) {
//if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(weights, "....WLS Weight Matrix: "); }
omxDGEMV(TRUE, 1.0, weights, B, 0.0, P);
} else {
// ULS Case: Memcpy faster than dgemv.
omxCopyMatrix(P, B);
}
sum = F77_CALL(ddot)(&(P->cols), P->data, &onei, B->data, &onei);
oo->matrix->data[0] = sum;
if(OMX_DEBUG) { mxLog("WLSFitFunction value comes to: %f.", oo->matrix->data[0]); }
}
void BA81FitState::copyEstimates(BA81Expect *estate)
{
omxCopyMatrix(itemParam, estate->itemParam);
if (estate->_latentMeanOut) omxCopyMatrix(latentMean, estate->_latentMeanOut);
if (estate->_latentCovOut) omxCopyMatrix(latentCov, estate->_latentCovOut);
}
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);
}
static void CallFIMLFitFunction(omxFitFunction *off, int want, FitContext *fc)
{
// TODO: Figure out how to give access to other per-iteration structures.
// TODO: Current implementation is slow: update by filtering correlations and thresholds.
// TODO: Current implementation does not implement speedups for sorting.
// TODO: Current implementation may fail on all-continuous-missing or all-ordinal-missing rows.
if (want & (FF_COMPUTE_PREOPTIMIZE)) return;
if(OMX_DEBUG) {
mxLog("Beginning Joint FIML Evaluation.");
}
int returnRowLikelihoods = 0;
omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*)off->argStruct);
omxMatrix* fitMatrix = off->matrix;
int numChildren = (int) fc->childList.size();
omxMatrix *cov = ofiml->cov;
omxMatrix *means = ofiml->means;
if (!means) {
omxRaiseErrorf("%s: raw data observed but no expected means "
"vector was provided. Add something like mxPath(from = 'one',"
" to = manifests) to your model.", off->name());
return;
}
omxData* data = ofiml->data; // read-only
omxMatrix *dataColumns = ofiml->dataColumns;
returnRowLikelihoods = ofiml->returnRowLikelihoods; // read-only
omxExpectation* expectation = off->expectation;
std::vector< omxThresholdColumn > &thresholdCols = expectation->thresholds;
if (data->defVars.size() == 0 && !strEQ(expectation->expType, "MxExpectationStateSpace")) {
if(OMX_DEBUG) {mxLog("Precalculating cov and means for all rows.");}
omxExpectationRecompute(fc, expectation);
// MCN Also do the threshold formulae!
for(int j=0; j < dataColumns->cols; j++) {
int var = omxVectorElement(dataColumns, j);
if (!omxDataColumnIsFactor(data, var)) continue;
if (j < int(thresholdCols.size()) && thresholdCols[j].numThresholds > 0) { // j is an ordinal column
omxMatrix* nextMatrix = thresholdCols[j].matrix;
omxRecompute(nextMatrix, fc);
checkIncreasing(nextMatrix, thresholdCols[j].column, thresholdCols[j].numThresholds, fc);
for(int index = 0; index < numChildren; index++) {
FitContext *kid = fc->childList[index];
omxMatrix *target = kid->lookupDuplicate(nextMatrix);
omxCopyMatrix(target, nextMatrix);
}
} else {
Rf_error("No threshold given for ordinal column '%s'",
omxDataColumnName(data, j));
}
}
double *corList = ofiml->corList;
double *weights = ofiml->weights;
if (corList) {
omxStandardizeCovMatrix(cov, corList, weights, fc); // Calculate correlation and covariance
}
for(int index = 0; index < numChildren; index++) {
FitContext *kid = fc->childList[index];
omxMatrix *childFit = kid->lookupDuplicate(fitMatrix);
omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
omxCopyMatrix(childOfiml->cov, cov);
omxCopyMatrix(childOfiml->means, means);
if (corList) {
memcpy(childOfiml->weights, weights, sizeof(double) * cov->rows);
memcpy(childOfiml->corList, corList, sizeof(double) * (cov->rows * (cov->rows - 1)) / 2);
}
}
if(OMX_DEBUG) { omxPrintMatrix(cov, "Cov"); }
if(OMX_DEBUG) { omxPrintMatrix(means, "Means"); }
}
memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
int parallelism = (numChildren == 0) ? 1 : numChildren;
if (parallelism > data->rows) {
parallelism = data->rows;
}
FIMLSingleIterationType singleIter = ofiml->SingleIterFn;
bool failed = false;
if (parallelism > 1) {
int stride = (data->rows / parallelism);
#pragma omp parallel for num_threads(parallelism) reduction(||:failed)
for(int i = 0; i < parallelism; i++) {
FitContext *kid = fc->childList[i];
omxMatrix *childMatrix = kid->lookupDuplicate(fitMatrix);
omxFitFunction *childFit = childMatrix->fitFunction;
if (i == parallelism - 1) {
failed |= singleIter(kid, childFit, off, stride * i, data->rows - stride * i);
} else {
failed |= singleIter(kid, childFit, off, stride * i, stride);
}
}
} else {
failed |= singleIter(fc, off, off, 0, data->rows);
}
if (failed) {
omxSetMatrixElement(off->matrix, 0, 0, NA_REAL);
return;
}
if(!returnRowLikelihoods) {
double val, sum = 0.0;
// floating-point addition is not associative,
// so we serialized the following reduction operation.
for(int i = 0; i < data->rows; i++) {
val = omxVectorElement(ofiml->rowLogLikelihoods, i);
// mxLog("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
sum += val;
}
if(OMX_DEBUG) {mxLog("Total Likelihood is %3.3f", sum);}
omxSetMatrixElement(off->matrix, 0, 0, sum);
}
}
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));
}
}
void omxInitExpectationBA81(omxExpectation* oo) {
omxState* currentState = oo->currentState;
SEXP rObj = oo->rObj;
SEXP tmp;
if(OMX_DEBUG) {
mxLog("Initializing %s.", oo->name);
}
if (!Glibrpf_model) {
#if USE_EXTERNAL_LIBRPF
get_librpf_t get_librpf = (get_librpf_t) R_GetCCallable("rpf", "get_librpf_model_GPL");
(*get_librpf)(LIBIFA_RPF_API_VERSION, &Glibrpf_numModels, &Glibrpf_model);
#else
// if linking against included source code
Glibrpf_numModels = librpf_numModels;
Glibrpf_model = librpf_model;
#endif
}
BA81Expect *state = new BA81Expect;
// These two constants should be as identical as possible
state->name = oo->name;
if (0) {
state->LogLargestDouble = 0.0;
state->LargestDouble = 1.0;
} else {
state->LogLargestDouble = log(std::numeric_limits<double>::max()) - 1;
state->LargestDouble = exp(state->LogLargestDouble);
ba81NormalQuad &quad = state->getQuad();
quad.setOne(state->LargestDouble);
}
state->expectedUsed = false;
state->estLatentMean = NULL;
state->estLatentCov = NULL;
state->type = EXPECTATION_OBSERVED;
state->itemParam = NULL;
state->EitemParam = NULL;
state->itemParamVersion = 0;
state->latentParamVersion = 0;
oo->argStruct = (void*) state;
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("data")));
state->data = omxDataLookupFromState(tmp, currentState);
}
if (strcmp(omxDataType(state->data), "raw") != 0) {
omxRaiseErrorf("%s unable to handle data type %s", oo->name, omxDataType(state->data));
return;
}
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("verbose")));
state->verbose = Rf_asInteger(tmp);
}
int targetQpoints;
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("qpoints")));
targetQpoints = Rf_asInteger(tmp);
}
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("qwidth")));
state->grp.setGridFineness(Rf_asReal(tmp), targetQpoints);
}
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("ItemSpec")));
state->grp.importSpec(tmp);
if (state->verbose >= 2) mxLog("%s: found %d item specs", oo->name, state->numItems());
}
state->_latentMeanOut = omxNewMatrixFromSlot(rObj, currentState, "mean");
state->_latentCovOut = omxNewMatrixFromSlot(rObj, currentState, "cov");
state->itemParam = omxNewMatrixFromSlot(rObj, currentState, "item");
state->grp.param = state->itemParam->data; // algebra not allowed yet TODO
const int numItems = state->itemParam->cols;
if (state->numItems() != numItems) {
omxRaiseErrorf("ItemSpec length %d must match the number of item columns (%d)",
state->numItems(), numItems);
return;
}
if (state->itemParam->rows != state->grp.impliedParamRows) {
omxRaiseErrorf("item matrix must have %d rows", state->grp.impliedParamRows);
return;
}
state->grp.paramRows = state->itemParam->rows;
// for algebra item param, will need to defer until later?
state->grp.learnMaxAbilities();
int maxAbilities = state->grp.itemDims;
state->grp.setFactorNames(state->itemParam->rownames);
{
ProtectedSEXP tmp2(R_do_slot(rObj, Rf_install(".detectIndependence")));
state->grp.detectIndependence = Rf_asLogical(tmp2);
}
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("EstepItem")));
if (!Rf_isNull(tmp)) {
int rows, cols;
getMatrixDims(tmp, &rows, &cols);
if (rows != state->itemParam->rows || cols != state->itemParam->cols) {
Rf_error("EstepItem must have the same dimensions as the item MxMatrix");
}
state->EitemParam = REAL(tmp);
}
}
oo->computeFun = ba81compute;
oo->setVarGroup = ignoreSetVarGroup;
oo->destructFun = ba81Destroy;
oo->populateAttrFun = ba81PopulateAttributes;
oo->componentFun = getComponent;
oo->canDuplicate = false;
// TODO: Exactly identical rows do not contribute any information.
// The sorting algorithm ought to remove them so we get better cache behavior.
// The following summary stats would be cheaper to calculate too.
omxData *data = state->data;
if (data->hasDefinitionVariables()) Rf_error("%s: not implemented yet", oo->name);
std::vector<int> &rowMap = state->grp.rowMap;
int weightCol;
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("weightColumn")));
weightCol = INTEGER(tmp)[0];
}
if (weightCol == NA_INTEGER) {
// Should rowMap be part of omxData? This is essentially a
// generic compression step that shouldn't be specific to IFA models.
state->grp.rowWeight = (double*) R_alloc(data->rows, sizeof(double));
rowMap.resize(data->rows);
int numUnique = 0;
for (int rx=0; rx < data->rows; ) {
int rw = 1;
state->grp.rowWeight[numUnique] = rw;
rowMap[numUnique] = rx;
rx += rw;
++numUnique;
}
rowMap.resize(numUnique);
state->weightSum = state->data->rows;
}
else {
if (omxDataColumnIsFactor(data, weightCol)) {
omxRaiseErrorf("%s: weightColumn %d is a factor", oo->name, 1 + weightCol);
return;
}
state->grp.rowWeight = omxDoubleDataColumn(data, weightCol);
state->weightSum = 0;
for (int rx=0; rx < data->rows; ++rx) { state->weightSum += state->grp.rowWeight[rx]; }
rowMap.resize(data->rows);
for (size_t rx=0; rx < rowMap.size(); ++rx) {
rowMap[rx] = rx;
}
}
// complain about non-integral rowWeights (EAP can't work) TODO
auto colMap = oo->getDataColumns();
for (int cx = 0; cx < numItems; cx++) {
int *col = omxIntDataColumnUnsafe(data, colMap[cx]);
state->grp.dataColumns.push_back(col);
}
// sanity check data
for (int cx = 0; cx < numItems; cx++) {
if (!omxDataColumnIsFactor(data, colMap[cx])) {
data->omxPrintData("diagnostic", 3);
omxRaiseErrorf("%s: column %d is not a factor", oo->name, int(1 + colMap[cx]));
return;
}
}
// TODO the max outcome should be available from omxData
for (int rx=0; rx < data->rows; rx++) {
int cols = 0;
for (int cx = 0; cx < numItems; cx++) {
const int *col = state->grp.dataColumns[cx];
int pick = col[rx];
if (pick == NA_INTEGER) continue;
++cols;
const int no = state->grp.itemOutcomes[cx];
if (pick > no) {
Rf_error("Data for item '%s' has at least %d outcomes, not %d",
state->itemParam->colnames[cx], pick, no);
}
}
if (cols == 0) {
Rf_error("Row %d has all NAs", 1+rx);
}
}
if (state->_latentMeanOut && state->_latentMeanOut->rows * state->_latentMeanOut->cols != maxAbilities) {
Rf_error("The mean matrix '%s' must be a row or column vector of size %d",
state->_latentMeanOut->name(), maxAbilities);
}
if (state->_latentCovOut && (state->_latentCovOut->rows != maxAbilities ||
state->_latentCovOut->cols != maxAbilities)) {
Rf_error("The cov matrix '%s' must be %dx%d",
state->_latentCovOut->name(), maxAbilities, maxAbilities);
}
state->grp.setLatentDistribution(state->_latentMeanOut? state->_latentMeanOut->data : NULL,
state->_latentCovOut? state->_latentCovOut->data : NULL);
{
EigenArrayAdaptor Eparam(state->itemParam);
Eigen::Map< Eigen::VectorXd > meanVec(state->grp.mean, maxAbilities);
Eigen::Map< Eigen::MatrixXd > covMat(state->grp.cov, maxAbilities, maxAbilities);
state->grp.quad.setStructure(state->grp.qwidth, state->grp.qpoints,
Eparam, meanVec, covMat);
}
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("minItemsPerScore")));
state->grp.setMinItemsPerScore(Rf_asInteger(tmp));
}
state->grp.buildRowSkip();
if (isErrorRaised()) return;
{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("debugInternal")));
state->debugInternal = Rf_asLogical(tmp);
}
state->ElatentVersion = 0;
if (state->_latentMeanOut) {
state->estLatentMean = omxInitMatrix(maxAbilities, 1, TRUE, currentState);
omxCopyMatrix(state->estLatentMean, state->_latentMeanOut); // rename matrices TODO
}
if (state->_latentCovOut) {
state->estLatentCov = omxInitMatrix(maxAbilities, maxAbilities, TRUE, currentState);
omxCopyMatrix(state->estLatentCov, state->_latentCovOut);
}
}
static void
ba81compute(omxExpectation *oo, FitContext *fc, const char *what, const char *how)
{
BA81Expect *state = (BA81Expect *) oo->argStruct;
if (what) {
if (strcmp(what, "latentDistribution")==0 && how && strcmp(how, "copy")==0) {
omxCopyMatrix(state->_latentMeanOut, state->estLatentMean);
omxCopyMatrix(state->_latentCovOut, state->estLatentCov);
double sampleSizeAdj = (state->weightSum - 1.0) / state->weightSum;
int covSize = state->_latentCovOut->rows * state->_latentCovOut->cols;
for (int cx=0; cx < covSize; ++cx) {
state->_latentCovOut->data[cx] *= sampleSizeAdj;
}
return;
}
if (strcmp(what, "scores")==0) {
state->expectedUsed = true;
state->type = EXPECTATION_AUGMENTED;
} else if (strcmp(what, "nothing")==0) {
state->type = EXPECTATION_OBSERVED;
} else {
omxRaiseErrorf("%s: don't know how to predict '%s'",
oo->name, what);
}
if (state->verbose >= 1) {
mxLog("%s: predict %s", oo->name, what);
}
return;
}
bool latentClean = state->latentParamVersion == getLatentVersion(state);
bool itemClean = state->itemParamVersion == omxGetMatrixVersion(state->itemParam) && latentClean;
ba81NormalQuad &quad = state->getQuad();
if (state->verbose >= 1) {
mxLog("%s: Qinit %d itemClean %d latentClean %d (1=clean) expectedUsed=%d",
oo->name, (int)quad.isAllocated(), itemClean, latentClean, state->expectedUsed);
}
if (!latentClean) {
ba81RefreshQuadrature(oo);
state->latentParamVersion = getLatentVersion(state);
}
if (!itemClean) {
double *param = state->EitemParam? state->EitemParam : state->itemParam->data;
state->grp.quad.cacheOutcomeProb(param, FALSE);
bool estep = state->expectedUsed;
if (estep) {
if (oo->dynamicDataSource) {
BA81Engine<BA81Expect*, BA81LatentSummary, BA81Estep> engine;
engine.ba81Estep1(&state->grp, state);
} else {
BA81Engine<BA81Expect*, BA81LatentFixed, BA81Estep> engine;
engine.ba81Estep1(&state->grp, state);
}
} else {
state->grp.quad.releaseEstep();
refreshPatternLikelihood(state, oo->dynamicDataSource);
}
if (oo->dynamicDataSource && state->verbose >= 2) {
mxLog("%s: empirical distribution mean and cov:", state->name);
omxPrint(state->estLatentMean, "mean");
omxPrint(state->estLatentCov, "cov");
}
if (state->verbose >= 1) {
const int numUnique = state->getNumUnique();
mxLog("%s: estep<%s, %s> %d/%d rows excluded",
state->name,
(estep && oo->dynamicDataSource? "summary":"fixed"),
(estep? "estep":"omitEstep"),
state->grp.excludedPatterns, numUnique);
}
}
state->itemParamVersion = omxGetMatrixVersion(state->itemParam);
}
void omxCalculateLISRELCovarianceAndMeans(omxLISRELExpectation* oro) {
omxMatrix* LX = oro->LX;
omxMatrix* LY = oro->LY;
omxMatrix* BE = oro->BE;
omxMatrix* GA = oro->GA;
omxMatrix* PH = oro->PH;
omxMatrix* PS = oro->PS;
omxMatrix* TD = oro->TD;
omxMatrix* TE = oro->TE;
omxMatrix* TH = oro->TH;
omxMatrix* TX = oro->TX;
omxMatrix* TY = oro->TY;
omxMatrix* KA = oro->KA;
omxMatrix* AL = oro->AL;
omxMatrix* Cov = oro->cov;
omxMatrix* Means = oro->means;
int numIters = oro->numIters; //Used for fast RAM/LISREL inverse
omxMatrix* A = oro->A;
omxMatrix* B = oro->B;
omxMatrix* C = oro->C;
omxMatrix* D = oro->D;
omxMatrix* E = oro->E;
omxMatrix* F = oro->F;
omxMatrix* G = oro->G;
omxMatrix* H = oro->H;
omxMatrix* I = oro->I;
omxMatrix* J = oro->J;
omxMatrix* K = oro->K;
omxMatrix* L = oro->L;
omxMatrix* TOP = oro->TOP;
omxMatrix* BOT = oro->BOT;
omxMatrix* MUX = oro->MUX;
omxMatrix* MUY = oro->MUY;
omxMatrix** args = oro->args;
if(OMX_DEBUG) {
mxLog("Running LISREL computation in omxCalculateLISRELCovarianceAndMeans.");
}
double oned = 1.0, zerod=0.0; //, minusOned = -1.0;
//int ipiv[BE->rows], lwork = 4 * BE->rows * BE->cols; //This is copied from omxShallowInverse()
//double work[lwork]; // It lets you get the inverse of a matrix via omxDGETRI()
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(LX, "....LISREL: LX:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(LY, "....LISREL: LY:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(BE, "....LISREL: BE:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(GA, "....LISREL: GA:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(PH, "....LISREL: PH:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(PS, "....LISREL: PS:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TD, "....LISREL: TD:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TE, "....LISREL: TE:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TH, "....LISREL: TH:");
}
/* Calculate the lower right quadrant: the covariance of the Xs */
if(LX->cols != 0 && LY->cols != 0) {
//if( (LX != NULL) && (LY != NULL) ) {
if(OMX_DEBUG) {
mxLog("Calculating Lower Right Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, FALSE, oned, LX, PH, zerod, A); // A = LX*PH
omxCopyMatrix(B, TD); // B = TD
omxDGEMM(FALSE, TRUE, oned, A, LX, oned, B); // B = LX*PH*LX^T + TD
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(B, "....LISREL: Lower Right Quadrant of Model-implied Covariance Matrix:");
}
/* Calculate (I-BE)^(-1) and LY*(I-BE)^(-1) */
if(OMX_DEBUG) {
mxLog("Calculating Inverse of I-BE.");
}
omxShallowInverse(NULL, numIters, BE, C, L, I ); // C = (I-BE)^-1
//omxCopyMatrix(C, BE); // C = BE
//omxDGEMM(FALSE, FALSE, oned, I, I, minusOned, C); // C = I - BE
//omxDGETRF(C, ipiv); //LU Decomp
//omxDGETRI(C, ipiv, work, lwork); //Inverse based on LU Decomp ... C = C^(-1) = (I - BE)^(-1)
omxDGEMM(FALSE, FALSE, oned, LY, C, zerod, D); // D = LY*C = LY * (I - BE)^(-1)
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(D, "....LISREL: LY*(I-BE)^(-1)");
}
/* Calculate the lower left quadrant: the covariance of Xs and Ys, nX by nY */
if(OMX_DEBUG) {
mxLog("Calculating Lower Left Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, TRUE, oned, A, GA, zerod, E); // E = A*GA^T = LX*PH*GA^T
omxCopyMatrix(F, TH); // F = TH
omxDGEMM(FALSE, TRUE, oned, E, D, oned, F); // F = E*D^T + F = LX*PH*GA^T * (LY * (I - BE)^(-1))^T + TH
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(F, "....LISREL: Lower Left Quadrant of Model-implied Covariance Matrix:");
}
/* Calculate the upper right quadrant: NOTE THIS IS MERELY THE LOWER LEFT QUADRANT TRANSPOSED. */
//DONE as omxTranspose(F)
/* Calculate the upper left quadrant: the covariance of the Ys */
if(OMX_DEBUG) {
mxLog("Calculating Upper Left Quadrant of Expected Covariance Matrix.");
}
if(OMX_DEBUG_ALGEBRA) {
mxLog("Calculating G = GA*PH.");
}
omxDGEMM(FALSE, FALSE, oned, GA, PH, zerod, G); // G = GA*PH
if(OMX_DEBUG_ALGEBRA) {
mxLog("Copying C = PS.");
}
omxCopyMatrix(C, PS); // C = PS
if(OMX_DEBUG_ALGEBRA) {
mxLog("Calculating G = GA*PH.");
}
omxDGEMM(FALSE, TRUE, oned, G, GA, oned, C); // C = G*GA^T + C = GA*PH*GA^T + PS
omxDGEMM(FALSE, FALSE, oned, D, C, zerod, H); // H = D*C = LY * (I - BE)^(-1) * (GA*PH*GA^T + PS)
omxCopyMatrix(J, TE); // J = TE
omxDGEMM(FALSE, TRUE, oned, H, D, oned, J); // J = H*D^T + J = LY * (I - BE)^(-1) * (GA*PH*GA^T + PS) * (LY * (I - BE)^(-1))^T + TE
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(J, "....LISREL: Upper Left Quadrant of Model-implied Covariance Matrix:");
}
/* Construct the full model-implied covariance matrix from the blocks previously calculated */
// SigmaHat = ( J t(F) )
// ( F B )
args[0] = F;
args[1] = B;
omxMatrixHorizCat(args, 2, BOT);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(BOT, "....LISREL: BOT = cbind(F, B):");
}
args[0] = J;
omxTransposeMatrix(F);
args[1] = F;
omxMatrixHorizCat(args, 2, TOP);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(args[0], "....LISREL: TOP Debugging args[0] = J:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(args[1], "....LISREL: TOP Debugging args[1] = F:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(F, "....LISREL: TOP Debugging F (should be 2 rows):");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TOP, "....LISREL: TOP = cbind(J, t(F)):");
}
omxTransposeMatrix(F); // So that it's back where it was.
args[0] = TOP;
args[1] = BOT;
omxMatrixVertCat(args, 2, Cov);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(Cov, "....LISREL: Model-implied Covariance Matrix:");
}
/* Now Calculate the Expected Means */
if(Means != NULL) {
/* Mean of the Xs */
//if(TX != NULL) {
omxCopyMatrix(MUX, TX);
omxDGEMV(FALSE, oned, LX, KA, oned, MUX);
//}
/* Mean of Ys */
//if(TY != NULL) {
omxCopyMatrix(K, AL);
omxDGEMV(FALSE, oned, GA, KA, oned, K);
omxCopyMatrix(MUY, TY);
omxDGEMV(FALSE, oned, D, K, oned, MUY);
//}
/* Build means from blocks */
args[0] = MUY;
args[1] = MUX;
omxMatrixVertCat(args, 2, Means);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(Means, "....LISREL: Model-implied Means Vector:");
}
}
}
else if(LX->cols != 0) { /* IF THE MODEL ONLY HAS Xs */
//else if(LX != NULL) { /* IF THE MODEL ONLY HAS Xs */
if(OMX_DEBUG) {
mxLog("Calculating Lower Right Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, FALSE, oned, LX, PH, zerod, A); // A = LX*PH
omxCopyMatrix(Cov, TD); // Cov = TD
omxDGEMM(FALSE, TRUE, oned, A, LX, oned, Cov); // Cov = LX*PH*LX^T + Cov
if(Means != NULL) {
/* Mean of the Xs */
omxCopyMatrix(Means, TX);
omxDGEMV(FALSE, oned, LX, KA, oned, Means);
}
}
/* IF THE MODEL ONLY HAS Ys */
else if(LY->cols != 0) {
//else if(LY != NULL) {
/* Calculate (I-BE)^(-1) and LY*(I-BE)^(-1) */
if(OMX_DEBUG) {
mxLog("Calculating Inverse of I-BE.");
}
omxShallowInverse(NULL, numIters, BE, C, L, I ); // C = (I-BE)^-1
//omxCopyMatrix(C, BE); // C = BE
//omxDGEMM(FALSE, FALSE, oned, I, I, minusOned, C); // C = I - BE
//omxDGETRF(C, ipiv); //LU Decomp
//omxDGETRI(C, ipiv, work, lwork); //Inverse based on LU Decomp ... C = C^(-1) = (I - BE)^(-1)
omxDGEMM(FALSE, FALSE, oned, LY, C, zerod, D); // D = LY*C = LY * (I - BE)^(-1)
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(D, "....LISREL: LY*(I-BE)^(-1)");
}
/* Calculate the upper left quadrant: the covariance of the Ys */
if(OMX_DEBUG) {
mxLog("Calculating Upper Left Quadrant of Expected Covariance Matrix.");
}
if(OMX_DEBUG_ALGEBRA) {
mxLog("Copying C = PS.");
}
omxDGEMM(FALSE, FALSE, oned, D, PS, zerod, H); // H = D*PS = LY * (I - BE)^(-1) * PS
omxCopyMatrix(Cov, TE); // Cov = TE
omxDGEMM(FALSE, TRUE, oned, H, D, oned, Cov); // Cov = H*D^T + Cov = LY * (I - BE)^(-1) * PS * (LY * (I - BE)^(-1))^T + TE
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(J, "....LISREL: Upper Left Quadrant of Model-implied Covariance Matrix:");
}
if(Means != NULL) {
omxCopyMatrix(Means, TY);
omxDGEMV(FALSE, oned, D, AL, oned, Means);
}
}
/*
if(OMX_DEBUG) { mxLog("Running RAM computation."); }
double oned = 1.0, zerod=0.0;
if(Ax == NULL || I == NULL || Z == NULL || Y == NULL || X == NULL) {
Rf_error("Internal Error: RAM Metadata improperly populated. Please report this to the OpenMx development team.");
}
if(Cov == NULL && Means == NULL) {
return; // We're not populating anything, so why bother running the calculation?
}
// if( (Cov->rows != Cov->cols) || (A->rows != A->cols) // Conformance check
// || (X->rows != Cov->cols) || (X->cols != A->rows)
// || (Y->rows != Cov->cols) || (Y->cols != A->rows)
// || (Ax->rows != Cov->cols) || (Ax->cols != A->rows)
// || (I->rows != Cov->cols) || (I->cols != Cov->rows)
// || (Y->rows != Cov->cols) || (Y->cols != A->rows)
// || (M->cols != Cov->cols) || (M->rows != 1)
// || (Means->rows != 1) || (Means->cols != Cov->cols) ) {
// Rf_error("INTERNAL ERROR: Incorrectly sized matrices being passed to omxRAMObjective Calculation.\n Please report this to the OpenMx development team.");
// }
omxShallowInverse(numIters, A, Z, Ax, I );
// IMPORTANT: Cov = FZSZ'F'
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(F->majority), *(Z->majority), (F->rows), (Z->cols), (Z->rows), oned, F->data, (F->leading), Z->data, (Z->leading), zerod, Y->data, (Y->leading));}
// F77_CALL(omxunsafedgemm)(F->majority, Z->majority, &(F->rows), &(Z->cols), &(Z->rows), &oned, F->data, &(F->leading), Z->data, &(Z->leading), &zerod, Y->data, &(Y->leading)); // Y = FZ
omxDGEMM(FALSE, FALSE, 1.0, F, Z, 0.0, Y);
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(Y->majority), *(S->majority), (Y->rows), (S->cols), (S->rows), oned, Y->data, (Y->leading), S->data, (S->leading), zerod, X->data, (X->leading));}
// F77_CALL(omxunsafedgemm)(Y->majority, S->majority, &(Y->rows), &(S->cols), &(S->rows), &oned, Y->data, &(Y->leading), S->data, &(S->leading), &zerod, X->data, &(X->leading)); // X = FZS
omxDGEMM(FALSE, FALSE, 1.0, Y, S, 0.0, X);
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(X->majority), *(Y->minority), (X->rows), (Y->rows), (Y->cols), oned, X->data, (X->leading), Y->data, (Y->lagging), zerod, Cov->data, (Cov->leading));}
// F77_CALL(omxunsafedgemm)(X->majority, Y->minority, &(X->rows), &(Y->rows), &(Y->cols), &oned, X->data, &(X->leading), Y->data, &(Y->leading), &zerod, Cov->data, &(Cov->leading));
omxDGEMM(FALSE, TRUE, 1.0, X, Y, 0.0, Cov);
// Cov = FZSZ'F' (Because (FZ)' = Z'F')
if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(Cov, "....RAM: Model-implied Covariance Matrix:");}
if(M != NULL && Means != NULL) {
// F77_CALL(omxunsafedgemv)(Y->majority, &(Y->rows), &(Y->cols), &oned, Y->data, &(Y->leading), M->data, &onei, &zerod, Means->data, &onei);
omxDGEMV(FALSE, 1.0, Y, M, 0.0, Means);
if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(Means, "....RAM: Model-implied Means Vector:");}
}
*/
}
