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