Esempio n. 1
0
static void omxCallRFitFunction(omxFitFunction *oo, int want, FitContext *) {
	if (want & (FF_COMPUTE_PREOPTIMIZE)) return;

	omxRFitFunction* rFitFunction = (omxRFitFunction*)oo->argStruct;

	SEXP theCall, theReturn;
	ScopedProtect p2(theCall, Rf_allocVector(LANGSXP, 3));
	SETCAR(theCall, rFitFunction->fitfun);
	SETCADR(theCall, rFitFunction->model);
	SETCADDR(theCall, rFitFunction->state);

	{
		ScopedProtect p1(theReturn, Rf_eval(theCall, R_GlobalEnv));

	if (LENGTH(theReturn) < 1) {
		// seems impossible, but report it if it happens
		omxRaiseErrorf("FitFunction returned nothing");
	} else if (LENGTH(theReturn) == 1) {
		oo->matrix->data[0] = Rf_asReal(theReturn);
	} else if (LENGTH(theReturn) == 2) {
		oo->matrix->data[0] = Rf_asReal(VECTOR_ELT(theReturn, 0));
		R_Reprotect(rFitFunction->state = VECTOR_ELT(theReturn, 1), rFitFunction->stateIndex);
	} else if (LENGTH(theReturn) > 2) {
		omxRaiseErrorf("FitFunction returned more than 2 arguments");
	}
	}
}
Esempio n. 2
0
double totalLogLikelihood(omxMatrix *fitMat)
{
	if (fitMat->rows != 1) {
		omxFitFunction *ff = fitMat->fitFunction;
		if (strEQ(ff->fitType, "MxFitFunctionML") || strEQ(ff->fitType, "imxFitFunctionFIML")) {
			// NOTE: Floating-point addition is not
			// associative. If we compute this in parallel
			// then we introduce non-determinancy.
			double sum = 0;
			for(int i = 0; i < fitMat->rows; i++) {
				sum += log(omxVectorElement(fitMat, i));
			}
			if (!Global->rowLikelihoodsWarning) {
				Rf_warning("%s does not evaluate to a 1x1 matrix. Fixing model by adding "
					   "mxAlgebra(-2*sum(log(%s)), 'm2ll'), mxFitFunctionAlgebra('m2ll')",
					   fitMat->name(), fitMat->name());
				Global->rowLikelihoodsWarning = true;
			}
			return sum * Global->llScale;
		} else {
			omxRaiseErrorf("%s of type %s returned %d values instead of 1, not sure how to proceed",
				       fitMat->name(), ff->fitType, fitMat->rows);
			return nan("unknown");
		}
	} else {
		return fitMat->data[0];
	}
}
Esempio n. 3
0
	// Does vector=TRUE mean something sensible? Mixture of mixtures?
	void state::init()
	{
		auto *oo = this;
		auto *ms = this;
		if (!oo->expectation) { mxThrow("%s requires an expectation", oo->fitType); }

		oo->units = FIT_UNITS_MINUS2LL;
		oo->canDuplicate = true;

		omxState *currentState = oo->matrix->currentState;
		const char *myex1 = "MxExpectationHiddenMarkov";
		const char *myex2 = "MxExpectationMixture";
		if (!expectation || !(strEQ(expectation->expType, myex1) ||
				      strEQ(expectation->expType, myex2)))
			mxThrow("%s must be paired with %s or %s", oo->name(), myex1, myex2);

		ProtectedSEXP Rverbose(R_do_slot(oo->rObj, Rf_install("verbose")));
		ms->verbose = Rf_asInteger(Rverbose);

		ProtectedSEXP Rcomponents(R_do_slot(oo->rObj, Rf_install("components")));
		int nc = Rf_length(Rcomponents);
		int *cvec = INTEGER(Rcomponents);
		componentUnits = FIT_UNITS_UNINITIALIZED;
		for (int cx=0; cx < nc; ++cx) {
			omxMatrix *fmat = currentState->algebraList[ cvec[cx] ];
			if (fmat->fitFunction) {
				omxCompleteFitFunction(fmat);
				auto ff = fmat->fitFunction;
				if (ff->units != FIT_UNITS_PROBABILITY) {
					omxRaiseErrorf("%s: component %s must be in probability units",
						       oo->name(), ff->name());
					return;
				}
				if (componentUnits == FIT_UNITS_UNINITIALIZED) {
					componentUnits = ff->units;
				} else if (ff->units != componentUnits) {
					omxRaiseErrorf("%s: components with heterogenous units %s and %s in same mixture",
						       oo->name(), fitUnitsToName(ff->units), fitUnitsToName(componentUnits));
				}
			}
			ms->components.push_back(fmat);
		}
		if (componentUnits == FIT_UNITS_UNINITIALIZED) componentUnits = FIT_UNITS_PROBABILITY;

		ms->initial = expectation->getComponent("initial");
		ms->transition = expectation->getComponent("transition");
	}
Esempio n. 4
0
void omxExpectation::loadThresholds()
{
	bool debug = false;
	CheckAST(thresholdsMat, 0);
	numOrdinal = 0;

	//omxPrint(thresholdsMat, "loadThr");

	auto dc = base::getDataColumns();
	thresholds.reserve(dc.size());
	std::vector<bool> found(thresholdsMat->cols, false);
	for(int dx = 0; dx < int(dc.size()); dx++) {
		int index = dc[dx];
		omxThresholdColumn col;
		col.dColumn = index;

		const char *colname = data->columnName(index);
		int tc = thresholdsMat->lookupColumnByName(colname);

		if (tc < 0 || (data->rawCols.size() && !omxDataColumnIsFactor(data, index))) {	// Continuous variable
			if(debug || OMX_DEBUG) {
				mxLog("%s: column[%d] '%s' is continuous (tc=%d isFactor=%d)",
				      name, index, colname, tc, omxDataColumnIsFactor(data, index));
			}
			thresholds.push_back(col);
		} else {
			found[tc] = true;
			col.column = tc;
			if (data->rawCols.size()) {
				col.numThresholds = omxDataGetNumFactorLevels(data, index) - 1;
			} else {
				// See omxData::permute
			}

			thresholds.push_back(col);
			if(debug || OMX_DEBUG) {
				mxLog("%s: column[%d] '%s' is ordinal with %d thresholds in threshold column %d.", 
				      name, index, colname, col.numThresholds, tc);
			}
			numOrdinal++;
		}
	}

	if (numOrdinal != thresholdsMat->cols) {
		std::string buf;
		for (int cx=0; cx < thresholdsMat->cols; ++cx) {
			if (found[cx]) continue;
			buf += string_snprintf(" %d", 1+cx);
		}
		omxRaiseErrorf("%s: cannot find data for threshold columns:%s\n(Do appropriate threshold column names match data column names?)", name, buf.c_str());
	}

	if(debug || OMX_DEBUG) {
		mxLog("%d threshold columns processed.", numOrdinal);
	}
}
Esempio n. 5
0
void FitMultigroup::compute(int want, FitContext *fc)
{
	omxMatrix *fitMatrix = matrix;
	double fit = 0;
	double mac = 0;

	FitMultigroup *mg = (FitMultigroup*) this;

	for (size_t ex=0; ex < mg->fits.size(); ex++) {
		omxMatrix* f1 = mg->fits[ex];
		if (f1->fitFunction) {
			omxFitFunctionCompute(f1->fitFunction, want, fc);
			if (want & FF_COMPUTE_MAXABSCHANGE) {
				mac = std::max(fc->mac, mac);
			}
			if (want & FF_COMPUTE_PREOPTIMIZE) {
				if (units == FIT_UNITS_UNINITIALIZED) {
					units = f1->fitFunction->units;
				} else if (units != f1->fitFunction->units) {
					mxThrow("%s: cannot combine units %s and %s (from %s)",
						matrix->name(), fitUnitsToName(units),
						fitUnitsToName(f1->fitFunction->units), f1->name());
				}
			}
		} else {
			omxRecompute(f1, fc);
		}
		if (want & FF_COMPUTE_FIT) {
			if(f1->rows != 1 || f1->cols != 1) {
				omxRaiseErrorf("%s[%d]: %s of type %s does not evaluate to a 1x1 matrix",
					       fitMatrix->name(), (int)ex, f1->name(), f1->fitFunction->fitType);
			}
			fit += f1->data[0];
			if (mg->verbose >= 1) { mxLog("%s: %s fit=%f", fitMatrix->name(), f1->name(), f1->data[0]); }
		}
	}

	if (fc) fc->mac = mac;

	if (want & FF_COMPUTE_FIT) {
		fitMatrix->data[0] = fit;
		if (mg->verbose >= 1) { mxLog("%s: fit=%f", fitMatrix->name(), fit); }
	}
}
Esempio n. 6
0
void omxCallGREMLFitFunction(omxFitFunction *oo, int want, FitContext *fc){
  if (want & (FF_COMPUTE_PREOPTIMIZE)) return;
  
  //Recompute Expectation:
  omxExpectation* expectation = oo->expectation;
  omxExpectationCompute(expectation, NULL);
    
  omxGREMLFitState *gff = (omxGREMLFitState*)oo->argStruct; //<--Cast generic omxFitFunction to omxGREMLFitState
  
  //Ensure that the pointer in the GREML fitfunction is directed at the right FreeVarGroup
  //(not necessary for most compute plans):
  if(fc && gff->varGroup != fc->varGroup){
    gff->buildParamMap(fc->varGroup);
	}
  
  //Declare local variables used in more than one scope in this function:
  const double Scale = fabs(Global->llScale); //<--absolute value of loglikelihood scale
  const double NATLOG_2PI = 1.837877066409345483560659472811;	//<--log(2*pi)
  int i;
  Eigen::Map< Eigen::MatrixXd > Eigy(omxMatrixDataColumnMajor(gff->y), gff->y->cols, 1);
  Eigen::Map< Eigen::MatrixXd > Vinv(omxMatrixDataColumnMajor(gff->invcov), gff->invcov->rows, gff->invcov->cols);
  EigenMatrixAdaptor EigX(gff->X);
  Eigen::MatrixXd P, Py;
  P.setZero(gff->invcov->rows, gff->invcov->cols);
  double logdetV=0, logdetquadX=0;
  
  if(want & (FF_COMPUTE_FIT | FF_COMPUTE_GRADIENT | FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
    if(gff->usingGREMLExpectation){
      omxGREMLExpectation* oge = (omxGREMLExpectation*)(expectation->argStruct);
      
      //Check that factorizations of V and the quadratic form in X succeeded:
      if(oge->cholV_fail_om->data[0]){
        oo->matrix->data[0] = NA_REAL;
        if (fc) fc->recordIterationError("expected covariance matrix is non-positive-definite");
        return;
      }
      if(oge->cholquadX_fail){
        oo->matrix->data[0] = NA_REAL;
        if (fc) fc->recordIterationError("Cholesky factorization failed; possibly, the matrix of covariates is rank-deficient");
        return;
      }
      
      //Log determinant of V:
      logdetV = oge->logdetV_om->data[0];
      
      //Log determinant of quadX:
      for(i=0; i < gff->X->cols; i++){
        logdetquadX += log(oge->cholquadX_vectorD[i]);
      }
      logdetquadX *= 2;
      gff->REMLcorrection = Scale*0.5*logdetquadX;
      
      //Finish computing fit (negative loglikelihood):
      P.triangularView<Eigen::Lower>() = Vinv.selfadjointView<Eigen::Lower>() * 
        (Eigen::MatrixXd::Identity(Vinv.rows(), Vinv.cols()) - 
          (EigX * oge->quadXinv.selfadjointView<Eigen::Lower>() * oge->XtVinv)); //Vinv * (I-Hatmat)
      Py = P.selfadjointView<Eigen::Lower>() * Eigy;
      oo->matrix->data[0] = gff->REMLcorrection + Scale*0.5*( (((double)gff->y->cols) * NATLOG_2PI) + logdetV + ( Eigy.transpose() * Py )(0,0));
      gff->nll = oo->matrix->data[0]; 
    }
    else{ //If not using GREML expectation, deal with means and cov in a general way to compute fit...
      //Declare locals:
      EigenMatrixAdaptor yhat(gff->means);
      EigenMatrixAdaptor EigV(gff->cov);
      double logdetV=0, logdetquadX=0;
      Eigen::MatrixXd Vinv, quadX;
      Eigen::LLT< Eigen::MatrixXd > cholV(gff->cov->rows);
      Eigen::LLT< Eigen::MatrixXd > cholquadX(gff->X->cols);
      Eigen::VectorXd cholV_vectorD, cholquadX_vectorD;
      
      //Cholesky factorization of V:
      cholV.compute(EigV);
      if(cholV.info() != Eigen::Success){
        omxRaiseErrorf("expected covariance matrix is non-positive-definite");
        oo->matrix->data[0] = NA_REAL;
        return;
      }
      //Log determinant of V:
      cholV_vectorD = (( Eigen::MatrixXd )(cholV.matrixL())).diagonal();
      for(i=0; i < gff->X->rows; i++){
        logdetV += log(cholV_vectorD[i]);
      }
      logdetV *= 2;
      
      Vinv = cholV.solve(Eigen::MatrixXd::Identity( EigV.rows(), EigV.cols() )); //<-- V inverse
      
      quadX = EigX.transpose() * Vinv * EigX; //<--Quadratic form in X
      
      cholquadX.compute(quadX); //<--Cholesky factorization of quadX
      if(cholquadX.info() != Eigen::Success){
        omxRaiseErrorf("Cholesky factorization failed; possibly, the matrix of covariates is rank-deficient");
        oo->matrix->data[0] = NA_REAL;
        return;
      }
      cholquadX_vectorD = (( Eigen::MatrixXd )(cholquadX.matrixL())).diagonal();
      for(i=0; i < gff->X->cols; i++){
        logdetquadX += log(cholquadX_vectorD[i]);
      }
      logdetquadX *= 2;
      gff->REMLcorrection = Scale*0.5*logdetquadX;
      
      //Finish computing fit:
      oo->matrix->data[0] = gff->REMLcorrection + Scale*0.5*( ((double)gff->y->rows * NATLOG_2PI) + logdetV + 
        ( Eigy.transpose() * Vinv * (Eigy - yhat) )(0,0));
      gff->nll = oo->matrix->data[0]; 
      return;
    }
  }
  
  if(want & (FF_COMPUTE_GRADIENT | FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
    //This part requires GREML expectation:
    omxGREMLExpectation* oge = (omxGREMLExpectation*)(expectation->argStruct);
    
    //Declare local variables for this scope:
    int numChildren = fc->childList.size();
    int __attribute__((unused)) parallelism = (numChildren == 0) ? 1 : numChildren;
    
    fc->grad.resize(gff->dVlength); //<--Resize gradient in FitContext
    
    //Set up new HessianBlock:
    HessianBlock *hb = new HessianBlock;
    if(want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
      hb->vars.resize(gff->dVlength);
      hb->mat.resize(gff->dVlength, gff->dVlength);
    }
    
    //Begin looping thru free parameters:
#pragma omp parallel for num_threads(parallelism) 
    for(i=0; i < gff->dVlength; i++){
    	//Declare locals within parallelized region:
    	int j=0, t1=0, t2=0;
    	Eigen::MatrixXd PdV_dtheta1;
    	Eigen::MatrixXd dV_dtheta1(Eigy.rows(), Eigy.rows()); //<--Derivative of V w/r/t parameter i.
    	Eigen::MatrixXd dV_dtheta2(Eigy.rows(), Eigy.rows()); //<--Derivative of V w/r/t parameter j.
      t1 = gff->gradMap[i]; //<--Parameter number for parameter i.
      if(t1 < 0){continue;}
      if(want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){hb->vars[i] = t1;}
      if( oge->numcases2drop ){
        dropCasesAndEigenize(gff->dV[i], dV_dtheta1, oge->numcases2drop, oge->dropcase, 1);
      }
      else{dV_dtheta1 = Eigen::Map< Eigen::MatrixXd >(omxMatrixDataColumnMajor(gff->dV[i]), gff->dV[i]->rows, gff->dV[i]->cols);}
      //PdV_dtheta1 = P.selfadjointView<Eigen::Lower>() * dV_dtheta1.selfadjointView<Eigen::Lower>();
      PdV_dtheta1 = P.selfadjointView<Eigen::Lower>();
      PdV_dtheta1 = PdV_dtheta1 * dV_dtheta1.selfadjointView<Eigen::Lower>();
      for(j=i; j < gff->dVlength; j++){
        if(j==i){
          gff->gradient(t1) = Scale*0.5*(PdV_dtheta1.trace() - (Eigy.transpose() * PdV_dtheta1 * Py)(0,0));
          fc->grad(t1) += gff->gradient(t1);
          if(want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
            gff->avgInfo(t1,t1) = Scale*0.5*(Eigy.transpose() * PdV_dtheta1 * PdV_dtheta1 * Py)(0,0);
          }
        }
        else{if(want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
          t2 = gff->gradMap[j]; //<--Parameter number for parameter j.
          if(t2 < 0){continue;}
          if( oge->numcases2drop ){
            dropCasesAndEigenize(gff->dV[j], dV_dtheta2, oge->numcases2drop, oge->dropcase, 1);
          }
          else{dV_dtheta2 = Eigen::Map< Eigen::MatrixXd >(omxMatrixDataColumnMajor(gff->dV[j]), gff->dV[j]->rows, gff->dV[j]->cols);}
          gff->avgInfo(t1,t2) = Scale*0.5*(Eigy.transpose() * PdV_dtheta1 * P.selfadjointView<Eigen::Lower>() * dV_dtheta2.selfadjointView<Eigen::Lower>() * Py)(0,0);
          gff->avgInfo(t2,t1) = gff->avgInfo(t1,t2);
    }}}}
    //Assign upper triangle elements of avgInfo to the HessianBlock:
    if(want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)){
      for (size_t d1=0, h1=0; h1 < gff->dV.size(); ++h1) {
		    for (size_t d2=0, h2=0; h2 <= h1; ++h2) {
				  	hb->mat(d2,d1) = gff->avgInfo(h2,h1);
				    ++d2;
        }
			  ++d1;	
		  }
		  fc->queue(hb);
  }}
Esempio n. 7
0
static void gradCov(omxFitFunction *oo, FitContext *fc)
{
	const double Scale = Global->llScale;
	omxExpectation *expectation = oo->expectation;
	BA81FitState *state = (BA81FitState*) oo->argStruct;
	BA81Expect *estate = (BA81Expect*) expectation->argStruct;
	if (estate->verbose >= 1) mxLog("%s: cross product approximation", oo->name());

	estate->grp.ba81OutcomeProb(estate->itemParam->data, FALSE);

	const int numThreads = Global->numThreads;
	const int numUnique = estate->getNumUnique();
	ba81NormalQuad &quad = estate->getQuad();
	const int numSpecific = quad.numSpecific;
	const int maxDims = quad.maxDims;
	const int pDims = numSpecific? maxDims-1 : maxDims;
	const int maxAbilities = quad.maxAbilities;
	Eigen::MatrixXd icovMat(pDims, pDims);
	if (maxAbilities) {
		Eigen::VectorXd mean;
		Eigen::MatrixXd srcMat;
		estate->getLatentDistribution(fc, mean, srcMat);
		icovMat = srcMat.topLeftCorner(pDims, pDims);
		Matrix tmp(icovMat.data(), pDims, pDims);
		int info = InvertSymmetricPosDef(tmp, 'U');
		if (info) {
			omxRaiseErrorf("%s: latent covariance matrix is not positive definite", oo->name());
			return;
		}
		icovMat.triangularView<Eigen::Lower>() = icovMat.transpose().triangularView<Eigen::Lower>();
	}
	std::vector<int> &rowMap = estate->grp.rowMap;
	double *rowWeight = estate->grp.rowWeight;
	std::vector<bool> &rowSkip = estate->grp.rowSkip;
	const int totalQuadPoints = quad.totalQuadPoints;
	omxMatrix *itemParam = estate->itemParam;
	omxBuffer<double> patternLik(numUnique);

	const int priDerivCoef = pDims + triangleLoc1(pDims);
	const int numLatents = maxAbilities + triangleLoc1(maxAbilities);
	const int thrDerivSize = itemParam->cols * state->itemDerivPadSize;
	const int totalOutcomes = estate->totalOutcomes();
	const int numItems = state->freeItemParams? estate->numItems() : 0;
	const size_t numParam = fc->varGroup->vars.size();
	std::vector<double> thrGrad(numThreads * numParam);
	std::vector<double> thrMeat(numThreads * numParam * numParam);
	const double *wherePrep = quad.wherePrep.data();

	if (numSpecific == 0) {
		omxBuffer<double> thrLxk(totalQuadPoints * numThreads);
		omxBuffer<double> derivCoef(totalQuadPoints * priDerivCoef);

		if (state->freeLatents) {
#pragma omp parallel for num_threads(numThreads)
			for (int qx=0; qx < totalQuadPoints; qx++) {
				const double *where = wherePrep + qx * maxDims;
				calcDerivCoef(fc, state, estate, icovMat.data(), where,
					      derivCoef.data() + qx * priDerivCoef);
			}
		}

#pragma omp parallel for num_threads(numThreads)
		for (int px=0; px < numUnique; px++) {
			if (rowSkip[px]) continue;
			int thrId = omx_absolute_thread_num();
			double *lxk = thrLxk.data() + thrId * totalQuadPoints;
			omxBuffer<double> expected(totalOutcomes); // can use maxOutcomes instead TODO
			std::vector<double> deriv0(thrDerivSize);
			std::vector<double> latentGrad(numLatents);
			std::vector<double> patGrad(numParam);
			double *grad = thrGrad.data() + thrId * numParam;
			double *meat = thrMeat.data() + thrId * numParam * numParam;
			estate->grp.ba81LikelihoodSlow2(px, lxk);

			// If patternLik is already valid, maybe could avoid this loop TODO
			double patternLik1 = 0;
			for (int qx=0; qx < totalQuadPoints; qx++) {
				patternLik1 += lxk[qx];
			}
			patternLik[px] = patternLik1;

			// if (!validPatternLik(state, patternLik1))  complain, TODO

			for (int qx=0; qx < totalQuadPoints; qx++) {
				double tmp = lxk[qx];
				mapLatentDeriv(state, estate, tmp, derivCoef.data() + qx * priDerivCoef,
					       latentGrad.data());

				for (int ix=0; ix < numItems; ++ix) {
					int pick = estate->grp.dataColumns[ix][rowMap[px]];
					if (pick == NA_INTEGER) continue;
					OMXZERO(expected.data(), estate->itemOutcomes(ix));
					expected[pick-1] = tmp;
					const double *spec = estate->itemSpec(ix);
					double *iparam = omxMatrixColumn(itemParam, ix);
					const int id = spec[RPF_ISpecID];
					double *myDeriv = deriv0.data() + ix * state->itemDerivPadSize;
					(*Glibrpf_model[id].dLL1)(spec, iparam, wherePrep + qx * maxDims,
							      expected.data(), myDeriv);
				}
			}

			gradCov_finish_1pat(1 / patternLik1, rowWeight[px], numItems, numLatents, numParam,
					state, estate, itemParam, deriv0, latentGrad, Scale, patGrad, grad, meat);
		}
	} else {
		const int totalPrimaryPoints = quad.totalPrimaryPoints;
		const int specificPoints = quad.quadGridSize;
		omxBuffer<double> thrLxk(totalQuadPoints * numSpecific * numThreads);
		omxBuffer<double> thrEi(totalPrimaryPoints * numThreads);
		omxBuffer<double> thrEis(totalPrimaryPoints * numSpecific * numThreads);
		const int derivPerPoint = priDerivCoef + 2 * numSpecific;
		omxBuffer<double> derivCoef(totalQuadPoints * derivPerPoint);

		if (state->freeLatents) {
#pragma omp parallel for num_threads(numThreads)
			for (int qx=0; qx < totalQuadPoints; qx++) {
				const double *where = wherePrep + qx * maxDims;
				calcDerivCoef(fc, state, estate, icovMat.data(), where,
					      derivCoef.data() + qx * derivPerPoint);
				for (int Sgroup=0; Sgroup < numSpecific; ++Sgroup) {
					calcDerivCoef1(fc, state, estate, where, Sgroup,
						       derivCoef.data() + qx * derivPerPoint + priDerivCoef + 2 * Sgroup);
				}
			}
		}

#pragma omp parallel for num_threads(numThreads)
		for (int px=0; px < numUnique; px++) {
			if (rowSkip[px]) continue;
			int thrId = omx_absolute_thread_num();
			double *lxk = thrLxk.data() + totalQuadPoints * numSpecific * thrId;
			double *Ei = thrEi.data() + totalPrimaryPoints * thrId;
			double *Eis = thrEis.data() + totalPrimaryPoints * numSpecific * thrId;
			omxBuffer<double> expected(totalOutcomes); // can use maxOutcomes instead TODO
			std::vector<double> deriv0(thrDerivSize);
			std::vector<double> latentGrad(numLatents);
			std::vector<double> patGrad(numParam);
			double *grad = thrGrad.data() + thrId * numParam;
			double *meat = thrMeat.data() + thrId * numParam * numParam;
			estate->grp.cai2010EiEis(px, lxk, Eis, Ei);

			for (int qx=0, qloc = 0; qx < totalPrimaryPoints; qx++) {
				for (int sgroup=0; sgroup < numSpecific; ++sgroup) {
					Eis[qloc] = Ei[qx] / Eis[qloc];
					++qloc;
				}
			}

			for (int qloc=0, eisloc=0, qx=0; eisloc < totalPrimaryPoints * numSpecific; eisloc += numSpecific) {
				for (int sx=0; sx < specificPoints; sx++) {
					mapLatentDeriv(state, estate, Eis[eisloc] * lxk[qloc],
						       derivCoef.data() + qx * derivPerPoint,
						       latentGrad.data());

					for (int Sgroup=0; Sgroup < numSpecific; Sgroup++) {
						double lxk1 = lxk[qloc];
						double Eis1 = Eis[eisloc + Sgroup];
						double tmp = Eis1 * lxk1;
						mapLatentDerivS(state, estate, Sgroup, tmp,
								derivCoef.data() + qx * derivPerPoint + priDerivCoef + 2 * Sgroup,
								latentGrad.data());

						for (int ix=0; ix < numItems; ++ix) {
							if (estate->grp.Sgroup[ix] != Sgroup) continue;
							int pick = estate->grp.dataColumns[ix][rowMap[px]];
							if (pick == NA_INTEGER) continue;
							OMXZERO(expected.data(), estate->itemOutcomes(ix));
							expected[pick-1] = tmp;
							const double *spec = estate->itemSpec(ix);
							double *iparam = omxMatrixColumn(itemParam, ix);
							const int id = spec[RPF_ISpecID];
							const int dims = spec[RPF_ISpecDims];
							double *myDeriv = deriv0.data() + ix * state->itemDerivPadSize;
							const double *where = wherePrep + qx * maxDims;
							Eigen::VectorXd ptheta(dims);
							for (int dx=0; dx < dims; dx++) {
								ptheta[dx] = where[std::min(dx, maxDims-1)];
							}
							(*Glibrpf_model[id].dLL1)(spec, iparam, ptheta.data(),
									      expected.data(), myDeriv);
						}
						++qloc;
					}
					++qx;
				}
			}

			// If patternLik is already valid, maybe could avoid this loop TODO
			double patternLik1 = 0;
			for (int qx=0; qx < totalPrimaryPoints; ++qx) {
				patternLik1 += Ei[qx];
			}
			patternLik[px] = patternLik1;

			gradCov_finish_1pat(1 / patternLik1, rowWeight[px], numItems, numLatents, numParam,
					state, estate, itemParam, deriv0, latentGrad, Scale, patGrad, grad, meat);
		}
	}

	for (int tx=1; tx < numThreads; ++tx) {
		double *th = thrGrad.data() + tx * numParam;
		for (size_t en=0; en < numParam; ++en) {
			thrGrad[en] += th[en];
		}
	}
	for (int tx=1; tx < numThreads; ++tx) {
		double *th = thrMeat.data() + tx * numParam * numParam;
		for (size_t en=0; en < numParam * numParam; ++en) {
			thrMeat[en] += th[en];
		}
	}
	for (size_t d1=0; d1 < numParam; ++d1) {
		fc->grad(d1) += thrGrad[d1];
	}
	if (fc->infoB) {
		for (size_t d1=0; d1 < numParam; ++d1) {
			for (size_t d2=0; d2 < numParam; ++d2) {
				int cell = d1 * numParam + d2;
				fc->infoB[cell] += thrMeat[cell];
			}
		}
	}
}
Esempio n. 8
0
static double
ba81ComputeEMFit(omxFitFunction* oo, int want, FitContext *fc)
{
	const double Scale = Global->llScale;
	BA81FitState *state = (BA81FitState*) oo->argStruct;
	BA81Expect *estate = (BA81Expect*) oo->expectation->argStruct;
	omxMatrix *itemParam = estate->itemParam;
	std::vector<const double*> &itemSpec = estate->grp.spec;
        std::vector<int> &cumItemOutcomes = estate->grp.cumItemOutcomes;
	ba81NormalQuad &quad = estate->getQuad();
	const int maxDims = quad.maxDims;
	const size_t numItems = itemSpec.size();
	const int do_fit = want & FF_COMPUTE_FIT;
	const int do_deriv = want & (FF_COMPUTE_GRADIENT | FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN);

	if (do_deriv && !state->freeItemParams) {
		omxRaiseErrorf("%s: no free parameters", oo->name());
		return NA_REAL;
	}

	if (state->returnRowLikelihoods) {
		omxRaiseErrorf("%s: vector=TRUE not implemented", oo->name());
		return NA_REAL;
	}

	if (estate->verbose >= 3) mxLog("%s: complete data fit(want fit=%d deriv=%d)", oo->name(), do_fit, do_deriv);

	if (do_fit) estate->grp.ba81OutcomeProb(itemParam->data, TRUE);

	const int thrDerivSize = itemParam->cols * state->itemDerivPadSize;
	std::vector<double> thrDeriv(thrDerivSize * Global->numThreads);
	double *wherePrep = quad.wherePrep.data();

	double ll = 0;
#pragma omp parallel for num_threads(Global->numThreads) reduction(+:ll)
	for (size_t ix=0; ix < numItems; ix++) {
		const int thrId = omx_absolute_thread_num();
		const double *spec = itemSpec[ix];
		const int id = spec[RPF_ISpecID];
		const int dims = spec[RPF_ISpecDims];
		Eigen::VectorXd ptheta(dims);
		const rpf_dLL1_t dLL1 = Glibrpf_model[id].dLL1;
		const int iOutcomes = estate->grp.itemOutcomes[ix];
		const int outcomeBase = cumItemOutcomes[ix] * quad.totalQuadPoints;
		const double *weight = estate->expected + outcomeBase;
                const double *oProb = estate->grp.outcomeProb + outcomeBase;
		const double *iparam = omxMatrixColumn(itemParam, ix);
		double *myDeriv = thrDeriv.data() + thrDerivSize * thrId + ix * state->itemDerivPadSize;

		for (int qx=0; qx < quad.totalQuadPoints; qx++) {
			if (do_fit) {
				for (int ox=0; ox < iOutcomes; ox++) {
					ll += weight[ox] * oProb[ox];
				}
			}
			if (do_deriv) {
				double *where = wherePrep + qx * maxDims;
				for (int dx=0; dx < dims; dx++) {
					ptheta[dx] = where[std::min(dx, maxDims-1)];
				}

				(*dLL1)(spec, iparam, ptheta.data(), weight, myDeriv);
			}
			weight += iOutcomes;
			oProb += iOutcomes;
		}
	}

	size_t excluded = 0;

	if (do_deriv) {
		double *deriv0 = thrDeriv.data();

		int perThread = itemParam->cols * state->itemDerivPadSize;
		for (int th=1; th < Global->numThreads; th++) {
			double *thrD = thrDeriv.data() + th * perThread;
			for (int ox=0; ox < perThread; ox++) deriv0[ox] += thrD[ox];
		}

		int numFreeParams = int(state->numFreeParam);
		int ox=-1;
		for (size_t ix=0; ix < numItems; ix++) {
			const double *spec = itemSpec[ix];
			int id = spec[RPF_ISpecID];
			double *iparam = omxMatrixColumn(itemParam, ix);
			double *pad = deriv0 + ix * state->itemDerivPadSize;
			(*Glibrpf_model[id].dLL2)(spec, iparam, pad);

			HessianBlock *hb = state->hBlocks[ix].clone();
			hb->mat.triangularView<Eigen::Upper>().setZero();

			for (int dx=0; dx < state->itemDerivPadSize; ++dx) {
				int to = state->paramMap[++ox];
				if (to == -1) continue;

				// Need to check because this can happen if
				// lbounds/ubounds are not set appropriately.
				if (0 && !std::isfinite(deriv0[ox])) {
					int item = ox / itemParam->rows;
					mxLog("item parameters:\n");
					const double *spec = itemSpec[item];
					int id = spec[RPF_ISpecID];
					int numParam = (*Glibrpf_model[id].numParam)(spec);
					double *iparam = omxMatrixColumn(itemParam, item);
					pda(iparam, numParam, 1);
					// Perhaps bounds can be pulled in from librpf? TODO
					Rf_error("Deriv %d for item %d is %f; are you missing a lbound/ubound?",
						 ox, item, deriv0[ox]);
				}

				if (to < numFreeParams) {
					if (want & FF_COMPUTE_GRADIENT) {
						fc->grad(to) -= Scale * deriv0[ox];
					}
				} else {
					if (want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)) {
						int Hto = state->hbMap[ox];
						if (Hto >= 0) hb->mat.data()[Hto] -= Scale * deriv0[ox];
					}
				}
			}
			fc->queue(hb);
		}
	}

	if (excluded && estate->verbose >= 1) {
		mxLog("%s: Hessian not positive definite for %d/%d items",
		      oo->name(), (int) excluded, (int) numItems);
	}
	if (excluded == numItems) {
		omxRaiseErrorf("Hessian not positive definite for %d/%d items",
			       (int) excluded, (int) numItems);
	}

	return Scale * ll;
}
Esempio n. 9
0
static void
ba81ComputeFit(omxFitFunction* oo, int want, FitContext *fc)
{
	BA81FitState *state = (BA81FitState*) oo->argStruct;
	BA81Expect *estate = (BA81Expect*) oo->expectation->argStruct;
	if (fc) state->numFreeParam = fc->varGroup->vars.size();

	if (want & FF_COMPUTE_INITIAL_FIT) return;

	if (estate->type == EXPECTATION_AUGMENTED) {
		buildItemParamMap(oo, fc);

		if (want & FF_COMPUTE_PARAMFLAVOR) {
			for (size_t px=0; px < state->numFreeParam; ++px) {
				if (state->paramFlavor[px] == NULL) continue;
				fc->flavor[px] = state->paramFlavor[px];
			}
			return;
		}

		if (want & FF_COMPUTE_PREOPTIMIZE) {
			omxExpectationCompute(fc, oo->expectation, NULL);
			return;
		}

		if (want & FF_COMPUTE_INFO) {
			buildLatentParamMap(oo, fc);
			if (!state->freeItemParams) {
				omxRaiseErrorf("%s: no free parameters", oo->name());
				return;
			}
			ba81SetupQuadrature(oo->expectation);

			if (fc->infoMethod == INFO_METHOD_HESSIAN) {
				ba81ComputeEMFit(oo, FF_COMPUTE_HESSIAN, fc);
			} else {
				omxRaiseErrorf("Information matrix approximation method %d is not available",
					       fc->infoMethod);
				return;
			}
			return;
		}

		double got = ba81ComputeEMFit(oo, want, fc);
		oo->matrix->data[0] = got;
		return;
	} else if (estate->type == EXPECTATION_OBSERVED) {

		if (want == FF_COMPUTE_STARTING) {
			buildLatentParamMap(oo, fc);
			if (state->freeLatents) setLatentStartingValues(oo, fc);
			return;
		}

		if (want & (FF_COMPUTE_INFO | FF_COMPUTE_GRADIENT)) {
			buildLatentParamMap(oo, fc); // only to check state->freeLatents
			buildItemParamMap(oo, fc);
			if (!state->freeItemParams && !state->freeLatents) {
				omxRaiseErrorf("%s: no free parameters", oo->name());
				return;
			}
			ba81SetupQuadrature(oo->expectation);

			if (want & FF_COMPUTE_GRADIENT ||
			    (want & FF_COMPUTE_INFO && fc->infoMethod == INFO_METHOD_MEAT)) {
				gradCov(oo, fc);
			} else {
				if (state->freeLatents) {
					omxRaiseErrorf("Information matrix approximation method %d is not available",
						       fc->infoMethod);
					return;
				}
				if (!state->freeItemParams) {
					omxRaiseErrorf("%s: no free parameters", oo->name());
					return;
				}
				sandwich(oo, fc);
			}
		}
		if (want & (FF_COMPUTE_HESSIAN | FF_COMPUTE_IHESSIAN)) {
			omxRaiseErrorf("%s: Hessian is not available for observed data", oo->name());
		}

		if (want & FF_COMPUTE_MAXABSCHANGE) {
			double mac = std::max(omxMaxAbsDiff(state->itemParam, estate->itemParam),
					      omxMaxAbsDiff(state->latentMean, estate->_latentMeanOut));
			fc->mac = std::max(mac, omxMaxAbsDiff(state->latentCov, estate->_latentCovOut));
			state->copyEstimates(estate);
		}

		if (want & FF_COMPUTE_FIT) {
			omxExpectationCompute(fc, oo->expectation, NULL);

			Eigen::ArrayXd &patternLik = estate->grp.patternLik;
			const int numUnique = estate->getNumUnique();
			if (state->returnRowLikelihoods) {
				const double OneOverLargest = estate->grp.quad.getReciprocalOfOne();
				omxData *data = estate->data;
				for (int rx=0; rx < numUnique; rx++) {
					int dups = omxDataNumIdenticalRows(data, estate->grp.rowMap[rx]);
					for (int dup=0; dup < dups; dup++) {
						int dest = omxDataIndex(data, estate->grp.rowMap[rx]+dup);
						oo->matrix->data[dest] = patternLik[rx] * OneOverLargest;
					}
				}
			} else {
				double *rowWeight = estate->grp.rowWeight;
				const double LogLargest = estate->LogLargestDouble;
				double got = 0;
#pragma omp parallel for num_threads(Global->numThreads) reduction(+:got)
				for (int ux=0; ux < numUnique; ux++) {
					if (patternLik[ux] == 0) continue;
					got += rowWeight[ux] * (log(patternLik[ux]) - LogLargest);
				}
				double fit = nan("infeasible");
				if (estate->grp.excludedPatterns < numUnique) {
					fit = Global->llScale * got;
					// add in some badness for excluded patterns
					fit += fit * estate->grp.excludedPatterns;
				}
				if (estate->verbose >= 1) mxLog("%s: observed fit %.4f (%d/%d excluded)",
								oo->name(), fit, estate->grp.excludedPatterns, numUnique);
				oo->matrix->data[0] = fit;
			}
		}
	} else {
		Rf_error("%s: Predict nothing or scores before computing %d", oo->name(), want);
	}
}
Esempio n. 10
0
	void state::compute(int want, FitContext *fc)
	{
		state *st = (state*) this;
		auto *oo = this;

		for (auto c1 : components) {
			if (c1->fitFunction) {
				omxFitFunctionCompute(c1->fitFunction, want, fc);
			} else {
				omxRecompute(c1, fc);
			}
		}
		if (!(want & FF_COMPUTE_FIT)) return;

		int nrow = components[0]->rows;
		for (auto c1 : components) {
			if (c1->rows != nrow) {
				mxThrow("%s: component '%s' has %d rows but component '%s' has %d rows",
					 oo->name(), components[0]->name(), nrow, c1->name(), c1->rows);
			}
		}

		Eigen::VectorXd expect;
		Eigen::VectorXd rowResult;
		int numC = components.size();
		Eigen::VectorXd tp(numC);
		double lp=0;
		for (int rx=0; rx < nrow; ++rx) {
			if (expectation->loadDefVars(rx) || rx == 0) {
				omxExpectationCompute(fc, expectation, NULL);
				if (!st->transition || rx == 0) {
					EigenVectorAdaptor Einitial(st->initial);
					expect = Einitial;
					if (expect.rows() != numC || expect.cols() != 1) {
						omxRaiseErrorf("%s: initial prob matrix must be %dx%d not %dx%d",
							       name(), numC, 1, expect.rows(), expect.cols());
						return;
					}
				}
				if (st->transition && (st->transition->rows != numC || st->transition->cols != numC)) {
					omxRaiseErrorf("%s: transition prob matrix must be %dx%d not %dx%d",
						       name(), numC, numC, st->transition->rows, st->transition->cols);
					return;
				}
			}
			for (int cx=0; cx < int(components.size()); ++cx) {
				EigenVectorAdaptor Ecomp(components[cx]);
				tp[cx] = Ecomp[rx];
			}
			if (st->verbose >= 4) {
				mxPrintMat("tp", tp);
			}
			if (st->transition) {
				EigenMatrixAdaptor Etransition(st->transition);
				expect = (Etransition * expect).eval();
			}
			rowResult = tp.array() * expect.array();
			double rowp = rowResult.sum();
			rowResult /= rowp;
			lp += log(rowp);
			if (st->transition) expect = rowResult;
		}
		oo->matrix->data[0] = Global->llScale * lp;
		if (st->verbose >= 2) mxLog("%s: fit=%f", oo->name(), lp);
	}
Esempio n. 11
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. 12
0
void omxInitExpectationBA81(omxExpectation* oo) {
	omxState* currentState = oo->currentState;	
	SEXP rObj = oo->rObj;
	SEXP tmp;
	
	if(OMX_DEBUG) {
		mxLog("Initializing %s.", oo->name);
	}
	if (!Glibrpf_model) {
#if USE_EXTERNAL_LIBRPF
		get_librpf_t get_librpf = (get_librpf_t) R_GetCCallable("rpf", "get_librpf_model_GPL");
		(*get_librpf)(LIBIFA_RPF_API_VERSION, &Glibrpf_numModels, &Glibrpf_model);
#else
		// if linking against included source code
		Glibrpf_numModels = librpf_numModels;
		Glibrpf_model = librpf_model;
#endif
	}
	
	BA81Expect *state = new BA81Expect;

	// These two constants should be as identical as possible
	state->name = oo->name;
	if (0) {
		state->LogLargestDouble = 0.0;
		state->LargestDouble = 1.0;
	} else {
		state->LogLargestDouble = log(std::numeric_limits<double>::max()) - 1;
		state->LargestDouble = exp(state->LogLargestDouble);
		ba81NormalQuad &quad = state->getQuad();
		quad.setOne(state->LargestDouble);
	}

	state->expectedUsed = false;

	state->estLatentMean = NULL;
	state->estLatentCov = NULL;
	state->type = EXPECTATION_OBSERVED;
	state->itemParam = NULL;
	state->EitemParam = NULL;
	state->itemParamVersion = 0;
	state->latentParamVersion = 0;
	oo->argStruct = (void*) state;

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("data")));
	state->data = omxDataLookupFromState(tmp, currentState);
	}

	if (strcmp(omxDataType(state->data), "raw") != 0) {
		omxRaiseErrorf("%s unable to handle data type %s", oo->name, omxDataType(state->data));
		return;
	}

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("verbose")));
	state->verbose = Rf_asInteger(tmp);
	}

	int targetQpoints;
	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("qpoints")));
		targetQpoints = Rf_asInteger(tmp);
	}

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("qwidth")));
	state->grp.setGridFineness(Rf_asReal(tmp), targetQpoints);
	}

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("ItemSpec")));
	state->grp.importSpec(tmp);
	if (state->verbose >= 2) mxLog("%s: found %d item specs", oo->name, state->numItems());
	}

	state->_latentMeanOut = omxNewMatrixFromSlot(rObj, currentState, "mean");
	state->_latentCovOut  = omxNewMatrixFromSlot(rObj, currentState, "cov");

	state->itemParam = omxNewMatrixFromSlot(rObj, currentState, "item");
	state->grp.param = state->itemParam->data; // algebra not allowed yet TODO

	const int numItems = state->itemParam->cols;
	if (state->numItems() != numItems) {
		omxRaiseErrorf("ItemSpec length %d must match the number of item columns (%d)",
			       state->numItems(), numItems);
		return;
	}
	if (state->itemParam->rows != state->grp.impliedParamRows) {
		omxRaiseErrorf("item matrix must have %d rows", state->grp.impliedParamRows);
		return;
	}
	state->grp.paramRows = state->itemParam->rows;

	// for algebra item param, will need to defer until later?
	state->grp.learnMaxAbilities();

	int maxAbilities = state->grp.itemDims;
	state->grp.setFactorNames(state->itemParam->rownames);

	{
		ProtectedSEXP tmp2(R_do_slot(rObj, Rf_install(".detectIndependence")));
		state->grp.detectIndependence = Rf_asLogical(tmp2);
	}

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("EstepItem")));
	if (!Rf_isNull(tmp)) {
		int rows, cols;
		getMatrixDims(tmp, &rows, &cols);
		if (rows != state->itemParam->rows || cols != state->itemParam->cols) {
			Rf_error("EstepItem must have the same dimensions as the item MxMatrix");
		}
		state->EitemParam = REAL(tmp);
	}
	}

	oo->computeFun = ba81compute;
	oo->setVarGroup = ignoreSetVarGroup;
	oo->destructFun = ba81Destroy;
	oo->populateAttrFun = ba81PopulateAttributes;
	oo->componentFun = getComponent;
	oo->canDuplicate = false;
	
	// TODO: Exactly identical rows do not contribute any information.
	// The sorting algorithm ought to remove them so we get better cache behavior.
	// The following summary stats would be cheaper to calculate too.

	omxData *data = state->data;
	if (data->hasDefinitionVariables()) Rf_error("%s: not implemented yet", oo->name);

	std::vector<int> &rowMap = state->grp.rowMap;

	int weightCol;
	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("weightColumn")));
		weightCol = INTEGER(tmp)[0];
	}

	if (weightCol == NA_INTEGER) {
		// Should rowMap be part of omxData? This is essentially a
		// generic compression step that shouldn't be specific to IFA models.
		state->grp.rowWeight = (double*) R_alloc(data->rows, sizeof(double));
		rowMap.resize(data->rows);
		int numUnique = 0;
		for (int rx=0; rx < data->rows; ) {
			int rw = 1;
			state->grp.rowWeight[numUnique] = rw;
			rowMap[numUnique] = rx;
			rx += rw;
			++numUnique;
		}
		rowMap.resize(numUnique);
		state->weightSum = state->data->rows;
	}
	else {
		if (omxDataColumnIsFactor(data, weightCol)) {
			omxRaiseErrorf("%s: weightColumn %d is a factor", oo->name, 1 + weightCol);
			return;
		}
		state->grp.rowWeight = omxDoubleDataColumn(data, weightCol);
		state->weightSum = 0;
		for (int rx=0; rx < data->rows; ++rx) { state->weightSum += state->grp.rowWeight[rx]; }
		rowMap.resize(data->rows);
		for (size_t rx=0; rx < rowMap.size(); ++rx) {
			rowMap[rx] = rx;
		}
	}
	// complain about non-integral rowWeights (EAP can't work) TODO

	auto colMap = oo->getDataColumns();

	for (int cx = 0; cx < numItems; cx++) {
		int *col = omxIntDataColumnUnsafe(data, colMap[cx]);
		state->grp.dataColumns.push_back(col);
	}

	// sanity check data
	for (int cx = 0; cx < numItems; cx++) {
		if (!omxDataColumnIsFactor(data, colMap[cx])) {
			data->omxPrintData("diagnostic", 3);
			omxRaiseErrorf("%s: column %d is not a factor", oo->name, int(1 + colMap[cx]));
			return;
		}
	}

	// TODO the max outcome should be available from omxData
	for (int rx=0; rx < data->rows; rx++) {
		int cols = 0;
		for (int cx = 0; cx < numItems; cx++) {
			const int *col = state->grp.dataColumns[cx];
			int pick = col[rx];
			if (pick == NA_INTEGER) continue;
			++cols;
			const int no = state->grp.itemOutcomes[cx];
			if (pick > no) {
				Rf_error("Data for item '%s' has at least %d outcomes, not %d",
					 state->itemParam->colnames[cx], pick, no);
			}
		}
		if (cols == 0) {
			Rf_error("Row %d has all NAs", 1+rx);
		}
	}

	if (state->_latentMeanOut && state->_latentMeanOut->rows * state->_latentMeanOut->cols != maxAbilities) {
		Rf_error("The mean matrix '%s' must be a row or column vector of size %d",
			 state->_latentMeanOut->name(), maxAbilities);
	}

	if (state->_latentCovOut && (state->_latentCovOut->rows != maxAbilities ||
				    state->_latentCovOut->cols != maxAbilities)) {
		Rf_error("The cov matrix '%s' must be %dx%d",
			 state->_latentCovOut->name(), maxAbilities, maxAbilities);
	}

	state->grp.setLatentDistribution(state->_latentMeanOut? state->_latentMeanOut->data : NULL,
					 state->_latentCovOut? state->_latentCovOut->data : NULL);

	{
		EigenArrayAdaptor Eparam(state->itemParam);
		Eigen::Map< Eigen::VectorXd > meanVec(state->grp.mean, maxAbilities);
		Eigen::Map< Eigen::MatrixXd > covMat(state->grp.cov, maxAbilities, maxAbilities);
		state->grp.quad.setStructure(state->grp.qwidth, state->grp.qpoints,
					     Eparam, meanVec, covMat);
	}

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("minItemsPerScore")));
	state->grp.setMinItemsPerScore(Rf_asInteger(tmp));
	}

	state->grp.buildRowSkip();

	if (isErrorRaised()) return;

	{ScopedProtect p1(tmp, R_do_slot(rObj, Rf_install("debugInternal")));
	state->debugInternal = Rf_asLogical(tmp);
	}

	state->ElatentVersion = 0;
	if (state->_latentMeanOut) {
		state->estLatentMean = omxInitMatrix(maxAbilities, 1, TRUE, currentState);
		omxCopyMatrix(state->estLatentMean, state->_latentMeanOut); // rename matrices TODO
	}
	if (state->_latentCovOut) {
		state->estLatentCov = omxInitMatrix(maxAbilities, maxAbilities, TRUE, currentState);
		omxCopyMatrix(state->estLatentCov, state->_latentCovOut);
	}
}
Esempio n. 13
0
static void
ba81compute(omxExpectation *oo, FitContext *fc, const char *what, const char *how)
{
	BA81Expect *state = (BA81Expect *) oo->argStruct;

	if (what) {
		if (strcmp(what, "latentDistribution")==0 && how && strcmp(how, "copy")==0) {
			omxCopyMatrix(state->_latentMeanOut, state->estLatentMean);
			omxCopyMatrix(state->_latentCovOut, state->estLatentCov);

			double sampleSizeAdj = (state->weightSum - 1.0) / state->weightSum;
			int covSize = state->_latentCovOut->rows * state->_latentCovOut->cols;
			for (int cx=0; cx < covSize; ++cx) {
				state->_latentCovOut->data[cx] *= sampleSizeAdj;
			}
			return;
		}

		if (strcmp(what, "scores")==0) {
			state->expectedUsed = true;
			state->type = EXPECTATION_AUGMENTED;
		} else if (strcmp(what, "nothing")==0) {
			state->type = EXPECTATION_OBSERVED;
		} else {
			omxRaiseErrorf("%s: don't know how to predict '%s'",
				       oo->name, what);
		}

		if (state->verbose >= 1) {
			mxLog("%s: predict %s", oo->name, what);
		}
		return;
	}

	bool latentClean = state->latentParamVersion == getLatentVersion(state);
	bool itemClean = state->itemParamVersion == omxGetMatrixVersion(state->itemParam) && latentClean;

	ba81NormalQuad &quad = state->getQuad();

	if (state->verbose >= 1) {
		mxLog("%s: Qinit %d itemClean %d latentClean %d (1=clean) expectedUsed=%d",
		      oo->name, (int)quad.isAllocated(), itemClean, latentClean, state->expectedUsed);
	}

	if (!latentClean) {
		ba81RefreshQuadrature(oo);
		state->latentParamVersion = getLatentVersion(state);
	}

	if (!itemClean) {
		double *param = state->EitemParam? state->EitemParam : state->itemParam->data;
		state->grp.quad.cacheOutcomeProb(param, FALSE);

		bool estep = state->expectedUsed;
		if (estep) {
			if (oo->dynamicDataSource) {
				BA81Engine<BA81Expect*, BA81LatentSummary, BA81Estep> engine;
				engine.ba81Estep1(&state->grp, state);
			} else {
				BA81Engine<BA81Expect*, BA81LatentFixed, BA81Estep> engine;
				engine.ba81Estep1(&state->grp, state);
			}
		} else {
			state->grp.quad.releaseEstep();
			refreshPatternLikelihood(state, oo->dynamicDataSource);
		}
		if (oo->dynamicDataSource && state->verbose >= 2) {
			mxLog("%s: empirical distribution mean and cov:", state->name);
			omxPrint(state->estLatentMean, "mean");
			omxPrint(state->estLatentCov, "cov");
		}
		if (state->verbose >= 1) {
			const int numUnique = state->getNumUnique();
			mxLog("%s: estep<%s, %s> %d/%d rows excluded",
			      state->name,
			      (estep && oo->dynamicDataSource? "summary":"fixed"),
			      (estep? "estep":"omitEstep"),
			      state->grp.excludedPatterns, numUnique);
		}
	}

	state->itemParamVersion = omxGetMatrixVersion(state->itemParam);
}
Esempio n. 14
0
void complainAboutMissingMeans(omxExpectation *off)
{
	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);
}
Esempio n. 15
0
void omxRaiseError(const char* msg) { // DEPRECATED
	omxRaiseErrorf("%s", msg);
}