Example #1
0
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());
}
Example #2
0
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());
}
Example #3
0
/**
 * 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());
}