Esempio n. 1
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)));
}
Esempio n. 2
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]); }
	
}
Esempio n. 3
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:");}
    	}
    */
}
Esempio n. 4
0
static void CallFIMLFitFunction(omxFitFunction *off, int want, FitContext *fc)
{
	// TODO: Figure out how to give access to other per-iteration structures.
	// TODO: Current implementation is slow: update by filtering correlations and thresholds.
	// TODO: Current implementation does not implement speedups for sorting.
	// TODO: Current implementation may fail on all-continuous-missing or all-ordinal-missing rows.
	
	if (want & (FF_COMPUTE_PREOPTIMIZE)) return;

    if(OMX_DEBUG) { 
	    mxLog("Beginning Joint FIML Evaluation.");
    }
	int returnRowLikelihoods = 0;

	omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*)off->argStruct);
	omxMatrix* fitMatrix  = off->matrix;
	int numChildren = (int) fc->childList.size();

	omxMatrix *cov 		= ofiml->cov;
	omxMatrix *means	= ofiml->means;
	if (!means) {
		omxRaiseErrorf("%s: raw data observed but no expected means "
			       "vector was provided. Add something like mxPath(from = 'one',"
			       " to = manifests) to your model.", off->name());
		return;
	}
	omxData* data           = ofiml->data;                            //  read-only
	omxMatrix *dataColumns	= ofiml->dataColumns;

	returnRowLikelihoods = ofiml->returnRowLikelihoods;   //  read-only
	omxExpectation* expectation = off->expectation;
	std::vector< omxThresholdColumn > &thresholdCols = expectation->thresholds;

	if (data->defVars.size() == 0 && !strEQ(expectation->expType, "MxExpectationStateSpace")) {
		if(OMX_DEBUG) {mxLog("Precalculating cov and means for all rows.");}
		omxExpectationRecompute(fc, expectation);
		// MCN Also do the threshold formulae!
		
		for(int j=0; j < dataColumns->cols; j++) {
			int var = omxVectorElement(dataColumns, j);
			if (!omxDataColumnIsFactor(data, var)) continue;
			if (j < int(thresholdCols.size()) && thresholdCols[j].numThresholds > 0) { // j is an ordinal column
				omxMatrix* nextMatrix = thresholdCols[j].matrix;
				omxRecompute(nextMatrix, fc);
				checkIncreasing(nextMatrix, thresholdCols[j].column, thresholdCols[j].numThresholds, fc);
				for(int index = 0; index < numChildren; index++) {
					FitContext *kid = fc->childList[index];
					omxMatrix *target = kid->lookupDuplicate(nextMatrix);
					omxCopyMatrix(target, nextMatrix);
				}
			} else {
				Rf_error("No threshold given for ordinal column '%s'",
					 omxDataColumnName(data, j));
			}
		}

		double *corList 	= ofiml->corList;
		double *weights		= ofiml->weights;

		if (corList) {
			omxStandardizeCovMatrix(cov, corList, weights, fc);	// Calculate correlation and covariance
		}
		for(int index = 0; index < numChildren; index++) {
			FitContext *kid = fc->childList[index];
			omxMatrix *childFit = kid->lookupDuplicate(fitMatrix);
			omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
			omxCopyMatrix(childOfiml->cov, cov);
			omxCopyMatrix(childOfiml->means, means);
			if (corList) {
				memcpy(childOfiml->weights, weights, sizeof(double) * cov->rows);
				memcpy(childOfiml->corList, corList, sizeof(double) * (cov->rows * (cov->rows - 1)) / 2);
			}
		}
		if(OMX_DEBUG) { omxPrintMatrix(cov, "Cov"); }
		if(OMX_DEBUG) { omxPrintMatrix(means, "Means"); }
    }

	memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
    
	int parallelism = (numChildren == 0) ? 1 : numChildren;

	if (parallelism > data->rows) {
		parallelism = data->rows;
	}

	FIMLSingleIterationType singleIter = ofiml->SingleIterFn;

	bool failed = false;
	if (parallelism > 1) {
		int stride = (data->rows / parallelism);

#pragma omp parallel for num_threads(parallelism) reduction(||:failed)
		for(int i = 0; i < parallelism; i++) {
			FitContext *kid = fc->childList[i];
			omxMatrix *childMatrix = kid->lookupDuplicate(fitMatrix);
			omxFitFunction *childFit = childMatrix->fitFunction;
			if (i == parallelism - 1) {
				failed |= singleIter(kid, childFit, off, stride * i, data->rows - stride * i);
			} else {
				failed |= singleIter(kid, childFit, off, stride * i, stride);
			}
		}
	} else {
		failed |= singleIter(fc, off, off, 0, data->rows);
	}
	if (failed) {
		omxSetMatrixElement(off->matrix, 0, 0, NA_REAL);
		return;
	}

	if(!returnRowLikelihoods) {
		double val, sum = 0.0;
		// floating-point addition is not associative,
		// so we serialized the following reduction operation.
		for(int i = 0; i < data->rows; i++) {
			val = omxVectorElement(ofiml->rowLogLikelihoods, i);
//			mxLog("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
			sum += val;
		}	
		if(OMX_DEBUG) {mxLog("Total Likelihood is %3.3f", sum);}
		omxSetMatrixElement(off->matrix, 0, 0, sum);
	}
}
Esempio n. 5
0
void omxFitFunctionPrint(omxFitFunction* off, const char* d) {
	mxLog("(FitFunction, type %s)", off->fitType);
	omxPrintMatrix(off->matrix, d);
}