static void omxCallWLSFitFunction(omxFitFunction *oo, int want, FitContext *fc) {
if (want & (FF_COMPUTE_INITIAL_FIT | FF_COMPUTE_PREOPTIMIZE)) return;
if(OMX_DEBUG) { mxLog("Beginning WLS Evaluation.");}
// Requires: Data, means, covariances.
double sum = 0.0;
omxMatrix *eCov, *eMeans, *P, *B, *weights, *oFlat, *eFlat;
omxMatrix *seCov, *seMeans, *seThresholdsMat, *seFlat;
omxWLSFitFunction *owo = ((omxWLSFitFunction*)oo->argStruct);
/* Locals for readability. Compiler should cut through this. */
eCov = owo->expectedCov;
eMeans = owo->expectedMeans;
std::vector< omxThresholdColumn > &eThresh = oo->expectation->thresholds;
oFlat = owo->observedFlattened;
eFlat = owo->expectedFlattened;
weights = owo->weights;
B = owo->B;
P = owo->P;
seCov = owo->standardExpectedCov;
seMeans = owo->standardExpectedMeans;
seThresholdsMat = owo->standardExpectedThresholds;
seFlat = owo->standardExpectedFlattened;
int onei = 1;
omxExpectation* expectation = oo->expectation;
/* Recompute and recopy */
if(OMX_DEBUG) { mxLog("WLSFitFunction Computing expectation"); }
omxExpectationCompute(fc, expectation, NULL);
omxMatrix *expThresholdsMat = expectation->thresholdsMat;
standardizeCovMeansThresholds(eCov, eMeans, expThresholdsMat, eThresh,
seCov, seMeans, seThresholdsMat);
if(expThresholdsMat != NULL){
flattenDataToVector(seCov, seMeans, seThresholdsMat, eThresh, eFlat);
} else {
flattenDataToVector(eCov, eMeans, expThresholdsMat, eThresh, eFlat);
}
omxCopyMatrix(B, oFlat);
//if(OMX_DEBUG) {omxPrintMatrix(B, "....WLS Observed Vector: "); }
if(OMX_DEBUG) {omxPrintMatrix(eFlat, "....WLS Expected Vector: "); }
omxDAXPY(-1.0, eFlat, B);
//if(OMX_DEBUG) {omxPrintMatrix(B, "....WLS Observed - Expected Vector: "); }
if(weights != NULL) {
//if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(weights, "....WLS Weight Matrix: "); }
omxDGEMV(TRUE, 1.0, weights, B, 0.0, P);
} else {
// ULS Case: Memcpy faster than dgemv.
omxCopyMatrix(P, B);
}
sum = F77_CALL(ddot)(&(P->cols), P->data, &onei, B->data, &onei);
oo->matrix->data[0] = sum;
if(OMX_DEBUG) { mxLog("WLSFitFunction value comes to: %f.", oo->matrix->data[0]); }
}
void omxCalculateLISRELCovarianceAndMeans(omxLISRELExpectation* oro) {
omxMatrix* LX = oro->LX;
omxMatrix* LY = oro->LY;
omxMatrix* BE = oro->BE;
omxMatrix* GA = oro->GA;
omxMatrix* PH = oro->PH;
omxMatrix* PS = oro->PS;
omxMatrix* TD = oro->TD;
omxMatrix* TE = oro->TE;
omxMatrix* TH = oro->TH;
omxMatrix* TX = oro->TX;
omxMatrix* TY = oro->TY;
omxMatrix* KA = oro->KA;
omxMatrix* AL = oro->AL;
omxMatrix* Cov = oro->cov;
omxMatrix* Means = oro->means;
int numIters = oro->numIters; //Used for fast RAM/LISREL inverse
omxMatrix* A = oro->A;
omxMatrix* B = oro->B;
omxMatrix* C = oro->C;
omxMatrix* D = oro->D;
omxMatrix* E = oro->E;
omxMatrix* F = oro->F;
omxMatrix* G = oro->G;
omxMatrix* H = oro->H;
omxMatrix* I = oro->I;
omxMatrix* J = oro->J;
omxMatrix* K = oro->K;
omxMatrix* L = oro->L;
omxMatrix* TOP = oro->TOP;
omxMatrix* BOT = oro->BOT;
omxMatrix* MUX = oro->MUX;
omxMatrix* MUY = oro->MUY;
omxMatrix** args = oro->args;
if(OMX_DEBUG) {
mxLog("Running LISREL computation in omxCalculateLISRELCovarianceAndMeans.");
}
double oned = 1.0, zerod=0.0; //, minusOned = -1.0;
//int ipiv[BE->rows], lwork = 4 * BE->rows * BE->cols; //This is copied from omxShallowInverse()
//double work[lwork]; // It lets you get the inverse of a matrix via omxDGETRI()
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(LX, "....LISREL: LX:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(LY, "....LISREL: LY:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(BE, "....LISREL: BE:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(GA, "....LISREL: GA:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(PH, "....LISREL: PH:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(PS, "....LISREL: PS:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TD, "....LISREL: TD:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TE, "....LISREL: TE:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TH, "....LISREL: TH:");
}
/* Calculate the lower right quadrant: the covariance of the Xs */
if(LX->cols != 0 && LY->cols != 0) {
//if( (LX != NULL) && (LY != NULL) ) {
if(OMX_DEBUG) {
mxLog("Calculating Lower Right Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, FALSE, oned, LX, PH, zerod, A); // A = LX*PH
omxCopyMatrix(B, TD); // B = TD
omxDGEMM(FALSE, TRUE, oned, A, LX, oned, B); // B = LX*PH*LX^T + TD
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(B, "....LISREL: Lower Right Quadrant of Model-implied Covariance Matrix:");
}
/* Calculate (I-BE)^(-1) and LY*(I-BE)^(-1) */
if(OMX_DEBUG) {
mxLog("Calculating Inverse of I-BE.");
}
omxShallowInverse(NULL, numIters, BE, C, L, I ); // C = (I-BE)^-1
//omxCopyMatrix(C, BE); // C = BE
//omxDGEMM(FALSE, FALSE, oned, I, I, minusOned, C); // C = I - BE
//omxDGETRF(C, ipiv); //LU Decomp
//omxDGETRI(C, ipiv, work, lwork); //Inverse based on LU Decomp ... C = C^(-1) = (I - BE)^(-1)
omxDGEMM(FALSE, FALSE, oned, LY, C, zerod, D); // D = LY*C = LY * (I - BE)^(-1)
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(D, "....LISREL: LY*(I-BE)^(-1)");
}
/* Calculate the lower left quadrant: the covariance of Xs and Ys, nX by nY */
if(OMX_DEBUG) {
mxLog("Calculating Lower Left Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, TRUE, oned, A, GA, zerod, E); // E = A*GA^T = LX*PH*GA^T
omxCopyMatrix(F, TH); // F = TH
omxDGEMM(FALSE, TRUE, oned, E, D, oned, F); // F = E*D^T + F = LX*PH*GA^T * (LY * (I - BE)^(-1))^T + TH
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(F, "....LISREL: Lower Left Quadrant of Model-implied Covariance Matrix:");
}
/* Calculate the upper right quadrant: NOTE THIS IS MERELY THE LOWER LEFT QUADRANT TRANSPOSED. */
//DONE as omxTranspose(F)
/* Calculate the upper left quadrant: the covariance of the Ys */
if(OMX_DEBUG) {
mxLog("Calculating Upper Left Quadrant of Expected Covariance Matrix.");
}
if(OMX_DEBUG_ALGEBRA) {
mxLog("Calculating G = GA*PH.");
}
omxDGEMM(FALSE, FALSE, oned, GA, PH, zerod, G); // G = GA*PH
if(OMX_DEBUG_ALGEBRA) {
mxLog("Copying C = PS.");
}
omxCopyMatrix(C, PS); // C = PS
if(OMX_DEBUG_ALGEBRA) {
mxLog("Calculating G = GA*PH.");
}
omxDGEMM(FALSE, TRUE, oned, G, GA, oned, C); // C = G*GA^T + C = GA*PH*GA^T + PS
omxDGEMM(FALSE, FALSE, oned, D, C, zerod, H); // H = D*C = LY * (I - BE)^(-1) * (GA*PH*GA^T + PS)
omxCopyMatrix(J, TE); // J = TE
omxDGEMM(FALSE, TRUE, oned, H, D, oned, J); // J = H*D^T + J = LY * (I - BE)^(-1) * (GA*PH*GA^T + PS) * (LY * (I - BE)^(-1))^T + TE
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(J, "....LISREL: Upper Left Quadrant of Model-implied Covariance Matrix:");
}
/* Construct the full model-implied covariance matrix from the blocks previously calculated */
// SigmaHat = ( J t(F) )
// ( F B )
args[0] = F;
args[1] = B;
omxMatrixHorizCat(args, 2, BOT);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(BOT, "....LISREL: BOT = cbind(F, B):");
}
args[0] = J;
omxTransposeMatrix(F);
args[1] = F;
omxMatrixHorizCat(args, 2, TOP);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(args[0], "....LISREL: TOP Debugging args[0] = J:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(args[1], "....LISREL: TOP Debugging args[1] = F:");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(F, "....LISREL: TOP Debugging F (should be 2 rows):");
}
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(TOP, "....LISREL: TOP = cbind(J, t(F)):");
}
omxTransposeMatrix(F); // So that it's back where it was.
args[0] = TOP;
args[1] = BOT;
omxMatrixVertCat(args, 2, Cov);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(Cov, "....LISREL: Model-implied Covariance Matrix:");
}
/* Now Calculate the Expected Means */
if(Means != NULL) {
/* Mean of the Xs */
//if(TX != NULL) {
omxCopyMatrix(MUX, TX);
omxDGEMV(FALSE, oned, LX, KA, oned, MUX);
//}
/* Mean of Ys */
//if(TY != NULL) {
omxCopyMatrix(K, AL);
omxDGEMV(FALSE, oned, GA, KA, oned, K);
omxCopyMatrix(MUY, TY);
omxDGEMV(FALSE, oned, D, K, oned, MUY);
//}
/* Build means from blocks */
args[0] = MUY;
args[1] = MUX;
omxMatrixVertCat(args, 2, Means);
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(Means, "....LISREL: Model-implied Means Vector:");
}
}
}
else if(LX->cols != 0) { /* IF THE MODEL ONLY HAS Xs */
//else if(LX != NULL) { /* IF THE MODEL ONLY HAS Xs */
if(OMX_DEBUG) {
mxLog("Calculating Lower Right Quadrant of Expected Covariance Matrix.");
}
omxDGEMM(FALSE, FALSE, oned, LX, PH, zerod, A); // A = LX*PH
omxCopyMatrix(Cov, TD); // Cov = TD
omxDGEMM(FALSE, TRUE, oned, A, LX, oned, Cov); // Cov = LX*PH*LX^T + Cov
if(Means != NULL) {
/* Mean of the Xs */
omxCopyMatrix(Means, TX);
omxDGEMV(FALSE, oned, LX, KA, oned, Means);
}
}
/* IF THE MODEL ONLY HAS Ys */
else if(LY->cols != 0) {
//else if(LY != NULL) {
/* Calculate (I-BE)^(-1) and LY*(I-BE)^(-1) */
if(OMX_DEBUG) {
mxLog("Calculating Inverse of I-BE.");
}
omxShallowInverse(NULL, numIters, BE, C, L, I ); // C = (I-BE)^-1
//omxCopyMatrix(C, BE); // C = BE
//omxDGEMM(FALSE, FALSE, oned, I, I, minusOned, C); // C = I - BE
//omxDGETRF(C, ipiv); //LU Decomp
//omxDGETRI(C, ipiv, work, lwork); //Inverse based on LU Decomp ... C = C^(-1) = (I - BE)^(-1)
omxDGEMM(FALSE, FALSE, oned, LY, C, zerod, D); // D = LY*C = LY * (I - BE)^(-1)
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(D, "....LISREL: LY*(I-BE)^(-1)");
}
/* Calculate the upper left quadrant: the covariance of the Ys */
if(OMX_DEBUG) {
mxLog("Calculating Upper Left Quadrant of Expected Covariance Matrix.");
}
if(OMX_DEBUG_ALGEBRA) {
mxLog("Copying C = PS.");
}
omxDGEMM(FALSE, FALSE, oned, D, PS, zerod, H); // H = D*PS = LY * (I - BE)^(-1) * PS
omxCopyMatrix(Cov, TE); // Cov = TE
omxDGEMM(FALSE, TRUE, oned, H, D, oned, Cov); // Cov = H*D^T + Cov = LY * (I - BE)^(-1) * PS * (LY * (I - BE)^(-1))^T + TE
if(OMX_DEBUG_ALGEBRA) {
omxPrintMatrix(J, "....LISREL: Upper Left Quadrant of Model-implied Covariance Matrix:");
}
if(Means != NULL) {
omxCopyMatrix(Means, TY);
omxDGEMV(FALSE, oned, D, AL, oned, Means);
}
}
/*
if(OMX_DEBUG) { mxLog("Running RAM computation."); }
double oned = 1.0, zerod=0.0;
if(Ax == NULL || I == NULL || Z == NULL || Y == NULL || X == NULL) {
Rf_error("Internal Error: RAM Metadata improperly populated. Please report this to the OpenMx development team.");
}
if(Cov == NULL && Means == NULL) {
return; // We're not populating anything, so why bother running the calculation?
}
// if( (Cov->rows != Cov->cols) || (A->rows != A->cols) // Conformance check
// || (X->rows != Cov->cols) || (X->cols != A->rows)
// || (Y->rows != Cov->cols) || (Y->cols != A->rows)
// || (Ax->rows != Cov->cols) || (Ax->cols != A->rows)
// || (I->rows != Cov->cols) || (I->cols != Cov->rows)
// || (Y->rows != Cov->cols) || (Y->cols != A->rows)
// || (M->cols != Cov->cols) || (M->rows != 1)
// || (Means->rows != 1) || (Means->cols != Cov->cols) ) {
// Rf_error("INTERNAL ERROR: Incorrectly sized matrices being passed to omxRAMObjective Calculation.\n Please report this to the OpenMx development team.");
// }
omxShallowInverse(numIters, A, Z, Ax, I );
// IMPORTANT: Cov = FZSZ'F'
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(F->majority), *(Z->majority), (F->rows), (Z->cols), (Z->rows), oned, F->data, (F->leading), Z->data, (Z->leading), zerod, Y->data, (Y->leading));}
// F77_CALL(omxunsafedgemm)(F->majority, Z->majority, &(F->rows), &(Z->cols), &(Z->rows), &oned, F->data, &(F->leading), Z->data, &(Z->leading), &zerod, Y->data, &(Y->leading)); // Y = FZ
omxDGEMM(FALSE, FALSE, 1.0, F, Z, 0.0, Y);
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(Y->majority), *(S->majority), (Y->rows), (S->cols), (S->rows), oned, Y->data, (Y->leading), S->data, (S->leading), zerod, X->data, (X->leading));}
// F77_CALL(omxunsafedgemm)(Y->majority, S->majority, &(Y->rows), &(S->cols), &(S->rows), &oned, Y->data, &(Y->leading), S->data, &(S->leading), &zerod, X->data, &(X->leading)); // X = FZS
omxDGEMM(FALSE, FALSE, 1.0, Y, S, 0.0, X);
if(OMX_DEBUG_ALGEBRA) { mxLog("....DGEMM: %c %c %d %d %d %f %x %d %x %d %f %x %d.", *(X->majority), *(Y->minority), (X->rows), (Y->rows), (Y->cols), oned, X->data, (X->leading), Y->data, (Y->lagging), zerod, Cov->data, (Cov->leading));}
// F77_CALL(omxunsafedgemm)(X->majority, Y->minority, &(X->rows), &(Y->rows), &(Y->cols), &oned, X->data, &(X->leading), Y->data, &(Y->leading), &zerod, Cov->data, &(Cov->leading));
omxDGEMM(FALSE, TRUE, 1.0, X, Y, 0.0, Cov);
// Cov = FZSZ'F' (Because (FZ)' = Z'F')
if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(Cov, "....RAM: Model-implied Covariance Matrix:");}
if(M != NULL && Means != NULL) {
// F77_CALL(omxunsafedgemv)(Y->majority, &(Y->rows), &(Y->cols), &oned, Y->data, &(Y->leading), M->data, &onei, &zerod, Means->data, &onei);
omxDGEMV(FALSE, 1.0, Y, M, 0.0, Means);
if(OMX_DEBUG_ALGEBRA) {omxPrintMatrix(Means, "....RAM: Model-implied Means Vector:");}
}
*/
}