void omxInitNormalExpectation(omxExpectation* ox) { SEXP rObj = ox->rObj; omxState* currentState = ox->currentState; if(OMX_DEBUG) { mxLog("Initializing Normal expectation."); } omxNormalExpectation *one = (omxNormalExpectation*) R_alloc(1, sizeof(omxNormalExpectation)); /* Set Expectation Calls and Structures */ ox->computeFun = omxComputeNormalExpectation; ox->destructFun = omxDestroyNormalExpectation; ox->componentFun = omxGetNormalExpectationComponent; ox->populateAttrFun = omxPopulateNormalAttributes; ox->argStruct = (void*) one; /* Set up expectation structures */ if(OMX_DEBUG) { mxLog("Processing cov."); } one->cov = omxNewMatrixFromSlot(rObj, currentState, "covariance"); if(OMX_DEBUG) { mxLog("Processing Means."); } one->means = omxNewMatrixFromSlot(rObj, currentState, "means"); one->thresholds = omxNewMatrixFromSlot(rObj, currentState, "thresholds"); }
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 omxComputeNumericDeriv::initFromFrontend(omxState *state, SEXP rObj) { super::initFromFrontend(state, rObj); /*if (state->conListX.size()) { mxThrow("%s: cannot proceed with constraints (%d constraints found)", name, int(state->conListX.size())); }*/ fitMat = omxNewMatrixFromSlot(rObj, state, "fitfunction"); SEXP slotValue; Rf_protect(slotValue = R_do_slot(rObj, Rf_install("iterations"))); numIter = INTEGER(slotValue)[0]; if (numIter < 2) mxThrow("stepSize must be 2 or greater"); Rf_protect(slotValue = R_do_slot(rObj, Rf_install("parallel"))); parallel = Rf_asLogical(slotValue); Rf_protect(slotValue = R_do_slot(rObj, Rf_install("checkGradient"))); checkGradient = Rf_asLogical(slotValue); Rf_protect(slotValue = R_do_slot(rObj, Rf_install("verbose"))); verbose = Rf_asInteger(slotValue); { ProtectedSEXP Rhessian(R_do_slot(rObj, Rf_install("hessian"))); wantHessian = Rf_asLogical(Rhessian); } Rf_protect(slotValue = R_do_slot(rObj, Rf_install("stepSize"))); stepSize = GRADIENT_FUDGE_FACTOR(3.0) * REAL(slotValue)[0]; if (stepSize <= 0) mxThrow("stepSize must be positive"); knownHessian = NULL; { ScopedProtect(slotValue, R_do_slot(rObj, Rf_install("knownHessian"))); if (!Rf_isNull(slotValue)) { knownHessian = REAL(slotValue); SEXP dimnames; ScopedProtect pdn(dimnames, Rf_getAttrib(slotValue, R_DimNamesSymbol)); { SEXP names; ScopedProtect p1(names, VECTOR_ELT(dimnames, 0)); { int nlen = Rf_length(names); khMap.assign(nlen, -1); for (int nx=0; nx < nlen; ++nx) { const char *vname = CHAR(STRING_ELT(names, nx)); for (int vx=0; vx < int(varGroup->vars.size()); ++vx) { if (strEQ(vname, varGroup->vars[vx]->name)) { khMap[nx] = vx; if (verbose >= 1) mxLog("%s: knownHessian[%d] '%s' mapped to %d", name, nx, vname, vx); break; } } } } } } } numParams = 0; totalProbeCount = 0; numParams = 0; recordDetail = true; detail = 0; }
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 }