void ifaGroup::verifyFactorNames(SEXP mat, const char *matName) { static const char *dimname[] = { "row", "col" }; SEXP dimnames; Rf_protect(dimnames = Rf_getAttrib(mat, R_DimNamesSymbol)); if (!Rf_isNull(dimnames) && Rf_length(dimnames) == 2) { for (int dx=0; dx < 2; ++dx) { SEXP names; Rf_protect(names = VECTOR_ELT(dimnames, dx)); if (!Rf_length(names)) continue; if (int(factorNames.size()) != Rf_length(names)) { mxThrow("%s %snames must be length %d", matName, dimname[dx], (int) factorNames.size()); } int nlen = Rf_length(names); for (int nx=0; nx < nlen; ++nx) { const char *name = CHAR(STRING_ELT(names, nx)); if (strEQ(factorNames[nx].c_str(), name)) continue; mxThrow("%s %snames[%d] is '%s', does not match factor name '%s'", matName, dimname[dx], 1+nx, name, factorNames[nx].c_str()); } } } }
// Does vector=TRUE mean something sensible? Mixture of mixtures? void state::init() { auto *oo = this; auto *ms = this; if (!oo->expectation) { mxThrow("%s requires an expectation", oo->fitType); } oo->units = FIT_UNITS_MINUS2LL; oo->canDuplicate = true; omxState *currentState = oo->matrix->currentState; const char *myex1 = "MxExpectationHiddenMarkov"; const char *myex2 = "MxExpectationMixture"; if (!expectation || !(strEQ(expectation->expType, myex1) || strEQ(expectation->expType, myex2))) mxThrow("%s must be paired with %s or %s", oo->name(), myex1, myex2); ProtectedSEXP Rverbose(R_do_slot(oo->rObj, Rf_install("verbose"))); ms->verbose = Rf_asInteger(Rverbose); ProtectedSEXP Rcomponents(R_do_slot(oo->rObj, Rf_install("components"))); int nc = Rf_length(Rcomponents); int *cvec = INTEGER(Rcomponents); componentUnits = FIT_UNITS_UNINITIALIZED; for (int cx=0; cx < nc; ++cx) { omxMatrix *fmat = currentState->algebraList[ cvec[cx] ]; if (fmat->fitFunction) { omxCompleteFitFunction(fmat); auto ff = fmat->fitFunction; if (ff->units != FIT_UNITS_PROBABILITY) { omxRaiseErrorf("%s: component %s must be in probability units", oo->name(), ff->name()); return; } if (componentUnits == FIT_UNITS_UNINITIALIZED) { componentUnits = ff->units; } else if (ff->units != componentUnits) { omxRaiseErrorf("%s: components with heterogenous units %s and %s in same mixture", oo->name(), fitUnitsToName(ff->units), fitUnitsToName(componentUnits)); } } ms->components.push_back(fmat); } if (componentUnits == FIT_UNITS_UNINITIALIZED) componentUnits = FIT_UNITS_PROBABILITY; ms->initial = expectation->getComponent("initial"); ms->transition = expectation->getComponent("transition"); }
void ifaGroup::setMinItemsPerScore(int mips) { if (numItems() && mips > numItems()) { mxThrow("minItemsPerScore (=%d) cannot be larger than the number of items (=%d)", mips, numItems()); } minItemsPerScore = mips; }
void ba81NormalQuad::layer::detectTwoTier(Eigen::ArrayBase<T1> ¶m, Eigen::MatrixBase<T2> &mean, Eigen::MatrixBase<T3> &cov) { if (mean.rows() < 3) return; std::vector<int> orthogonal; Eigen::Matrix<Eigen::DenseIndex, Eigen::Dynamic, 1> numCov((cov.array() != 0.0).matrix().colwise().count()); std::vector<int> candidate; for (int fx=0; fx < numCov.rows(); ++fx) { if (numCov(fx) == 1) candidate.push_back(fx); } if (candidate.size() > 1) { std::vector<bool> mask(numItems()); for (int cx=candidate.size() - 1; cx >= 0; --cx) { std::vector<bool> loading(numItems()); for (int ix=0; ix < numItems(); ++ix) { loading[ix] = param(candidate[cx], itemsMap[ix]) != 0; } std::vector<bool> overlap(loading.size()); std::transform(loading.begin(), loading.end(), mask.begin(), overlap.begin(), std::logical_and<bool>()); if (std::find(overlap.begin(), overlap.end(), true) == overlap.end()) { std::transform(loading.begin(), loading.end(), mask.begin(), mask.begin(), std::logical_or<bool>()); orthogonal.push_back(candidate[cx]); } } } std::reverse(orthogonal.begin(), orthogonal.end()); if (orthogonal.size() == 1) orthogonal.clear(); if (orthogonal.size() && orthogonal[0] != mean.rows() - int(orthogonal.size())) { mxThrow("Independent specific factors must be given after general dense factors"); } numSpecific = orthogonal.size(); if (numSpecific) { Sgroup.assign(numItems(), 0); for (int ix=0; ix < numItems(); ix++) { for (int dx=orthogonal[0]; dx < mean.rows(); ++dx) { if (param(dx, itemsMap[ix]) != 0) { Sgroup[ix] = dx - orthogonal[0]; continue; } } } //Eigen::Map< Eigen::ArrayXi > foo(Sgroup.data(), param.cols()); //mxPrintMat("sgroup", foo); } }
void FitMultigroup::init() { auto *oo = this; FitMultigroup *mg =this; SEXP rObj = oo->rObj; if (!rObj) return; if (mg->fits.size()) return; // hack to prevent double initialization, remove TOOD oo->units = FIT_UNITS_UNINITIALIZED; oo->gradientAvailable = TRUE; oo->hessianAvailable = TRUE; oo->canDuplicate = true; omxState *os = oo->matrix->currentState; ProtectedSEXP Rverb(R_do_slot(rObj, Rf_install("verbose"))); mg->verbose = Rf_asInteger(Rverb); ProtectedSEXP Rgroups(R_do_slot(rObj, Rf_install("groups"))); int *fits = INTEGER(Rgroups); for(int gx = 0; gx < Rf_length(Rgroups); gx++) { if (isErrorRaised()) break; omxMatrix *mat; if (fits[gx] >= 0) { mat = os->algebraList[fits[gx]]; } else { mxThrow("Can only add algebra and fitfunction"); } if (mat == oo->matrix) mxThrow("Cannot add multigroup to itself"); mg->fits.push_back(mat); if (mat->fitFunction) { omxCompleteFitFunction(mat); oo->gradientAvailable = (oo->gradientAvailable && mat->fitFunction->gradientAvailable); oo->hessianAvailable = (oo->hessianAvailable && mat->fitFunction->hessianAvailable); } else { oo->gradientAvailable = FALSE; oo->hessianAvailable = FALSE; } } }
/* MX_OVERRIDDEN */ void mx::FileStream::Flush(void) { mxAssert(IsOpen()); if (EOF == fflush(m_hFileDescriptor)) { // We cannot reach eof during write (check it). mxAssert(!feof(m_hFileDescriptor)); // File I/O error other than EOF. mxThrow(GenericIOException(ferror(m_hFileDescriptor))); } }
void ifaGroup::importSpec(SEXP slotValue) { for (int sx=0; sx < Rf_length(slotValue); ++sx) { SEXP model = VECTOR_ELT(slotValue, sx); if (!OBJECT(model)) { mxThrow("Item models must inherit rpf.base"); } SEXP Rspec; ScopedProtect p1(Rspec, R_do_slot(model, Rf_install("spec"))); spec.push_back(REAL(Rspec)); } dataColumns.reserve(spec.size()); itemOutcomes.reserve(spec.size()); impliedParamRows = 0; totalOutcomes = 0; maxOutcomes = 0; itemDims = -1; for (int cx = 0; cx < numItems(); cx++) { const double *ispec = spec[cx]; int id = ispec[RPF_ISpecID]; int dims = ispec[RPF_ISpecDims]; if (itemDims == -1) { itemDims = dims; } else if (dims != itemDims) { mxThrow("All items must have the same number of factors (%d != %d)", itemDims, dims); } int no = ispec[RPF_ISpecOutcomes]; itemOutcomes.push_back(no); maxOutcomes = std::max(maxOutcomes, no); totalOutcomes += no; int numParam = (*Glibrpf_model[id].numParam)(ispec); if (impliedParamRows < numParam) impliedParamRows = numParam; } }
void ifaGroup::learnMaxAbilities() { int maxAbilities = 0; Eigen::ArrayXi loadings(itemDims); loadings.setZero(); for (int cx = 0; cx < numItems(); cx++) { for (int dx=0; dx < itemDims; ++dx) { if (getItemParam(cx)[dx] != 0) loadings[dx] += 1; } } maxAbilities = (loadings != 0).count(); if (itemDims != maxAbilities) { for (int lx=0; lx < itemDims; ++lx) { if (loadings[lx] == 0) mxThrow("Factor %d does not load on any items", 1+lx); } } }
void FitMultigroup::compute(int want, FitContext *fc) { omxMatrix *fitMatrix = matrix; double fit = 0; double mac = 0; FitMultigroup *mg = (FitMultigroup*) this; for (size_t ex=0; ex < mg->fits.size(); ex++) { omxMatrix* f1 = mg->fits[ex]; if (f1->fitFunction) { omxFitFunctionCompute(f1->fitFunction, want, fc); if (want & FF_COMPUTE_MAXABSCHANGE) { mac = std::max(fc->mac, mac); } if (want & FF_COMPUTE_PREOPTIMIZE) { if (units == FIT_UNITS_UNINITIALIZED) { units = f1->fitFunction->units; } else if (units != f1->fitFunction->units) { mxThrow("%s: cannot combine units %s and %s (from %s)", matrix->name(), fitUnitsToName(units), fitUnitsToName(f1->fitFunction->units), f1->name()); } } } else { omxRecompute(f1, fc); } if (want & FF_COMPUTE_FIT) { if(f1->rows != 1 || f1->cols != 1) { omxRaiseErrorf("%s[%d]: %s of type %s does not evaluate to a 1x1 matrix", fitMatrix->name(), (int)ex, f1->name(), f1->fitFunction->fitType); } fit += f1->data[0]; if (mg->verbose >= 1) { mxLog("%s: %s fit=%f", fitMatrix->name(), f1->name(), f1->data[0]); } } } if (fc) fc->mac = mac; if (want & FF_COMPUTE_FIT) { fitMatrix->data[0] = fit; if (mg->verbose >= 1) { mxLog("%s: fit=%f", fitMatrix->name(), fit); } } }
void ifaGroup::buildRowSkip() { rowSkip.assign(rowMap.size(), false); if (itemDims == 0) return; // Rows with no information about an ability will obtain the // prior distribution as an ability estimate. This will // throw off multigroup latent distribution estimates. for (size_t rx=0; rx < rowMap.size(); rx++) { bool hasNA = false; std::vector<int> contribution(itemDims); for (int ix=0; ix < numItems(); ix++) { int pick = dataColumn(ix)[ rowMap[rx] ]; if (pick == NA_INTEGER) { hasNA = true; continue; } const double *ispec = spec[ix]; int dims = ispec[RPF_ISpecDims]; double *iparam = getItemParam(ix); for (int dx=0; dx < dims; dx++) { // assume factor loadings are the first item parameters if (iparam[dx] == 0) continue; contribution[dx] += 1; } } if (!hasNA) continue; if (minItemsPerScore == NA_INTEGER) { mxThrow("You have missing data. You must set minItemsPerScore"); } for (int ax=0; ax < itemDims; ++ax) { if (contribution[ax] < minItemsPerScore) { // We could compute the other scores, but estimation of the // latent distribution is in the hot code path. We can reconsider // this choice when we try generating scores instead of the // score distribution. rowSkip[rx] = true; } } } }
/* MX_OVERRIDDEN */ mx::Size mx::FileStream::PrintfV( const Char * const sFormat, va_list pArguments) { mxAssert(IsOpen()); mxAssert(sFormat != NULL); int iCharsWritten; if ((iCharsWritten = #ifndef MXCPP_UNICODE ::vfprintf #else ::vfwprintf #endif (m_hFileDescriptor, sFormat, pArguments)) < 0) { // We cannot reach eof during write (check it). mxAssert(!feof(m_hFileDescriptor)); // File I/O error other than EOF. mxThrow(GenericIOException(ferror(m_hFileDescriptor))); } return iCharsWritten; }
void omxComputeNumericDeriv::computeImpl(FitContext *fc) { if (fc->fitUnits == FIT_UNITS_SQUARED_RESIDUAL || fc->fitUnits == FIT_UNITS_SQUARED_RESIDUAL_CHISQ) { // refactor TODO numParams = 0; if (verbose >= 1) mxLog("%s: derivatives %s units are meaningless", name, fitUnitsToName(fc->fitUnits)); return; //Possible TODO: calculate Hessian anyway? } int newWanted = fc->wanted | FF_COMPUTE_GRADIENT; if (wantHessian) newWanted |= FF_COMPUTE_HESSIAN; int nf = fc->calcNumFree(); if (numParams != 0 && numParams != nf) { mxThrow("%s: number of parameters changed from %d to %d", name, numParams, nf); } numParams = nf; if (numParams <= 0) { complainNoFreeParam(); return; } optima.resize(numParams); fc->copyEstToOptimizer(optima); paramMap.resize(numParams); for (int px=0,ex=0; px < numParams; ++ex) { if (fc->profiledOut[ex]) continue; paramMap[px++] = ex; } omxAlgebraPreeval(fitMat, fc); fc->createChildren(fitMat); // allow FIML rowwiseParallel even when parallel=false fc->state->countNonlinearConstraints(fc->state->numEqC, fc->state->numIneqC, false); int c_n = fc->state->numEqC + fc->state->numIneqC; fc->constraintFunVals.resize(c_n); fc->constraintJacobian.resize(c_n, numParams); if(c_n){ omxCalcFinalConstraintJacobian(fc, numParams); } // TODO: Allow more than one hessian value for calculation int numChildren = 1; if (parallel && !fc->openmpUser && fc->childList.size()) numChildren = fc->childList.size(); if (!fc->haveReferenceFit(fitMat)) return; minimum = fc->fit; hessWorkVector = new hess_struct[numChildren]; if (numChildren == 1) { omxPopulateHessianWork(hessWorkVector, fc); } else { for(int i = 0; i < numChildren; i++) { omxPopulateHessianWork(hessWorkVector + i, fc->childList[i]); } } if(verbose >= 1) mxLog("Numerical Hessian approximation (%d children, ref fit %.2f)", numChildren, minimum); hessian = NULL; if (wantHessian) { hessian = fc->getDenseHessUninitialized(); Eigen::Map< Eigen::MatrixXd > eH(hessian, numParams, numParams); eH.setConstant(NA_REAL); if (knownHessian) { int khSize = int(khMap.size()); Eigen::Map< Eigen::MatrixXd > kh(knownHessian, khSize, khMap.size()); for (int rx=0; rx < khSize; ++rx) { for (int cx=0; cx < khSize; ++cx) { if (khMap[rx] < 0 || khMap[cx] < 0) continue; eH(khMap[rx], khMap[cx]) = kh(rx, cx); } } } } if (detail) { recordDetail = false; // already done it once } else { Rf_protect(detail = Rf_allocVector(VECSXP, 4)); SET_VECTOR_ELT(detail, 0, Rf_allocVector(LGLSXP, numParams)); for (int gx=0; gx < 3; ++gx) { SET_VECTOR_ELT(detail, 1+gx, Rf_allocVector(REALSXP, numParams)); } SEXP detailCols; Rf_protect(detailCols = Rf_allocVector(STRSXP, 4)); Rf_setAttrib(detail, R_NamesSymbol, detailCols); SET_STRING_ELT(detailCols, 0, Rf_mkChar("symmetric")); SET_STRING_ELT(detailCols, 1, Rf_mkChar("forward")); SET_STRING_ELT(detailCols, 2, Rf_mkChar("central")); SET_STRING_ELT(detailCols, 3, Rf_mkChar("backward")); SEXP detailRowNames; Rf_protect(detailRowNames = Rf_allocVector(STRSXP, numParams)); Rf_setAttrib(detail, R_RowNamesSymbol, detailRowNames); for (int nx=0; nx < int(numParams); ++nx) { SET_STRING_ELT(detailRowNames, nx, Rf_mkChar(fc->varGroup->vars[nx]->name)); } markAsDataFrame(detail); } gforward = REAL(VECTOR_ELT(detail, 1)); gcentral = REAL(VECTOR_ELT(detail, 2)); gbackward = REAL(VECTOR_ELT(detail, 3)); Eigen::Map< Eigen::ArrayXd > Gf(gforward, numParams); Eigen::Map< Eigen::ArrayXd > Gc(gcentral, numParams); Eigen::Map< Eigen::ArrayXd > Gb(gbackward, numParams); Gf.setConstant(NA_REAL); Gc.setConstant(NA_REAL); Gb.setConstant(NA_REAL); calcHessianEntry che(this); CovEntrywiseParallel(numChildren, che); for(int i = 0; i < numChildren; i++) { struct hess_struct *hw = hessWorkVector + i; totalProbeCount += hw->probeCount; } delete [] hessWorkVector; if (isErrorRaised()) return; Eigen::Map< Eigen::ArrayXi > Gsymmetric(LOGICAL(VECTOR_ELT(detail, 0)), numParams); double gradNorm = 0.0; double feasibilityTolerance = Global->feasibilityTolerance; for (int px=0; px < numParams; ++px) { // factor out simliar code in ComputeNR omxFreeVar &fv = *fc->varGroup->vars[ paramMap[px] ]; if ((fabs(optima[px] - fv.lbound) < feasibilityTolerance && Gc[px] > 0) || (fabs(optima[px] - fv.ubound) < feasibilityTolerance && Gc[px] < 0)) { Gsymmetric[px] = false; continue; } gradNorm += Gc[px] * Gc[px]; double relsym = 2 * fabs(Gf[px] + Gb[px]) / (Gb[px] - Gf[px]); Gsymmetric[px] = (Gf[px] < 0 && 0 < Gb[px] && relsym < 1.5); if (checkGradient && verbose >= 2 && !Gsymmetric[px]) { mxLog("%s: param[%d] %d %f", name, px, Gsymmetric[px], relsym); } } fc->grad.resize(fc->numParam); fc->grad.setZero(); fc->copyGradFromOptimizer(Gc); if(c_n){ fc->inequality.resize(fc->state->numIneqC); fc->analyticIneqJacTmp.resize(fc->state->numIneqC, numParams); fc->myineqFun(true, verbose, omxConstraint::LESS_THAN, false); } gradNorm = sqrt(gradNorm); double gradThresh = Global->getGradientThreshold(minimum); //The gradient will generally not be near zero at a local minimum if there are equality constraints //or active inequality constraints: if ( checkGradient && gradNorm > gradThresh && !(fc->state->numEqC || fc->inequality.array().sum()) ) { if (verbose >= 1) { mxLog("Some gradient entries are too large, norm %f", gradNorm); } if (fc->getInform() < INFORM_NOT_AT_OPTIMUM) fc->setInform(INFORM_NOT_AT_OPTIMUM); } fc->setEstFromOptimizer(optima); // auxillary information like per-row likelihoods need a refresh ComputeFit(name, fitMat, FF_COMPUTE_FIT, fc); fc->wanted = newWanted; }
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 ifaGroup::setFactorNames(std::vector<const char *> &names) { if (int(names.size()) < itemDims) mxThrow("Not enough names"); factorNames.resize(itemDims); for (int fx=0; fx < itemDims; ++fx) factorNames[fx] = names[fx]; }
void state::compute(int want, FitContext *fc) { state *st = (state*) this; auto *oo = this; for (auto c1 : components) { if (c1->fitFunction) { omxFitFunctionCompute(c1->fitFunction, want, fc); } else { omxRecompute(c1, fc); } } if (!(want & FF_COMPUTE_FIT)) return; int nrow = components[0]->rows; for (auto c1 : components) { if (c1->rows != nrow) { mxThrow("%s: component '%s' has %d rows but component '%s' has %d rows", oo->name(), components[0]->name(), nrow, c1->name(), c1->rows); } } Eigen::VectorXd expect; Eigen::VectorXd rowResult; int numC = components.size(); Eigen::VectorXd tp(numC); double lp=0; for (int rx=0; rx < nrow; ++rx) { if (expectation->loadDefVars(rx) || rx == 0) { omxExpectationCompute(fc, expectation, NULL); if (!st->transition || rx == 0) { EigenVectorAdaptor Einitial(st->initial); expect = Einitial; if (expect.rows() != numC || expect.cols() != 1) { omxRaiseErrorf("%s: initial prob matrix must be %dx%d not %dx%d", name(), numC, 1, expect.rows(), expect.cols()); return; } } if (st->transition && (st->transition->rows != numC || st->transition->cols != numC)) { omxRaiseErrorf("%s: transition prob matrix must be %dx%d not %dx%d", name(), numC, numC, st->transition->rows, st->transition->cols); return; } } for (int cx=0; cx < int(components.size()); ++cx) { EigenVectorAdaptor Ecomp(components[cx]); tp[cx] = Ecomp[rx]; } if (st->verbose >= 4) { mxPrintMat("tp", tp); } if (st->transition) { EigenMatrixAdaptor Etransition(st->transition); expect = (Etransition * expect).eval(); } rowResult = tp.array() * expect.array(); double rowp = rowResult.sum(); rowResult /= rowp; lp += log(rowp); if (st->transition) expect = rowResult; } oo->matrix->data[0] = Global->llScale * lp; if (st->verbose >= 2) mxLog("%s: fit=%f", oo->name(), lp); }
void ifaGroup::import(SEXP Rlist) { SEXP argNames; Rf_protect(argNames = Rf_getAttrib(Rlist, R_NamesSymbol)); if (Rf_length(Rlist) != Rf_length(argNames)) { mxThrow("All list elements must be named"); } std::vector<const char *> dataColNames; paramRows = -1; int pmatCols=-1; int mips = 1; int dataRows = 0; SEXP Rmean=0, Rcov=0; for (int ax=0; ax < Rf_length(Rlist); ++ax) { const char *key = R_CHAR(STRING_ELT(argNames, ax)); SEXP slotValue = VECTOR_ELT(Rlist, ax); if (strEQ(key, "spec")) { importSpec(slotValue); } else if (strEQ(key, "param")) { if (!Rf_isReal(slotValue)) mxThrow("'param' must be a numeric matrix of item parameters"); param = REAL(slotValue); getMatrixDims(slotValue, ¶mRows, &pmatCols); SEXP dimnames; Rf_protect(dimnames = Rf_getAttrib(slotValue, R_DimNamesSymbol)); if (!Rf_isNull(dimnames) && Rf_length(dimnames) == 2) { SEXP names; Rf_protect(names = VECTOR_ELT(dimnames, 0)); int nlen = Rf_length(names); factorNames.resize(nlen); for (int nx=0; nx < nlen; ++nx) { factorNames[nx] = CHAR(STRING_ELT(names, nx)); } Rf_protect(names = VECTOR_ELT(dimnames, 1)); nlen = Rf_length(names); itemNames.resize(nlen); for (int nx=0; nx < nlen; ++nx) { itemNames[nx] = CHAR(STRING_ELT(names, nx)); } } } else if (strEQ(key, "mean")) { Rmean = slotValue; if (!Rf_isReal(slotValue)) mxThrow("'mean' must be a numeric vector or matrix"); mean = REAL(slotValue); } else if (strEQ(key, "cov")) { Rcov = slotValue; if (!Rf_isReal(slotValue)) mxThrow("'cov' must be a numeric matrix"); cov = REAL(slotValue); } else if (strEQ(key, "data")) { Rdata = slotValue; dataRows = Rf_length(VECTOR_ELT(Rdata, 0)); SEXP names; Rf_protect(names = Rf_getAttrib(Rdata, R_NamesSymbol)); int nlen = Rf_length(names); dataColNames.reserve(nlen); for (int nx=0; nx < nlen; ++nx) { dataColNames.push_back(CHAR(STRING_ELT(names, nx))); } Rf_protect(dataRowNames = Rf_getAttrib(Rdata, R_RowNamesSymbol)); } else if (strEQ(key, "weightColumn")) { if (Rf_length(slotValue) != 1) { mxThrow("You can only have one %s", key); } weightColumnName = CHAR(STRING_ELT(slotValue, 0)); } else if (strEQ(key, "freqColumn")) { if (Rf_length(slotValue) != 1) { mxThrow("You can only have one %s", key); } freqColumnName = CHAR(STRING_ELT(slotValue, 0)); } else if (strEQ(key, "qwidth")) { qwidth = Rf_asReal(slotValue); } else if (strEQ(key, "qpoints")) { qpoints = Rf_asInteger(slotValue); } else if (strEQ(key, "minItemsPerScore")) { mips = Rf_asInteger(slotValue); } else { // ignore } } learnMaxAbilities(); if (itemDims < (int) factorNames.size()) factorNames.resize(itemDims); if (int(factorNames.size()) < itemDims) { factorNames.reserve(itemDims); const int SMALLBUF = 24; char buf[SMALLBUF]; while (int(factorNames.size()) < itemDims) { snprintf(buf, SMALLBUF, "s%d", int(factorNames.size()) + 1); factorNames.push_back(CHAR(Rf_mkChar(buf))); } } if (Rmean) { if (Rf_isMatrix(Rmean)) { int nrow, ncol; getMatrixDims(Rmean, &nrow, &ncol); if (!(nrow * ncol == itemDims && (nrow==1 || ncol==1))) { mxThrow("mean must be a column or row matrix of length %d", itemDims); } } else { if (Rf_length(Rmean) != itemDims) { mxThrow("mean must be a vector of length %d", itemDims); } } verifyFactorNames(Rmean, "mean"); } if (Rcov) { if (Rf_isMatrix(Rcov)) { int nrow, ncol; getMatrixDims(Rcov, &nrow, &ncol); if (nrow != itemDims || ncol != itemDims) { mxThrow("cov must be %dx%d matrix", itemDims, itemDims); } } else { if (Rf_length(Rcov) != 1) { mxThrow("cov must be %dx%d matrix", itemDims, itemDims); } } verifyFactorNames(Rcov, "cov"); } setLatentDistribution(mean, cov); setMinItemsPerScore(mips); if (numItems() != pmatCols) { mxThrow("item matrix implies %d items but spec is length %d", pmatCols, numItems()); } if (Rdata) { if (itemNames.size() == 0) mxThrow("Item matrix must have colnames"); for (int ix=0; ix < numItems(); ++ix) { bool found=false; for (int dc=0; dc < int(dataColNames.size()); ++dc) { if (strEQ(itemNames[ix], dataColNames[dc])) { SEXP col = VECTOR_ELT(Rdata, dc); if (!Rf_isFactor(col)) { if (TYPEOF(col) == INTSXP) { mxThrow("Column '%s' is an integer but " "not an ordered factor", dataColNames[dc]); } else { mxThrow("Column '%s' is of type %s; expecting an " "ordered factor (integer)", dataColNames[dc], Rf_type2char(TYPEOF(col))); } } dataColumns.push_back(INTEGER(col)); found=true; break; } } if (!found) { mxThrow("Cannot find item '%s' in data", itemNames[ix]); } } if (weightColumnName) { for (int dc=0; dc < int(dataColNames.size()); ++dc) { if (strEQ(weightColumnName, dataColNames[dc])) { SEXP col = VECTOR_ELT(Rdata, dc); if (TYPEOF(col) != REALSXP) { mxThrow("Column '%s' is of type %s; expecting type numeric (double)", dataColNames[dc], Rf_type2char(TYPEOF(col))); } rowWeight = REAL(col); break; } } if (!rowWeight) { mxThrow("Cannot find weight column '%s'", weightColumnName); } } if (freqColumnName) { for (int dc=0; dc < int(dataColNames.size()); ++dc) { if (strEQ(freqColumnName, dataColNames[dc])) { SEXP col = VECTOR_ELT(Rdata, dc); if (TYPEOF(col) != INTSXP) { mxThrow("Column '%s' is of type %s; expecting type integer", dataColNames[dc], Rf_type2char(TYPEOF(col))); } rowFreq = INTEGER(col); break; } } if (!rowFreq) { mxThrow("Cannot find frequency column '%s'", freqColumnName); } } rowMap.reserve(dataRows); for (int rx=0; rx < dataRows; ++rx) rowMap.push_back(rx); } Eigen::Map< Eigen::ArrayXXd > Eparam(param, paramRows, numItems()); Eigen::Map< Eigen::VectorXd > meanVec(mean, itemDims); Eigen::Map< Eigen::MatrixXd > covMat(cov, itemDims, itemDims); quad.setStructure(qwidth, qpoints, Eparam, meanVec, covMat); if (paramRows < impliedParamRows) { mxThrow("At least %d rows are required in the item parameter matrix, only %d found", impliedParamRows, paramRows); } quad.refresh(meanVec, covMat); }
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(); } }