void flattenDataToVector(omxMatrix* cov, omxMatrix* means, omxMatrix *obsThresholdMat,
std::vector< omxThresholdColumn > &thresholds, omxMatrix* vector) {
// TODO: vectorize data flattening
// if(OMX_DEBUG) { mxLog("Flattening out data vectors: cov 0x%x, mean 0x%x, thresh 0x%x[n=%d] ==> 0x%x",
// cov, means, thresholds, nThresholds, vector); }
int nextLoc = 0;
for(int j = 0; j < cov->rows; j++) {
for(int k = j; k < cov->rows; k++) {
omxSetVectorElement(vector, nextLoc, omxMatrixElement(cov, j, k)); // Use upper triangle in case of SYMM-style mat.
nextLoc++;
}
}
if (means != NULL) {
for(int j = 0; j < cov->rows; j++) {
omxSetVectorElement(vector, nextLoc, omxVectorElement(means, j));
nextLoc++;
}
}
for(int j = 0; j < int(thresholds.size()); j++) {
omxThresholdColumn* thresh = &thresholds[j];
for(int k = 0; k < thresh->numThresholds; k++) {
omxSetVectorElement(vector, nextLoc, omxMatrixElement(obsThresholdMat, k, thresh->column));
nextLoc++;
}
}
}
void omxPopulateFIMLAttributes(omxFitFunction *off, SEXP algebra) {
if(OMX_DEBUG) { mxLog("Populating FIML Attributes."); }
omxFIMLFitFunction *argStruct = ((omxFIMLFitFunction*)off->argStruct);
SEXP expCovExt, expMeanExt, rowLikelihoodsExt;
omxMatrix *expCovInt, *expMeanInt;
expCovInt = argStruct->cov;
expMeanInt = argStruct->means;
Rf_protect(expCovExt = Rf_allocMatrix(REALSXP, expCovInt->rows, expCovInt->cols));
for(int row = 0; row < expCovInt->rows; row++)
for(int col = 0; col < expCovInt->cols; col++)
REAL(expCovExt)[col * expCovInt->rows + row] =
omxMatrixElement(expCovInt, row, col);
if (expMeanInt != NULL && expMeanInt->rows > 0 && expMeanInt->cols > 0) {
Rf_protect(expMeanExt = Rf_allocMatrix(REALSXP, expMeanInt->rows, expMeanInt->cols));
for(int row = 0; row < expMeanInt->rows; row++)
for(int col = 0; col < expMeanInt->cols; col++)
REAL(expMeanExt)[col * expMeanInt->rows + row] =
omxMatrixElement(expMeanInt, row, col);
} else {
Rf_protect(expMeanExt = Rf_allocMatrix(REALSXP, 0, 0));
}
Rf_setAttrib(algebra, Rf_install("expCov"), expCovExt);
Rf_setAttrib(algebra, Rf_install("expMean"), expMeanExt);
if(argStruct->populateRowDiagnostics){
omxMatrix *rowLikelihoodsInt = argStruct->rowLikelihoods;
Rf_protect(rowLikelihoodsExt = Rf_allocVector(REALSXP, rowLikelihoodsInt->rows));
for(int row = 0; row < rowLikelihoodsInt->rows; row++)
REAL(rowLikelihoodsExt)[row] = omxMatrixElement(rowLikelihoodsInt, row, 0);
Rf_setAttrib(algebra, Rf_install("likelihoods"), rowLikelihoodsExt);
}
}
static void setLatentStartingValues(omxFitFunction *oo, FitContext *fc) //remove? TODO
{
BA81FitState *state = (BA81FitState*) oo->argStruct;
BA81Expect *estate = (BA81Expect*) oo->expectation->argStruct;
std::vector<int> &latentMap = state->latentMap;
ba81NormalQuad &quad = estate->getQuad();
int maxAbilities = quad.maxAbilities;
omxMatrix *estMean = estate->estLatentMean;
omxMatrix *estCov = estate->estLatentCov;
for (int a1 = 0; a1 < maxAbilities; ++a1) {
if (latentMap[a1] >= 0) {
int to = latentMap[a1];
fc->est[to] = omxVectorElement(estMean, a1);
}
for (int a2 = 0; a2 <= a1; ++a2) {
int to = latentMap[maxAbilities + triangleLoc1(a1) + a2];
if (to < 0) continue;
fc->est[to] = omxMatrixElement(estCov, a1, a2);
}
}
if (estate->verbose >= 1) {
mxLog("%s: set latent parameters for version %d",
oo->name(), estate->ElatentVersion);
}
}
void omxCopyMatrixToRow(omxMatrix* source, int row, omxMatrix* target) {
int i;
for(i = 0; i < source->cols; i++) {
omxSetMatrixElement(target, row, i, omxMatrixElement(source, 0, i));
}
}
/**
* Copies an omxMatrix to a new R matrix object
*
* \param om the omxMatrix to copy
* \return a Rf_protect'd SEXP for the R matrix object
*/
SEXP omxExportMatrix(omxMatrix *om) {
SEXP nextMat;
Rf_protect(nextMat = Rf_allocMatrix(REALSXP, om->rows, om->cols));
for(int row = 0; row < om->rows; row++) {
for(int col = 0; col < om->cols; col++) {
REAL(nextMat)[col * om->rows + row] =
omxMatrixElement(om, row, col);
}
}
return nextMat;
}
void loglikelihoodCIFun(omxFitFunction *ff, int want, FitContext *fc)
{
const omxConfidenceInterval *CI = fc->CI;
if (want & FF_COMPUTE_PREOPTIMIZE) {
fc->targetFit = (fc->lowerBound? CI->lbound : CI->ubound) + fc->fit;
//mxLog("Set target fit to %f (MLE %f)", fc->targetFit, fc->fit);
return;
}
if (!(want & FF_COMPUTE_FIT)) {
Rf_error("Not implemented yet");
}
omxMatrix *fitMat = ff->matrix;
// We need to compute the fit here because that's the only way to
// check our soft feasibility constraints. If parameters don't
// change between here and the constraint evaluation then we
// should avoid recomputing the fit again in the constraint. TODO
omxFitFunctionCompute(fitMat->fitFunction, FF_COMPUTE_FIT, fc);
const double fit = totalLogLikelihood(fitMat);
omxRecompute(CI->matrix, fc);
double CIElement = omxMatrixElement(CI->matrix, CI->row, CI->col);
omxResizeMatrix(fitMat, 1, 1);
if (!std::isfinite(fit) || !std::isfinite(CIElement)) {
fc->recordIterationError("Confidence interval is in a range that is currently incalculable. Add constraints to keep the value in the region where it can be calculated.");
fitMat->data[0] = nan("infeasible");
return;
}
if (want & FF_COMPUTE_FIT) {
double param = (fc->lowerBound? CIElement : -CIElement);
if (fc->compositeCIFunction) {
double diff = fc->targetFit - fit;
diff *= diff;
if (diff > 1e2) {
// Ensure there aren't any creative solutions
diff = nan("infeasible");
return;
}
fitMat->data[0] = diff + param;
} else {
fitMat->data[0] = param;
}
//mxLog("param at %f", fitMat->data[0]);
}
if (want & (FF_COMPUTE_GRADIENT | FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)) {
// add deriv adjustments here TODO
}
}
void omxPopulateNormalAttributes(omxExpectation *ox, SEXP algebra) {
if(OMX_DEBUG) { mxLog("Populating Normal Attributes."); }
omxNormalExpectation* one = (omxNormalExpectation*) (ox->argStruct);
omxMatrix *cov = one->cov;
omxMatrix *means = one->means;
omxRecompute(cov, NULL);
if(means != NULL) omxRecompute(means, NULL);
{
SEXP expCovExt;
ScopedProtect p1(expCovExt, Rf_allocMatrix(REALSXP, cov->rows, cov->cols));
for(int row = 0; row < cov->rows; row++)
for(int col = 0; col < cov->cols; col++)
REAL(expCovExt)[col * cov->rows + row] =
omxMatrixElement(cov, row, col);
Rf_setAttrib(algebra, Rf_install("ExpCov"), expCovExt);
}
if (means != NULL) {
SEXP expMeanExt;
ScopedProtect p1(expMeanExt, Rf_allocMatrix(REALSXP, means->rows, means->cols));
for(int row = 0; row < means->rows; row++)
for(int col = 0; col < means->cols; col++)
REAL(expMeanExt)[col * means->rows + row] =
omxMatrixElement(means, row, col);
Rf_setAttrib(algebra, Rf_install("ExpMean"), expMeanExt);
} else {
SEXP expMeanExt;
ScopedProtect p1(expMeanExt, Rf_allocMatrix(REALSXP, 0, 0));
Rf_setAttrib(algebra, Rf_install("ExpMean"), expMeanExt);
}
Rf_setAttrib(algebra, Rf_install("numStats"), Rf_ScalarReal(omxDataDF(ox->data)));
}
void omxComputeNumericDeriv::omxEstimateHessianOffDiagonal(int i, int l, struct hess_struct* hess_work)
{
int ix = paramMap[i];
int lx = paramMap[l];
static const double v = 2.0; //Note: NumDeriv comments that this could be a parameter, but is hard-coded in the algorithm
double *Haprox = hess_work->Haprox;
omxMatrix* fitMatrix = hess_work->fitMatrix;
FitContext* fc = hess_work->fc;
double *freeParams = fc->est;
double iOffset = std::max(fabs(stepSize*optima[i]), stepSize);
double lOffset = std::max(fabs(stepSize*optima[l]), stepSize);
for(int k = 0; k < numIter; k++) {
freeParams[ix] = optima[i] + iOffset;
freeParams[lx] = optima[l] + lOffset;
fc->copyParamToModel();
++hess_work->probeCount;
omxRecompute(fitMatrix, fc);
double f1 = omxMatrixElement(fitMatrix, 0, 0);
freeParams[ix] = optima[i] - iOffset;
freeParams[lx] = optima[l] - lOffset;
fc->copyParamToModel();
++hess_work->probeCount;
omxRecompute(fitMatrix, fc);
double f2 = omxMatrixElement(fitMatrix, 0, 0);
Haprox[k] = (f1 - 2.0 * minimum + f2 - hessian[i*numParams+i]*iOffset*iOffset -
hessian[l*numParams+l]*lOffset*lOffset)/(2.0*iOffset*lOffset);
if(verbose >= 2) {
mxLog("Hessian first off-diagonal calculation: Haprox = %f, iOffset = %f, lOffset=%f from params %f, %f and %f, %f and %d (also: %f, %f and %f)",
Haprox[k], iOffset, lOffset, f1, hessian[i*numParams+i], hessian[l*numParams+l],
v, k, pow(v, k), stepSize*optima[i], stepSize*optima[l]);
}
freeParams[ix] = optima[i]; // Reset parameter values
freeParams[lx] = optima[l];
iOffset = iOffset / v; // And shrink step
lOffset = lOffset / v;
}
for(int m = 1; m < numIter; m++) { // Richardson Step
for(int k = 0; k < (numIter - m); k++) {
//if(OMX_DEBUG) {mxLog("Hessian off-diagonal calculation: Haprox = %f, iOffset = %f, lOffset=%f from params %f, %f and %f, %f and %d (also: %f, %f and %f, and %f).", Haprox[k], iOffset, lOffset, stepSize, optima[i], optima[l], v, m, pow(4.0, m), stepSize*optima[i], stepSize*optima[l], k);}
Haprox[k] = (Haprox[k+1] * pow(4.0, m) - Haprox[k]) / (pow(4.0, m)-1);
}
}
if(verbose >= 2) {
mxLog("Hessian estimation: Populating Hessian"
" ([%d, %d] = %d and %d) with value %f...",
i, l, i*numParams+l, l*numParams+i, Haprox[0]);
}
hessian[i*numParams+l] = Haprox[0];
hessian[l*numParams+i] = Haprox[0];
}
/**
@params i parameter number
@params hess_work local copy
@params optima shared read-only variable
@params gradient shared write-only variable
@params hessian shared write-only variable
*/
void omxComputeNumericDeriv::omxEstimateHessianOnDiagonal(int i, struct hess_struct* hess_work)
{
int ix = paramMap[i];
static const double v = 2.0; //Note: NumDeriv comments that this could be a parameter, but is hard-coded in the algorithm
double *Haprox = hess_work->Haprox;
double *Gcentral = hess_work->Gcentral;
double *Gforward = hess_work->Gforward;
double *Gbackward = hess_work->Gbackward;
omxMatrix* fitMatrix = hess_work->fitMatrix;
FitContext* fc = hess_work->fc;
double *freeParams = fc->est;
/* Part the first: Gradient and diagonal */
double iOffset = std::max(fabs(stepSize * optima[i]), stepSize);
for(int k = 0; k < numIter; k++) { // Decreasing step size, starting at k == 0
freeParams[ix] = optima[i] + iOffset;
fc->copyParamToModel();
++hess_work->probeCount;
omxRecompute(fitMatrix, fc);
double f1 = omxMatrixElement(fitMatrix, 0, 0);
freeParams[ix] = optima[i] - iOffset;
fc->copyParamToModel();
++hess_work->probeCount;
omxRecompute(fitMatrix, fc);
double f2 = omxMatrixElement(fitMatrix, 0, 0);
Gcentral[k] = (f1 - f2) / (2.0*iOffset); // This is for the gradient
Gforward[k] = (minimum - f2) / iOffset;
Gbackward[k] = (f1 - minimum) / iOffset;
Haprox[k] = (f1 - 2.0 * minimum + f2) / (iOffset * iOffset); // This is second derivative
freeParams[ix] = optima[i]; // Reset parameter value
iOffset /= v;
if(verbose >= 2) {
mxLog("Hessian: diag[%s] Δ%g (#%d) F1 %f F2 %f grad %f hess %f",
fc->varGroup->vars[i]->name, iOffset, k, f1, f2, Gcentral[k], Haprox[k]);
}
}
for(int m = 1; m < numIter; m++) { // Richardson Step
for(int k = 0; k < (numIter - m); k++) {
// NumDeriv Hard-wires 4s for r here. Why?
Gcentral[k] = (Gcentral[k+1] * pow(4.0, m) - Gcentral[k])/(pow(4.0, m)-1);
Gforward[k] = (Gforward[k+1] * pow(4.0, m) - Gforward[k])/(pow(4.0, m)-1);
Gbackward[k] = (Gbackward[k+1] * pow(4.0, m) - Gbackward[k])/(pow(4.0, m)-1);
Haprox[k] = (Haprox[k+1] * pow(4.0, m) - Haprox[k])/(pow(4.0, m)-1);
}
}
if(verbose >= 2) {
mxLog("Hessian: diag[%s] final grad %f hess %f", fc->varGroup->vars[i]->name, Gcentral[0], Haprox[0]);
}
gcentral[i] = Gcentral[0];
gforward[i] = Gforward[0];
gbackward[i] = Gbackward[0];
if (hessian) hessian[i*numParams + i] = Haprox[0];
}
void omxPopulateWLSAttributes(omxFitFunction *oo, SEXP algebra) {
if(OMX_DEBUG) { mxLog("Populating WLS Attributes."); }
omxWLSFitFunction *argStruct = ((omxWLSFitFunction*)oo->argStruct);
omxMatrix *expCovInt = argStruct->expectedCov; // Expected covariance
omxMatrix *expMeanInt = argStruct->expectedMeans; // Expected means
omxMatrix *weightInt = argStruct->weights; // Expected means
SEXP expCovExt, expMeanExt, gradients;
Rf_protect(expCovExt = Rf_allocMatrix(REALSXP, expCovInt->rows, expCovInt->cols));
for(int row = 0; row < expCovInt->rows; row++)
for(int col = 0; col < expCovInt->cols; col++)
REAL(expCovExt)[col * expCovInt->rows + row] =
omxMatrixElement(expCovInt, row, col);
if (expMeanInt != NULL) {
Rf_protect(expMeanExt = Rf_allocMatrix(REALSXP, expMeanInt->rows, expMeanInt->cols));
for(int row = 0; row < expMeanInt->rows; row++)
for(int col = 0; col < expMeanInt->cols; col++)
REAL(expMeanExt)[col * expMeanInt->rows + row] =
omxMatrixElement(expMeanInt, row, col);
} else {
Rf_protect(expMeanExt = Rf_allocMatrix(REALSXP, 0, 0));
}
if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(weightInt, "...WLS Weight Matrix: W"); }
SEXP weightExt = NULL;
if (weightInt) {
Rf_protect(weightExt = Rf_allocMatrix(REALSXP, weightInt->rows, weightInt->cols));
for(int row = 0; row < weightInt->rows; row++)
for(int col = 0; col < weightInt->cols; col++)
REAL(weightExt)[col * weightInt->rows + row] = weightInt->data[col * weightInt->rows + row];
}
if(0) { /* TODO fix for new internal API
int nLocs = Global->numFreeParams;
double gradient[Global->numFreeParams];
for(int loc = 0; loc < nLocs; loc++) {
gradient[loc] = NA_REAL;
}
//oo->gradientFun(oo, gradient);
Rf_protect(gradients = Rf_allocMatrix(REALSXP, 1, nLocs));
for(int loc = 0; loc < nLocs; loc++)
REAL(gradients)[loc] = gradient[loc];
*/
} else {
Rf_protect(gradients = Rf_allocMatrix(REALSXP, 0, 0));
}
if(OMX_DEBUG) { mxLog("Installing populated WLS Attributes."); }
Rf_setAttrib(algebra, Rf_install("expCov"), expCovExt);
Rf_setAttrib(algebra, Rf_install("expMean"), expMeanExt);
if (weightExt) Rf_setAttrib(algebra, Rf_install("weights"), weightExt);
Rf_setAttrib(algebra, Rf_install("gradients"), gradients);
Rf_setAttrib(algebra, Rf_install("SaturatedLikelihood"), Rf_ScalarReal(0));
//Rf_setAttrib(algebra, Rf_install("IndependenceLikelihood"), Rf_ScalarReal(0));
Rf_setAttrib(algebra, Rf_install("ADFMisfit"), Rf_ScalarReal(omxMatrixElement(oo->matrix, 0, 0)));
}
void AlgebraFitFunction::compute(int want, FitContext *fc)
{
if (fc && varGroup != fc->varGroup) {
setVarGroup(fc->varGroup);
}
if (want & (FF_COMPUTE_FIT | FF_COMPUTE_INITIAL_FIT | FF_COMPUTE_PREOPTIMIZE)) {
if (algebra) {
omxRecompute(algebra, fc);
ff->matrix->data[0] = algebra->data[0];
} else {
ff->matrix->data[0] = 0;
}
}
if (gradMap.size() == 0) return;
if (gradient) {
omxRecompute(gradient, fc);
if (want & FF_COMPUTE_GRADIENT) {
for (size_t v1=0; v1 < gradMap.size(); ++v1) {
int to = gradMap[v1];
if (to < 0) continue;
fc->grad(to) += omxVectorElement(gradient, v1);
}
}
if (want & FF_COMPUTE_INFO && fc->infoMethod == INFO_METHOD_MEAT) {
std::vector<double> grad(varGroup->vars.size());
for (size_t v1=0; v1 < gradMap.size(); ++v1) {
int to = gradMap[v1];
if (to < 0) continue;
grad[to] += omxVectorElement(gradient, v1);
}
addSymOuterProd(1, grad.data(), varGroup->vars.size(), fc->infoB);
}
}
if (hessian && ((want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)) ||
(want & FF_COMPUTE_INFO && fc->infoMethod == INFO_METHOD_HESSIAN))) {
omxRecompute(hessian, fc);
if (!vec2diag) {
HessianBlock *hb = new HessianBlock;
hb->vars.resize(numDeriv);
int vx=0;
for (size_t h1=0; h1 < gradMap.size(); ++h1) {
if (gradMap[h1] < 0) continue;
hb->vars[vx] = gradMap[h1];
++vx;
}
hb->mat.resize(numDeriv, numDeriv);
for (size_t d1=0, h1=0; h1 < gradMap.size(); ++h1) {
if (gradMap[h1] < 0) continue;
for (size_t d2=0, h2=0; h2 <= h1; ++h2) {
if (gradMap[h2] < 0) continue;
if (h1 == h2) {
hb->mat(d2,d1) = omxMatrixElement(hessian, h2, h1);
} else {
double coef1 = omxMatrixElement(hessian, h2, h1);
double coef2 = omxMatrixElement(hessian, h1, h2);
if (coef1 != coef2) {
Rf_warning("%s: Hessian algebra '%s' is not symmetric at [%d,%d]",
ff->matrix->name(), hessian->name(), 1+h2, 1+h1);
}
hb->mat(d2,d1) = coef1;
}
++d2;
}
++d1;
}
fc->queue(hb);
} else {
for (size_t h1=0; h1 < gradMap.size(); ++h1) {
int to = gradMap[h1];
if (to < 0) continue;
HessianBlock *hb = new HessianBlock;
hb->vars.assign(1, to);
hb->mat.resize(1,1);
hb->mat(0,0) = omxMatrixElement(hessian, h1, h1);
fc->queue(hb);
}
}
}
// complain if unimplemented FF_COMPUTE_INFO requested? TODO
}
