/**
* MAP is not affected by the number of items. EAP is. Likelihood can
* get concentrated in a single quadrature ordinate. For 3PL, response
* patterns can have a bimodal likelihood. This will confuse MAP and
* is a key advantage of EAP (Thissen & Orlando, 2001, p. 136).
*
* Thissen, D. & Orlando, M. (2001). IRT for items scored in two
* categories. In D. Thissen & H. Wainer (Eds.), \emph{Test scoring}
* (pp 73-140). Lawrence Erlbaum Associates, Inc.
*/
static void
ba81PopulateAttributes(omxExpectation *oo, SEXP robj)
{
BA81Expect *state = (BA81Expect *) oo->argStruct;
if (!state->debugInternal) return;
ba81NormalQuad &quad = state->getQuad();
int maxAbilities = quad.abilities();
const int numUnique = state->getNumUnique();
const double LogLargest = state->LogLargestDouble;
SEXP Rlik;
if (state->grp.patternLik.size() != numUnique) {
refreshPatternLikelihood(state, oo->dynamicDataSource);
}
Rf_protect(Rlik = Rf_allocVector(REALSXP, numUnique));
memcpy(REAL(Rlik), state->grp.patternLik.data(), sizeof(double) * numUnique);
double *lik_out = REAL(Rlik);
for (int px=0; px < numUnique; ++px) {
// Must return value in log units because it may not be representable otherwise
lik_out[px] = log(lik_out[px]) - LogLargest;
}
MxRList dbg;
dbg.add("patternLikelihood", Rlik);
if (quad.getEstepTableSize(0)) {
SEXP Rexpected;
Rf_protect(Rexpected = Rf_allocVector(REALSXP, quad.getEstepTableSize(0)));
Eigen::Map< Eigen::ArrayXd > box(REAL(Rexpected), quad.getEstepTableSize(0));
quad.exportEstepTable(0, box);
dbg.add("em.expected", Rexpected);
}
SEXP Rmean, Rcov;
if (state->estLatentMean) {
Rf_protect(Rmean = Rf_allocVector(REALSXP, maxAbilities));
memcpy(REAL(Rmean), state->estLatentMean->data, maxAbilities * sizeof(double));
dbg.add("mean", Rmean);
}
if (state->estLatentCov) {
Rf_protect(Rcov = Rf_allocMatrix(REALSXP, maxAbilities, maxAbilities));
memcpy(REAL(Rcov), state->estLatentCov->data, maxAbilities * maxAbilities * sizeof(double));
dbg.add("cov", Rcov);
}
Rf_setAttrib(robj, Rf_install("debug"), dbg.asR());
}
void MarkovExpectation::populateAttr(SEXP robj)
{
compute(0, 0, 0); // needed? TODO
MxRList out;
EigenVectorAdaptor Ei(scaledInitial);
const char *initialName = isMixtureInterface? "weights" : "initial";
out.add(initialName, Rcpp::wrap(Ei));
if (scaledTransition) {
EigenMatrixAdaptor Et(scaledTransition);
out.add("transition", Rcpp::wrap(Et));
}
Rf_setAttrib(robj, Rf_install("output"), out.asR());
}
void omxComputeNumericDeriv::reportResults(FitContext *fc, MxRList *slots, MxRList *result)
{
if (!numParams || !(fc->wanted & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN | FF_COMPUTE_GRADIENT))) return;
if (wantHessian) {
SEXP calculatedHessian;
Rf_protect(calculatedHessian = Rf_allocMatrix(REALSXP, numParams, numParams));
fc->copyDenseHess(REAL(calculatedHessian));
result->add("calculatedHessian", calculatedHessian);
}
MxRList out;
out.add("probeCount", Rf_ScalarInteger(totalProbeCount));
if (detail && recordDetail) {
Eigen::Map< Eigen::ArrayXi > Gsymmetric(LOGICAL(VECTOR_ELT(detail, 0)), numParams);
out.add("gradient", detail);
}
slots->add("output", out.asR());
}