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 }