Example #1
0
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]); }
	
}
Example #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** 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:");}
    	}
    */
}