Beispiel #1
0
void normalToStdVector(omxMatrix *cov, omxMatrix *mean, omxMatrix *slope, omxMatrix *thr,
		       int numOrdinal, std::vector< omxThresholdColumn > &ti,
		       Eigen::Ref<Eigen::VectorXd> out)
{
	// order of elements: (c.f. lav_model_wls, lavaan 0.6-2)
	// 1. thresholds + means (interleaved)
	// 2. slopes (if any, columnwise per exo)
	// 3. variances (continuous indicators only)
	// 4. covariances; not correlations (lower triangle)

	EigenMatrixAdaptor Ecov(cov);
	if (numOrdinal == 0) {
		int dx = 0;
		if (mean) {
			EigenVectorAdaptor Emean(mean);
			for (int rx=0; rx < cov->cols; ++rx) {
				out[dx++] = Emean(rx);
			}
		}
		if (slope) {
			EigenMatrixAdaptor Eslope(slope);
			for (int cx=0; cx < Eslope.cols(); ++cx) {
				for (int rx=0; rx < Eslope.rows(); ++rx) {
					out[dx++] = Eslope(rx,cx);
				}
			}
		}
		for (int cx=0; cx < cov->cols; ++cx) {
			out[dx++] = Ecov(cx,cx);
		}
		for (int cx=0; cx < cov->cols-1; ++cx) {
			for (int rx=cx+1; rx < cov->rows; ++rx) {
				out[dx++] = Ecov(rx,cx);
			}
		}
		return;
	}
	if (!mean) Rf_error("ordinal indicators and no mean vector");

	EigenVectorAdaptor Emean(mean);
	EigenMatrixAdaptor Eth(thr);
	Eigen::VectorXd sdTmp(1.0/Ecov.diagonal().array().sqrt());
	Eigen::DiagonalMatrix<double, Eigen::Dynamic> sd(Emean.size());
	sd.setIdentity();
	
	int dx = 0;
	for (auto &th : ti) {
		for (int t1=0; t1 < th.numThresholds; ++t1) {
			double sd1 = sdTmp[th.dColumn];
			out[dx++] = (Eth(t1, th.column) - Emean[th.dColumn]) * sd1;
			sd.diagonal()[th.dColumn] = sd1;
		}
		if (!th.numThresholds) {
			out[dx++] = Emean[th.dColumn];
		}
	}
	
	if (slope) {
		EigenMatrixAdaptor Eslope(slope);
		for (int cx=0; cx < Eslope.cols(); ++cx) {
			for (int rx=0; rx < Eslope.rows(); ++rx) {
				out[dx++] = Eslope(rx,cx);
			}
		}
	}

	Eigen::MatrixXd stdCov(sd * Ecov * sd);

	for (int cx=0; cx < cov->cols; ++cx) {
		if (ti[cx].numThresholds) continue;
		out[dx++] = stdCov(cx,cx);
	}

	for (int cx=0; cx < cov->cols-1; ++cx) {
		for (int rx=cx+1; rx < cov->rows; ++rx) {
			out[dx++] = stdCov(rx,cx);
		}
	}
}
Beispiel #2
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 *slope = oro->slope;
	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);
				if (slope) {
					EigenVectorAdaptor Emean(MUY);
					EigenMatrixAdaptor Eslope(slope);
					Emean += Eslope * oro->exoPredMean;
				}
			//}
		
			/* Build means from blocks */
			args[0] = MUY;
			args[1] = MUX;
			omxMatrixVertCat(args, 2, Means);
		}
	}
	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 (slope) {
					EigenVectorAdaptor Emean(Means);
					EigenMatrixAdaptor Eslope(slope);
					Emean += Eslope * oro->exoPredMean;
				}
		}
	}
	if (Means && OMX_DEBUG_ALGEBRA) omxPrintMatrix(Means, "....LISREL: Model-implied Means Vector:");
/*	
	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) {
		mxThrow("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) ) {
	// 		mxThrow("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:");}
	}
*/
}