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