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 omxCompleteExpectation(omxExpectation *ox) { if(ox->isComplete) return; if (ox->rObj) { omxState *os = ox->currentState; SEXP rObj = ox->rObj; SEXP slot; {ScopedProtect(slot, R_do_slot(rObj, Rf_install("container"))); if (Rf_length(slot) == 1) { int ex = INTEGER(slot)[0]; ox->container = os->expectationList.at(ex); } } {ScopedProtect(slot, R_do_slot(rObj, Rf_install("submodels"))); if (Rf_length(slot)) { int numSubmodels = Rf_length(slot); int *submodel = INTEGER(slot); for (int ex=0; ex < numSubmodels; ex++) { int sx = submodel[ex]; ox->submodels.push_back(omxExpectationFromIndex(sx, os)); } } } } omxExpectationProcessDataStructures(ox, ox->rObj); int numSubmodels = (int) ox->submodels.size(); for (int ex=0; ex < numSubmodels; ex++) { omxCompleteExpectation(ox->submodels[ex]); } ox->initFun(ox); if(ox->computeFun == NULL) { if (isErrorRaised()) { Rf_error("Failed to initialize '%s' of type %s: %s", ox->name, ox->expType, Global->getBads()); } else { Rf_error("Failed to initialize '%s' of type %s", ox->name, ox->expType); } } if (OMX_DEBUG) { omxData *od = ox->data; omxState *state = ox->currentState; std::string msg = string_snprintf("Expectation '%s' of type '%s' has" " %d definition variables:\n", ox->name, ox->expType, int(od->defVars.size())); for (int dx=0; dx < int(od->defVars.size()); ++dx) { omxDefinitionVar &dv = od->defVars[dx]; msg += string_snprintf("[%d] column '%s' ->", dx, omxDataColumnName(od, dv.column)); for (int lx=0; lx < dv.numLocations; ++lx) { msg += string_snprintf(" %s[%d,%d]", state->matrixToName(~dv.matrices[lx]), dv.rows[lx], dv.cols[lx]); } msg += "\n dirty:"; for (int mx=0; mx < dv.numDeps; ++mx) { msg += string_snprintf(" %s", state->matrixToName(dv.deps[mx])); } msg += "\n"; } mxLogBig(msg); } ox->isComplete = TRUE; }