int optim_lambda(POPROT *pop, double *gal, double *alkeep, double *crit,
double dmax, double crit2, double vmgal)
{
/* dmax is too large a move along the direction
=> move along the direction by dmax/2**k until
-the move is too small : no new frequencies have been found (return 1)
-a better likelihood is found => update pop with the new frequencies
-if the criteria has changed by more than FTOL, return 0
-else return 1; the frequencies correspond to the last (smallest) move
*/
int j;
double ro = 1,crit1;
do
{
ro = ro*0.5;
for(j = 0;j<pop->np;j++) pop->freq[j] = alkeep[j]+ro*dmax*gal[j];
crit1 = lik(pop); /* Updates Mf-1 for new frequencies */
if(crit1>*crit)
{
for(j = 0;j<pop->np;j++) alkeep[j] = pop->freq[j];
*crit = crit1;
if(fabs((crit2-*crit)/crit2)>FTOL) {return 0;}
else {return 1;}
}
} while((dmax*ro*vmgal)>1e-4);
for(j = 0;j<pop->np;j++) pop->freq[j] = alkeep[j];
return 1;
}
mydouble ContinuousMosaicDistribution::partial_likelihood_change_value(const ContinuousMosaicRV& y) {
mydouble lik(1.0);
_x = y.last_change_value().from;
lik /= get_marginal_distribution()->likelihood(this,to_Value());
_x = y.last_change_value().to;
lik *= get_marginal_distribution()->likelihood(this,to_Value());
return lik;
}
/* conFun: called for confidence interval estimation of pi */
double confFun(double x, void *params){
Result *res;
double l;
res = (Result *)params;
lik(x);
l = likelihood + res->l + 2.;
return l;
}
double myF(const gsl_vector* v, void *params){
double de;
/* get delta */
de = gsl_vector_get(v, 0);
if(de < -1 || de > 1)
return DBL_MAX;
else
lik(de);
return -likelihood;
}
void CVarianceDecomposition::initGPkronSum()
{
//check whether exact Kronecker structure?
if (this->phenoNANany)
throw CLimixException("GPKronSum (fast inference) can only be used for full kronecker structured data");
if (this->getNumberTerms()!=2)
throw CLimixException("CVarianceDecomposition: fastGP only works for two terms");
if (this->getNumberTraits()<2)
throw CLimixException("CVarianceDecomposition: supported only for multiple traits");
if (this->is_init && this->fast) {
this->gp->setY(pheno);
CGPHyperParams params = this->gp->getParams();
VectorXd covarParams;
this->agetScales(0,&covarParams); params["covarc1"]=covarParams;
this->agetScales(1,&covarParams); params["covarc2"]=covarParams;
params["dataTerm"] = MatrixXd::Zero(params["dataTerm"].rows(),params["dataTerm"].cols());
this->gp->setParams(params);
}
else
{
//init covars
this->terms[0]->initTerm();
this->terms[1]->initTerm();
PCovarianceFunction covarr1 = this->terms[0]->getKcf();
PCovarianceFunction covarr2 = this->terms[1]->getKcf();
PCovarianceFunction covarc1 = this->terms[0]->getTraitCovar();
PCovarianceFunction covarc2 = this->terms[1]->getTraitCovar();
//init dataTerm
MatrixXdVec::const_iterator fixed_iter = this->fixedEffs.begin();
MatrixXdVec::const_iterator design_iter = this->designs.begin();
PSumLinear mean(new CSumLinear());
for (; design_iter != this->designs.end(); design_iter++, fixed_iter++) {
MatrixXd A = design_iter[0];
MatrixXd F = fixed_iter[0];
MatrixXd W = MatrixXd::Zero(F.cols(),A.rows());
mean->appendTerm(PKroneckerMean(new CKroneckerMean(pheno,W,F,A)));
}
// init lik
PLikNormalNULL lik(new CLikNormalNULL());
//define gpKronSum
this->gp = PGPkronSum(new CGPkronSum(pheno, covarr1, covarc1, covarr2, covarc2, lik, mean));
this->fast=true;
this->is_init=1;
//Initialize Params
this->initGPparams();
//Optimizer GP
this->opt = PGPopt(new CGPopt(gp));
}
}
int main_opt(PROTOC *allprot,POPROT *pop,char *nomout,int nprot)
{ int nit = 0,ifin = 0,nstop,ntest;
double cri;
cri = lik(pop);
/* fprintf(stderr,"Critère au point initial = %lf \n",cri);
*/ ecritprot(nomout,pop,(-1));
for(nit = 0;nit<100;nit++)
{
/* A priori, il n'y a aucune chance d'avoir un alpha trop petit a ce stade donc
je mets l'appel a tassement a la fin
*/ nstop = 0;
do
{
ifin = ajout(allprot,pop,nprot);
nstop++;
} while ((cri<(-1e10))& (nstop<100));
if((nstop>99)& (cri<(-1e10)))
{
fprintf(stderr,"Unable to find a new protocol to add \n");
return -10;
}
if(ifin==1) break; /* Si ifin=1, on sort de la boucle sur nit */
ntest = doptimal(pop,allprot);
if(ntest<0)
return -100;
tassement(pop);
ecritprot(nomout,pop,nit);
if(pop->np>(pop->ndim*(pop->ndim+1)/2))
{
index_limit(pop);
return -1;
}
cri = lik(pop); /* Updates matrices */
}
return nit;
}
mydouble ContinuousMosaicDistribution::partial_likelihood_split_block(const ContinuousMosaicRV& y) {
const double p = get_p()->get_double();
mydouble success = mydouble(p);
mydouble failure = mydouble(1-p);
mydouble lik(1.0);
_x = y.last_split_block().from;
lik /= get_marginal_distribution()->likelihood(this,to_Value());
_x = y.last_split_block().to[0];
lik *= get_marginal_distribution()->likelihood(this,to_Value());
_x = y.last_split_block().to[1];
lik *= get_marginal_distribution()->likelihood(this,to_Value());
lik *= success/failure;
return lik;
}
int ajout(PROTOC *allprot,POPROT *pop,int nprot)
{ double cri,xmul,xtest,ifin = 0,xdim,rcalc;
int iprot,j,deja,qajout = -1;
cri = pop->det;
xtest = (double)(pop->ndim);
xdim = xtest;
for(iprot = 0;iprot<nprot;iprot++)
{
deja = 0;
for(j = 0;j<pop->np;j++)
{
if (iprot == pop->num[j]) deja = 1;
}
if(fabs(deja)<EPSILON)
{
xmul = matrace(iprot,allprot,pop);
if(xmul>=xtest)
{
xtest = xmul;
qajout = iprot;
}
}
}
if(fabs(xtest-xdim)<EPSILON)
{
ifin = 1;
}
else
{
rcalc = (xtest-xdim)/(xdim*(xtest-1));
/* printf("rcalc=%lf\n",rcalc);
*/
PROTOC_alloc(&pop->pind[pop->np],allprot[qajout].ntps,allprot[qajout].ndim);
PROTOC_copy(&allprot[qajout],&pop->pind[pop->np]);
pop->num[pop->np] = qajout;
pop->freq[pop->np] = rcalc;
for(j = 0;j<pop->np;j++) pop->freq[j] = pop->freq[j]*(1-rcalc);
pop->np++;
}
/* fprintf(stderr,"\n Dans ajout :\n");
POPROT_print(pop,0);
*/ cri = lik(pop);
return ifin;
}
mydouble ContinuousMosaicDistribution::full_likelihood(const ContinuousMosaicRV& y) {
// _calculate_likelihood = false;
const double p = get_p()->get_double();
if(p<0 || p>1) return mydouble::zero();
mydouble success = mydouble(p);
mydouble failure = mydouble(1-p);
mydouble lik(1.0);
int i;
for(i=0;i<y.length();i++) {
bool breakpoint = y.is_block_start(i);
if(i==0 || breakpoint) {
_x = y.get_double(i);
lik *= get_marginal_distribution()->likelihood(this,to_Value());
}
if(i!=0) lik *= (breakpoint) ? success : failure;
}
return lik;
}
int takeout_k(POPROT *pop,PROTOC *allprot,int *nnul)
{
int ir = -1,j;
double xmul;
xmul = lik(pop); /*update Mf-1 */
for(j = 0;j<pop->np;j++)
{
xmul = 0;
if(pop->freq[j] <= FREQMIN)
{
xmul = matrace(pop->num[j],allprot,pop);
if(xmul>(double)pop->ndim)
{
ir = j;
*nnul = *nnul-1;
return ir;
}
}
}
return ir;
}
void ecritprot(char *outfile, POPROT *pop, int nit)
{
FILE *inout = fopen(outfile,"a"); /* Appends to file */
int i,j;
double xcal;
if (inout == NULL) {
fprintf(stderr,"Impossible d'ouvrir le fichier %s en lecture/écriture\n",outfile);
return;
}
if (nit == (-1))
fprintf(inout, "INITIALISATION\n");
else
fprintf(inout, "ITERATION %d \n", nit);
fprintf(inout, "NOMBRE DE GROUPES %d ", pop->np);
xcal=lik(pop);
xcal = exp(log(pop->det)/(double)pop->ndim);
fprintf(inout,"DET %e EFF %e\n",pop->det,xcal);
/* Ici calcul du cout dans programme initial
fprintf(inout,"nombre total de points %d ",880);
fprintf(inout,"nombre de sujets %lf \n",(double)880/4);
ntot=800, donne comme cout maximal
xcout=1
cout(iprot)=ntps(iprot)/float(ntot)*xcout
xnn=Somme_i xcout*al(i)/cout(q(i))
ga(i) remplace ici par 2 fois frequence
*/
for(i = 0;i<pop->np;i++)
{
fprintf(inout,"%d %lf %lf %d %d ",i,pop->freq[i],pop->freq[i],
pop->num[i]+1,pop->pind[i].ntps);
for (j = 0;j<pop->pind[i].ntps;j++)
{
fprintf(inout,"%lf ",pop->pind[i].tps[j]);
}
fprintf(inout,"\n ");
}
fclose(inout);
return;
}
int project_grad(POPROT *pop, PROTOC *allprot, double *gal,int ir,double
*vmgal,int nnul)
{
/* Computes the projection of the gradient of ln(V)=ln(det(H(pop))) on the
surface sum(frequencies)=1 and freq[j]=0 for all j such as pop->freq[j]<FREQMIN
gal[j] is the jth component of the projected gradient (the direction)
gal[j]=0 if pop->freq[j]<FREQMIN and j<>ir
ir is -1 or the index removed from the active set at the previous step
vmgal is the largest abs(gal[j])
returns in, the last index j such as gal[j]<0
*/
int j,in = -1;
double sg,sgal;
sg = lik(pop); /* Check that Mf-1 has been computed */
sg = 0;
for(j = 0;j<pop->np;j++)
{
gal[j] = 0;
if((pop->freq[j]>=FREQMIN) | (j==ir))
gal[j] = matrace(pop->num[j],allprot,pop);
sg = sg+gal[j];
}
sgal = 0;*vmgal = 0;
for(j = 0;j<pop->np;j++)
{
if((pop->freq[j] >= FREQMIN) | (j==ir))
{
gal[j] = gal[j]-sg/(double)(pop->np-nnul);
if(fabs(gal[j])>*vmgal) *vmgal = (double)fabs(gal[j]);
if(gal[j]<0) in = j;
sgal = sgal+gal[j];
}
}
return in;
}
int doptimal(POPROT *pop,PROTOC *allprot)
{
int nnul = 0, ir = -1,in = -1,nit = 0;
int j,imax,iopt;
double crit,crit1,crit2,vmgal,dmax;
double *gal,*alkeep;
double sal,sal1;
gal = (double *)calloc(pop->np,sizeof(double));
alkeep = (double *)calloc(pop->np,sizeof(double));
crit = lik(pop); /*Calcul de Mf-1 */
for(nit = 0;nit<500;nit++)
{
/* alkeep stores the initial frequencies of the elementary protocols
*/
for(j = 0;j<pop->np;j++)
alkeep[j] = pop->freq[j];
crit2 = crit;
if(ir==(-1)) /* First time through */
{
nnul = 0; /* Computing the number of nul frequencies */
for(j = 0;j<pop->np;j++)
{
if(pop->freq[j]<FREQMIN) nnul++;
}
}
/* Compute the projected gradient (direction)*/
in = project_grad(pop,allprot,gal,ir,&vmgal,nnul);
if((in<0) | (gal[in]==0))
{
free(gal);
free(alkeep);
return nnul;
}
/* Compute the optimal change along the gradient dmax (lambda)*/
dmax = -pop->freq[in]/gal[in];
imax = in;
if((ir!=(-1)) & (gal[ir]<=0))
{
free(gal);
free(alkeep);
return nnul;
}
ir = -1;
for(j = 0;j<pop->np;j++)
{
if((gal[j]<0) & (fabs(pop->freq[j]/gal[j])<dmax))
{
dmax = -pop->freq[j]/gal[j];
imax = j;
}
}
/* Updates the frequencies as beta*(t,j)=beta(t,j)+dmax*gal(j)
Compute the likelihood for the updated vector of frequencies
*/
sal = 0;
for(j = 0;j<pop->np;j++)
{
pop->freq[j] = pop->freq[j]+dmax*gal[j];
sal = sal+pop->freq[j];
}
sal1 = sal-pop->freq[imax];
pop->freq[imax] = 0;
crit1 = lik(pop);
/* If better likelihood, update alkeep (pop->freq has been updated already)
*/
if(crit1>crit)
{
for(j = 0;j<pop->np;j++) alkeep[j] = pop->freq[j];
crit = crit1;
nnul++;
}
else
{
for(j = 0;j<pop->np;j++) pop->freq[j] = alkeep[j];
/* If not, try dmax*ro for ro=1/2**k until dmax*ro too small
*/
iopt = optim_lambda(pop,gal,alkeep,&crit,dmax,crit2,vmgal);
if(iopt==1)
{
ir = takeout_k(pop,allprot,&nnul);
/* ir=-1 if for all j, matrace(q[j]) <= ndim*(ndim+1)/2, ie optimal protocol
=> in that case exit the subroutine
*/
if(ir==(-1))
{
free(gal);
free(alkeep);
return nnul;
}
}
}
}
free(gal);
free(alkeep);
fprintf(stderr,"Pb with convergence in doptimal \n");
return -10;
}
void CVarianceDecomposition::initGPbase()
{
this->covar = PSumCF(new CSumCF());
// Init Covariances and sum them
for(PVarianceTermVec::iterator iter = this->terms.begin(); iter!=this->terms.end();iter++)
{
PVarianceTerm term = iter[0];
term->initTerm();
this->covar->addCovariance(iter[0]->getCovariance());
}
//Build Fixed Effect Term
// count number of cols
muint_t numberCols = 0;
MatrixXdVec::const_iterator design_iter = this->designs.begin();
MatrixXdVec::const_iterator fixed_iter = this->fixedEffs.begin();
for (; design_iter != this->designs.end(); design_iter++, fixed_iter++)
numberCols += design_iter[0].rows()*fixed_iter[0].cols();
//define fixed for CLinearMean
MatrixXd fixed(this->N*this->P,numberCols);
design_iter = this->designs.begin();
fixed_iter = this->fixedEffs.begin();
muint_t ncols = 0;
for (; design_iter != this->designs.end(); design_iter++, fixed_iter++)
{
MatrixXd part;
akron(part,design_iter[0].transpose(),fixed_iter[0]);
//fixed.block(0,ncols,this->N*this->P,design_iter[0].rows())=part;//Christoph: bug? should also take into account the number of columns in the fixed effects
fixed.block(0,ncols,this->N*this->P,design_iter[0].rows()*fixed_iter[0].cols())=part;//Christoph: fix
ncols+=design_iter[0].rows()*fixed_iter[0].cols();
}
//vectorize phenotype
MatrixXd y = this->pheno;
y.resize(this->N*this->P,1);
//do we have to deal with missing values
//phenoNANany = true;
if(this->phenoNANany)
{
//1. vectorize missing values
MatrixXb Iselect = this->phenoNAN;
Iselect.resize(this->N*this->P,1);
//invert
Iselect = Iselect.unaryExpr(std::ptr_fun(negate));
//2. select on y
MatrixXd _y;
slice(y,Iselect,_y);
y = _y;
//3 fixed effecfs
MatrixXd _fixed;
slice(fixed,Iselect,_fixed);
fixed = _fixed;
//4. set filter in terms
for(PVarianceTermVec::iterator iter = this->terms.begin(); iter!=this->terms.end();iter++)
{
PVarianceTerm term = iter[0];
term->setSampleFilter(Iselect);
}
}
//Define Likelihood, LinearMean and GP
PLikNormalNULL lik(new CLikNormalNULL());
PLinearMean mean(new CLinearMean(y,fixed));
this->gp = PGPbase(new CGPbase(covar, lik, mean));
this->gp->setY(y);
this->fast=false;
this->is_init=1;
//Initialize Params
this->initGPparams();
//optimizer
this->opt = PGPopt(new CGPopt(gp));
}
