void MarkovExpectation::init()
{
ProtectedSEXP Rverbose(R_do_slot(rObj, Rf_install("verbose")));
verbose = Rf_asInteger(Rverbose);
ProtectedSEXP Rcomponents(R_do_slot(rObj, Rf_install("components")));
int *cvec = INTEGER(Rcomponents);
int nc = Rf_length(Rcomponents);
for (int cx=0; cx < nc; ++cx) {
components.push_back(omxExpectationFromIndex(cvec[cx], currentState));
}
if (isMixtureInterface) {
initial = omxNewMatrixFromSlot(rObj, currentState, "weights");
transition = 0;
} else {
initial = omxNewMatrixFromSlot(rObj, currentState, "initial");
transition = omxNewMatrixFromSlot(rObj, currentState, "transition");
}
ProtectedSEXP Rscale(R_do_slot(rObj, Rf_install("scale")));
auto scaleName = CHAR(STRING_ELT(Rscale, 0));
if (strEQ(scaleName, "softmax")) {
scale = SCALE_SOFTMAX;
} else if (strEQ(scaleName, "sum")) {
scale = SCALE_SUM;
} else if (strEQ(scaleName, "none")) {
scale = SCALE_NONE;
} else {
Rf_error("%s: unknown scale '%s'", name, scaleName);
}
scaledInitial = omxInitMatrix(1, 1, TRUE, currentState);
scaledTransition = 0;
if (transition) {
scaledTransition = omxInitMatrix(1, 1, TRUE, currentState);
}
}
void omxInitFitFunctionBA81(omxFitFunction* oo)
{
if (!oo->argStruct) { // ugh!
BA81FitState *state = new BA81FitState;
oo->argStruct = state;
}
omxState *currentState = oo->matrix->currentState;
BA81FitState *state = (BA81FitState*) oo->argStruct;
omxExpectation *expectation = oo->expectation;
BA81Expect *estate = (BA81Expect*) expectation->argStruct;
estate->fit = oo;
oo->computeFun = ba81Compute;
oo->setVarGroup = ba81SetFreeVarGroup;
oo->destructFun = ba81Destroy;
oo->gradientAvailable = TRUE;
oo->hessianAvailable = TRUE;
int maxParam = estate->itemParam->rows;
state->itemDerivPadSize = maxParam + triangleLoc1(maxParam);
int numItems = estate->itemParam->cols;
for (int ix=0; ix < numItems; ix++) {
const double *spec = estate->itemSpec(ix);
int id = spec[RPF_ISpecID];
if (id < 0 || id >= Glibrpf_numModels) {
Rf_error("ItemSpec %d has unknown item model %d", ix, id);
}
}
state->itemParam = omxInitMatrix(0, 0, TRUE, currentState);
state->latentMean = omxInitMatrix(0, 0, TRUE, currentState);
state->latentCov = omxInitMatrix(0, 0, TRUE, currentState);
state->copyEstimates(estate);
state->returnRowLikelihoods = Rf_asInteger(R_do_slot(oo->rObj, Rf_install("vector")));
}
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;
}
omxMatrix* omxNewIdentityMatrix(int nrows, omxState* state) {
omxMatrix* newMat = NULL;
int l,k;
newMat = omxInitMatrix(nrows, nrows, TRUE, state);
for(k =0; k < newMat->rows; k++) {
for(l = 0; l < newMat->cols; l++) {
if(l == k) {
omxSetMatrixElement(newMat, k, l, 1);
} else {
omxSetMatrixElement(newMat, k, l, 0);
}
}
}
return newMat;
}
static omxFitFunction *omxNewInternalFitFunction(omxState* os, const char *fitType,
omxExpectation *expect, omxMatrix *matrix, bool rowLik)
{
omxFitFunction *obj = (omxFitFunction*) R_alloc(1, sizeof(omxFitFunction));
OMXZERO(obj, 1);
for (size_t fx=0; fx < OMX_STATIC_ARRAY_SIZE(omxFitFunctionSymbolTable); fx++) {
const omxFitFunctionTableEntry *entry = omxFitFunctionSymbolTable + fx;
if(strcmp(fitType, entry->name) == 0) {
obj->fitType = entry->name;
obj->initFun = entry->initFun;
// We need to set up the FreeVarGroup before calling initFun
// because older fit functions expect to know the number of
// free variables during initFun.
obj->setVarGroup = entry->setVarGroup; // ugh!
obj->addOutput = defaultAddOutput;
break;
}
}
if(obj->initFun == NULL) Rf_error("Fit function '%s' not implemented", fitType);
if (!matrix) {
obj->matrix = omxInitMatrix(1, 1, TRUE, os);
obj->matrix->hasMatrixNumber = TRUE;
obj->matrix->matrixNumber = ~os->algebraList.size();
os->algebraList.push_back(obj->matrix);
} else {
obj->matrix = matrix;
}
obj->matrix->fitFunction = obj;
obj->expectation = expect;
if (rowLik && expect && expect->data) {
omxData *dat = expect->data;
omxResizeMatrix(matrix, dat->rows, 1);
} else {
omxResizeMatrix(matrix, 1, 1);
}
return obj;
}
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 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));
}
}
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);
}
}
void omxInitLISRELExpectation(omxExpectation* oo) {
SEXP rObj = oo->rObj;
if(OMX_DEBUG) {
mxLog("Initializing LISREL Expectation.");
}
int nx, nxi, ny, neta, ntotal;
SEXP slotValue;
/* Create and fill expectation */
omxLISRELExpectation *LISobj = (omxLISRELExpectation*) R_alloc(1, sizeof(omxLISRELExpectation));
omxState* currentState = oo->currentState;
/* Set Expectation Calls and Structures */
oo->computeFun = omxCallLISRELExpectation;
oo->destructFun = omxDestroyLISRELExpectation;
oo->componentFun = omxGetLISRELExpectationComponent;
oo->populateAttrFun = omxPopulateLISRELAttributes;
oo->argStruct = (void*) LISobj;
/* Set up expectation structures */
if(OMX_DEBUG) {
mxLog("Initializing LISREL Meta Data for expectation.");
}
if(OMX_DEBUG) {
mxLog("Processing LX.");
}
LISobj->LX = omxNewMatrixFromSlot(rObj, currentState, "LX");
if(OMX_DEBUG) {
mxLog("Processing LY.");
}
LISobj->LY = omxNewMatrixFromSlot(rObj, currentState, "LY");
if(OMX_DEBUG) {
mxLog("Processing BE.");
}
LISobj->BE = omxNewMatrixFromSlot(rObj, currentState, "BE");
if(OMX_DEBUG) {
mxLog("Processing GA.");
}
LISobj->GA = omxNewMatrixFromSlot(rObj, currentState, "GA");
if(OMX_DEBUG) {
mxLog("Processing PH.");
}
LISobj->PH = omxNewMatrixFromSlot(rObj, currentState, "PH");
if(OMX_DEBUG) {
mxLog("Processing PS.");
}
LISobj->PS = omxNewMatrixFromSlot(rObj, currentState, "PS");
if(OMX_DEBUG) {
mxLog("Processing TD.");
}
LISobj->TD = omxNewMatrixFromSlot(rObj, currentState, "TD");
if(OMX_DEBUG) {
mxLog("Processing TE.");
}
LISobj->TE = omxNewMatrixFromSlot(rObj, currentState, "TE");
if(OMX_DEBUG) {
mxLog("Processing TH.");
}
LISobj->TH = omxNewMatrixFromSlot(rObj, currentState, "TH");
if(OMX_DEBUG) {
mxLog("Processing TX.");
}
LISobj->TX = omxNewMatrixFromSlot(rObj, currentState, "TX");
if(OMX_DEBUG) {
mxLog("Processing TY.");
}
LISobj->TY = omxNewMatrixFromSlot(rObj, currentState, "TY");
if(OMX_DEBUG) {
mxLog("Processing KA.");
}
LISobj->KA = omxNewMatrixFromSlot(rObj, currentState, "KA");
if(OMX_DEBUG) {
mxLog("Processing AL.");
}
LISobj->AL = omxNewMatrixFromSlot(rObj, currentState, "AL");
LISobj->noLY = LISobj->LY == NULL;
if(LISobj->noLY) {
LISobj->LY = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->PS = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->BE = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->TE = omxInitMatrix(0, 0, TRUE, currentState);
}
LISobj->noLX = LISobj->LX == NULL;
if(LISobj->noLX) {
LISobj->LX = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->PH = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->TD = omxInitMatrix(0, 0, TRUE, currentState);
}
LISobj->Lnocol = LISobj->LY->cols == 0 || LISobj->LX->cols == 0;
if(LISobj->Lnocol) {
LISobj->GA = omxInitMatrix(LISobj->LY->cols, LISobj->LX->cols, TRUE, currentState);
LISobj->TH = omxInitMatrix(LISobj->LX->rows, LISobj->LY->rows, TRUE, currentState);
}
/* Identity Matrix, Size Of BE */
if(OMX_DEBUG) {
mxLog("Generating I.");
}
LISobj->I = omxNewIdentityMatrix(LISobj->BE->rows, currentState);
/* Get the nilpotency index of the BE matrix for I-BE inverse speedup */
if(OMX_DEBUG) {
mxLog("Processing expansion iteration depth.");
}
{ ScopedProtect p1(slotValue, R_do_slot(rObj, Rf_install("depth")));
LISobj->numIters = INTEGER(slotValue)[0];
if(OMX_DEBUG) {
mxLog("Using %d iterations.", LISobj->numIters);
}
}
/* Initialize the place holder matrices used in calculations */
nx = LISobj->LX->rows;
nxi = LISobj->LX->cols;
ny = LISobj->LY->rows;
neta = LISobj->LY->cols;
ntotal = nx + ny;
if(OMX_DEBUG) {
mxLog("Generating internals for computation.");
}
LISobj->A = omxInitMatrix(nx, nxi, TRUE, currentState);
LISobj->B = omxInitMatrix(nx, nx, TRUE, currentState);
LISobj->C = omxInitMatrix(neta, neta, TRUE, currentState);
LISobj->D = omxInitMatrix(ny, neta, TRUE, currentState);
LISobj->E = omxInitMatrix(nx, neta, TRUE, currentState);
LISobj->F = omxInitMatrix(nx, ny, TRUE, currentState);
LISobj->G = omxInitMatrix(neta, nxi, TRUE, currentState);
LISobj->H = omxInitMatrix(ny, neta, TRUE, currentState);
LISobj->J = omxInitMatrix(ny, ny, TRUE, currentState);
LISobj->K = omxInitMatrix(neta, 1, TRUE, currentState);
LISobj->L = omxInitMatrix(neta, neta, TRUE, currentState);
LISobj->TOP = omxInitMatrix(ny, ntotal, TRUE, currentState);
LISobj->BOT = omxInitMatrix(nx, ntotal, TRUE, currentState);
LISobj->MUX = omxInitMatrix(nx, 1, TRUE, currentState);
LISobj->MUY = omxInitMatrix(ny, 1, TRUE, currentState);
LISobj->cov = omxInitMatrix(ntotal, ntotal, TRUE, currentState);
LISobj->args = (omxMatrix**) R_alloc(2, sizeof(omxMatrix*));
/* Means */
if(LISobj->TX != NULL || LISobj->TY != NULL || LISobj->KA != NULL || LISobj->AL != NULL) {
LISobj->means = omxInitMatrix(1, ntotal, TRUE, currentState);
} else LISobj->means = NULL;
//TODO: Adjust means processing to allow only Xs or only Ys
}
void omxLISRELExpectation::studyExoPred() // compare with similar function for RAM
{
if (data->defVars.size() == 0 || !TY || !TY->isSimple() || !PS->isSimple()) return;
Eigen::VectorXd estSave;
copyParamToModelFake1(currentState, estSave);
omxRecompute(PS, 0);
omxRecompute(LY, 0);
omxRecompute(BE, 0);
EigenMatrixAdaptor ePS(PS); // latent covariance
EigenMatrixAdaptor eLY(LY); // to manifest loading
EigenMatrixAdaptor eBE(BE); // to latent loading
Eigen::VectorXd hasVariance = ePS.diagonal().array().abs().matrix();
int found = 0;
std::vector<int> exoDataCol(PS->rows, -1);
int alNum = ~AL->matrixNumber;
for (int k=0; k < int(data->defVars.size()); ++k) {
omxDefinitionVar &dv = data->defVars[k];
if (dv.matrix == alNum && hasVariance[ dv.row ] == 0.0) {
for (int cx=0; cx < eBE.rows(); ++cx) {
if (eBE(cx, dv.row) == 0.0) continue;
mxThrow("%s: latent exogenous variables are not supported (%s -> %s)", name,
PS->rownames[dv.row], BE->rownames[cx]);
}
if (eLY.col(dv.row).array().abs().sum() == 0.) continue;
exoDataCol[dv.row] = dv.column;
found += 1;
dv.loadData(currentState, 0.);
if (verbose >= 1) {
mxLog("%s: set defvar '%s' for latent '%s' to exogenous mode",
name, data->columnName(dv.column), PS->rownames[dv.row]);
}
data->defVars.erase(data->defVars.begin() + k--);
}
}
copyParamToModelRestore(currentState, estSave);
if (!found) return;
slope = omxInitMatrix(LY->rows, found, currentState);
EigenMatrixAdaptor eSl(slope);
eSl.setZero();
for (int cx=0, ex=0; cx < PS->rows; ++cx) {
if (exoDataCol[cx] == -1) continue;
exoDataColumns.push_back(exoDataCol[cx]);
for (int rx=0; rx < LY->rows; ++rx) {
slope->addPopulate(LY, rx, cx, rx, ex);
}
ex += 1;
}
exoPredMean.resize(exoDataColumns.size());
for (int cx=0; cx < int(exoDataColumns.size()); ++cx) {
auto &e1 = data->rawCols[ exoDataColumns[cx] ];
Eigen::Map< Eigen::VectorXd > vec(e1.ptr.realData, data->numRawRows());
exoPredMean[cx] = vec.mean();
}
}
