arma::Col<double> CubicRegressionFunction::getRegressionImplementation(
const arma::Col<double>& parameter) const {
arma::Col<double> regression(numberOfRegressionDimensions_);
arma::uword n = 0;
for (arma::uword k = 0; k < numberOfParameterDimensions_; ++k) {
for (arma::uword l = k; l < numberOfParameterDimensions_; ++l) {
for (arma::uword m = l; m < numberOfParameterDimensions_; ++m) {
regression(n++) = parameter(k) * parameter(l) * parameter(m);
}
}
}
for (arma::uword k = 0; k < numberOfParameterDimensions_; ++k) {
for (arma::uword l = k; l < numberOfParameterDimensions_; ++l) {
regression(n++) = parameter(k) * parameter(l);
}
}
regression.subvec(n, n + numberOfParameterDimensions_ - 1) = parameter;
n += numberOfParameterDimensions_;
regression(n) = 1;
return regression;
}
SparseVector ARSM::observation_matrix(int t)const {
int n = regression()->dat().size();
if(t < n) return RegressionStateModel::observation_matrix(t);
if(t > n) {
report_error("argument too large in "
"AggregatedRegressionStateModel::observation_matrix");
}
// Handle the t == n case, which will occur on the final step of
// the Kalman filter.
double eta = regression()->predict(final_x_);
SparseVector ans(1);
ans[0] = eta;
return ans;
}
void testBivariateStats(){
float x[]={95.0,85.0,80.0,70.0,60.0};
float y[]={85.0,95.0,70.0,65.0,70.0};
regressionCoefficients coeffs;
coeffs=regression(x,y,5);
printf("\nBivariate Stats\n");
printf("correlation =%f\n",correlation(x,y,5));
printf("covariance =%f\n",covariance(x,y,5));
printf("rmse =%f\n",rmse(x,y,5));
printf("bias =%f\n",bias(x,y,5));
printf("m =%f\n",coeffs.m);
printf("c =%f\n",coeffs.c);
}
int main(int argc, char *argv[])
{
if(argc>1 && argv[1][0]=='-' && argv[1][1]=='r') /* appel du test de régression */
{
regression();
return 0;
}
int contreordinateur, niveauordinateur, plateau;
/* paramètres de jeu par défaut */
contreordinateur = 1;
niveauordinateur = 3;
plateau = 1;
while(menuPrincipal(&contreordinateur, &niveauordinateur, &plateau)==1)
{
Jouer( contreordinateur, niveauordinateur, plateau);
}
return 0;
}
int svg_plot(config *cfg, plot_info *pi, data_set *ds) {
svg_theme *theme = cfg->svg_theme;
svg_printf_header(pi->w, pi->h);
svg_printf_frame(pi->w, pi->h, theme->bg_color, theme->border_width, theme->border_color);
if (cfg->axis) {
draw_calc_axis_pos(pi);
svg_printf_axis(pi, theme);
}
transform_t transform = scale_get_transform(pi->log_x, pi->log_y);
for (uint8_t c = 0; c < ds->columns; c++) {
char *color = get_color(c, theme);
point *column = ds->pairs[c];
if (cfg->mode == MODE_LINE) {
bool beginning_line = true;
for (size_t i = 0; i < ds->rows; i++) {
point *p = &column[i];
if (IS_EMPTY(p->x) || IS_EMPTY(p->y)) {
if (!beginning_line) {
svg_printf_end_polyline(color, theme->line_width);
}
beginning_line = true;
continue;
}
if (beginning_line) {
svg_printf_begin_polyline();
beginning_line = false;
}
scaled_point sp;
scale_point(pi, p, &sp, transform);
svg_printf_polyline_point(sp.x, sp.y);
}
svg_printf_end_polyline(color, theme->line_width);
} else {
for (size_t i = 0; i < ds->rows; i++) {
point *p = &column[i];
scaled_point sp;
scale_point(pi, p, &sp, transform);
if (IS_EMPTY(p->x) || IS_EMPTY(p->y)) { continue; }
size_t point_size = SVG_DEF_POINT_SIZE;
if (pi->counters) {
size_t count = counter_get(pi->counters[c], sp.x, sp.y);
point_size = SVG_DEF_POINT_SIZE + (cfg->log_count ? log(count) : count);
}
svg_printf_circle(sp.x, sp.y, point_size, color);
}
}
if (cfg->regression) {
double slope = 0;
double intercept = 0;
regression(column, ds->rows, transform, &slope, &intercept);
svg_printf_regression_line(pi, color, slope, intercept);
}
}
svg_printf_end();
return 0;
}
/* ML estimation of parameters in mixture model via EM; maximum-likelihood
* estimation of parameters in the mixture model via the EM algorithm, using
* multilocus information, but assuming known recombination frequencies
*/
double QTLmixture(MQMMarkerMatrix loci, cvector cofactor, vector r, cvector position,
vector y, ivector ind, int Nind, int Naug,
int Nloci,
double *variance, int em, vector *weight, const bool useREML,const bool fitQTL,const bool dominance, MQMCrossType crosstype, int verbose) {
//debug_trace("QTLmixture called Nloci=%d Nind=%d Naug=%d, REML=%d em=%d fit=%d domi=%d cross=%c\n",Nloci,Nind,Naug,useREML,em,fitQTL,dominance,crosstype);
//for (int i=0; i<Nloci; i++){ debug_trace("loci %d : recombfreq=%f\n",i,r[i]); }
int iem= 0, i, j;
bool warnZeroDist=false;
bool biasadj=false;
double oldlogL=-10000, delta=1.0, calc_i, Pscale=1.75;
vector indweight = newvector(Nind);
int newNaug = ((!fitQTL) ? Naug : 3*Naug);
vector Fy = newvector(newNaug);
double logP = Nloci*log(Pscale); // only for computational accuracy
bool varknown = (((*variance)==-1.0) ? false : true );
vector Ploci = newvector(newNaug);
#ifndef STANDALONE
R_CheckUserInterrupt(); /* check for ^C */
R_FlushConsole();
#endif
if (!useREML) {
varknown=false;
biasadj=false;
}
for (i=0; i<newNaug; i++) { Ploci[i]= 1.0; }
if (!fitQTL) {
for (j=0; j<Nloci; j++) {
for (i=0; i<Naug; i++)
Ploci[i]*= Pscale;
if ((position[j]==MLEFT)||(position[j]==MUNLINKED)) {
for (i=0; i<Naug; i++) {
calc_i = start_prob(crosstype, loci[j][i]); // calc_i= prob(loci, r, i, j, MH, crosstype, 0, 1);
Ploci[i]*= calc_i;
//Als Ploci > 0 en calc_i > 0 then we want to assert Ploci[] != 0
}
}
if ((position[j]==MLEFT)||(position[j]==MMIDDLE)) {
for (i=0; i<Naug; i++) {
calc_i =left_prob(r[j],loci[j][i],loci[j+1][i],crosstype); //calc_i = prob(loci, r, i, j, loci[j+1][i], crosstype, 0);
if(calc_i == 0.0){calc_i=1.0;warnZeroDist=true;}
Ploci[i]*= calc_i;
}
}
}
} else {
for (j=0; j<Nloci; j++) {
for (i=0; i<Naug; i++) {
Ploci[i]*= Pscale; // only for computational accuracy; see use of logP
Ploci[i+Naug]*= Pscale; // only for computational accuracy; see use of logP
Ploci[i+2*Naug]*= Pscale; // only for computational accuracy; see use of logP
}
if ((position[j]==MLEFT)||(position[j]==MUNLINKED)) {
if (cofactor[j]<=MCOF){
for (i=0; i<Naug; i++) {
calc_i = start_prob(crosstype, loci[j][i]); // calc_i= prob(loci, r, i, j, MH, crosstype, 0, 1);
Ploci[i] *= calc_i;
Ploci[i+Naug] *= calc_i;
Ploci[i+2*Naug] *= calc_i;
}
}else{
for (i=0; i<Naug; i++) {
Ploci[i]*= start_prob(crosstype, MAA); //startvalue for MAA for new chromosome
Ploci[i+Naug]*= start_prob(crosstype, MH); //startvalue for MH for new chromosome
Ploci[i+2*Naug] *= start_prob(crosstype, MBB); //startvalue for MBB for new chromosome
}
}
}
if ((position[j]==MLEFT)||(position[j]==MMIDDLE)) {
if ((cofactor[j]<=MCOF)&&(cofactor[j+1]<=MCOF))
for (i=0; i<Naug; i++) {
calc_i =left_prob(r[j],loci[j][i],loci[j+1][i],crosstype); //calc_i = prob(loci, r, i, j, loci[j+1][i], crosstype, 0);
if(calc_i == 0.0){calc_i=1.0;warnZeroDist=true;}
Ploci[i]*= calc_i;
Ploci[i+Naug]*= calc_i;
Ploci[i+2*Naug]*= calc_i;
}
else if (cofactor[j]<=MCOF) // locus j+1 == QTL
for (i=0; i<Naug; i++) { // QTL==MAA || MH || MBB means: What is the prob of finding an MAA at J=1
calc_i =left_prob(r[j],loci[j][i],MAA,crosstype); //calc_i = prob(loci, r, i, j, MAA, crosstype, 0);
Ploci[i]*= calc_i;
calc_i = left_prob(r[j],loci[j][i],MH,crosstype); //calc_i = prob(loci, r, i, j, MH, crosstype, 0);
Ploci[i+Naug]*= calc_i;
calc_i = left_prob(r[j],loci[j][i],MBB,crosstype); //calc_i = prob(loci, r, i, j, MBB, crosstype, 0);
Ploci[i+2*Naug]*= calc_i;
}
else // locus j == QTL
for (i=0; i<Naug; i++) { // QTL==MQTL
calc_i = left_prob(r[j],MAA,loci[j+1][i],crosstype); //calc_i = prob(loci, r, i, j+1, MAA, crosstype, -1);
Ploci[i]*= calc_i;
calc_i = left_prob(r[j],MH,loci[j+1][i],crosstype); //calc_i = prob(loci, r, i, j+1, MH, crosstype, -1);
Ploci[i+Naug]*= calc_i;
calc_i = left_prob(r[j],MBB,loci[j+1][i],crosstype); //calc_i = prob(loci, r, i, j+1, MBB, crosstype, -1);
Ploci[i+2*Naug]*= calc_i;
}
}
}
}
if(warnZeroDist)info("!!! 0.0 from Prob !!! Markers at same Cm but different genotype !!!");
// Rprintf("INFO: Done fitting QTL's\n");
if ((*weight)[0]== -1.0) {
for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (!fitQTL) {
for (i=0; i<Naug; i++) indweight[ind[i]]+=Ploci[i];
for (i=0; i<Naug; i++) (*weight)[i]= Ploci[i]/indweight[ind[i]];
} else {
for (i=0; i<Naug; i++) indweight[ind[i]]+=Ploci[i]+Ploci[i+Naug]+Ploci[i+2*Naug];
for (i=0; i<Naug; i++) {
(*weight)[i] = Ploci[i]/indweight[ind[i]];
(*weight)[i+Naug] = Ploci[i+Naug]/indweight[ind[i]];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]/indweight[ind[i]];
}
}
}
debug_trace("Weights done\n");
debug_trace("Individual->trait,indweight weight Ploci\n");
//for (int j=0; j<Nind; j++){
// debug_trace("%d->%f,%f %f %f\n", j, y[j],indweight[i], (*weight)[j], Ploci[j]);
//}
double logL = 0;
vector indL = newvector(Nind);
while ((iem<em)&&(delta>1.0e-5)) {
iem+=1;
if (!varknown) *variance=-1.0;
logL = regression(Nind, Nloci, cofactor, loci, y, weight, ind, Naug, variance, Fy, biasadj, fitQTL, dominance);
logL = 0.0;
for (i=0; i<Nind; i++) indL[i]= 0.0;
if (!fitQTL) // no QTL fitted
for (i=0; i<Naug; i++) {
(*weight)[i]= Ploci[i]*Fy[i];
indL[ind[i]]= indL[ind[i]] + (*weight)[i];
}
else // QTL moved along the chromosomes
for (i=0; i<Naug; i++) {
(*weight)[i]= Ploci[i]*Fy[i];
(*weight)[i+Naug] = Ploci[i+Naug]* Fy[i+Naug];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]*Fy[i+2*Naug];
indL[ind[i]]+=(*weight)[i]+(*weight)[i+Naug]+(*weight)[i+2*Naug];
}
for (i=0; i<Nind; i++) logL+=log(indL[i])-logP;
for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (!fitQTL) {
for (i=0; i<Naug; i++) indweight[ind[i]]+=(*weight)[i];
for (i=0; i<Naug; i++) (*weight)[i]/=indweight[ind[i]];
} else {
for (i=0; i<Naug; i++)
indweight[ind[i]]+=(*weight)[i]+(*weight)[i+Naug]+(*weight)[i+2*Naug];
for (i=0; i<Naug; i++) {
(*weight)[i] /=indweight[ind[i]];
(*weight)[i+Naug] /=indweight[ind[i]];
(*weight)[i+2*Naug]/=indweight[ind[i]];
}
}
delta= fabs(logL-oldlogL);
oldlogL= logL;
}
if ((useREML)&&(!varknown)) { // Bias adjustment after finished ML estimation via EM
*variance=-1.0;
biasadj=true;
logL = regression(Nind, Nloci, cofactor, loci, y, weight, ind, Naug, variance, Fy, biasadj, fitQTL, dominance);
logL = 0.0;
for (int _i=0; _i<Nind; _i++) indL[_i]= 0.0;
if (!fitQTL)
for (i=0; i<Naug; i++) {
(*weight)[i]= Ploci[i]*Fy[i];
indL[ind[i]]+=(*weight)[i];
}
else
for (i=0; i<Naug; i++) {
(*weight)[i]= Ploci[i]*Fy[i];
(*weight)[i+Naug]= Ploci[i+Naug]*Fy[i+Naug];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]*Fy[i+2*Naug];
indL[ind[i]]+=(*weight)[i];
indL[ind[i]]+=(*weight)[i+Naug];
indL[ind[i]]+=(*weight)[i+2*Naug];
}
for (i=0; i<Nind; i++) logL+=log(indL[i])-logP;
for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (!fitQTL) {
for (i=0; i<Naug; i++) indweight[ind[i]]+=(*weight)[i];
for (i=0; i<Naug; i++) (*weight)[i]/=indweight[ind[i]];
} else {
for (i=0; i<Naug; i++) {
indweight[ind[i]]+=(*weight)[i];
indweight[ind[i]]+=(*weight)[i+Naug];
indweight[ind[i]]+=(*weight)[i+2*Naug];
}
for (i=0; i<Naug; i++) {
(*weight)[i] /=indweight[ind[i]];
(*weight)[i+Naug] /=indweight[ind[i]];
(*weight)[i+2*Naug]/=indweight[ind[i]];
}
}
}
//for (i=0; i<Nind; i++){ debug_trace("IND %d Ploci: %f Fy: %f UNLOG:%f LogL:%f LogL-LogP: %f\n", i, Ploci[i], Fy[i], indL[i], log(indL[i]), log(indL[i])-logP); }
Free(Fy);
Free(Ploci);
Free(indweight);
Free(indL);
return logL;
}
/* ML estimation of parameters in mixture model via EM;
*/
double QTLmixture(cmatrix loci, cvector cofactor, vector r, cvector position,
vector y, ivector ind, int Nind, int Naug,
int Nloci,
double *variance, int em, vector *weight,char REMLorML,char fitQTL,char dominance,char crosstype,Mmatrix MendelM,int verbose){
//if(verbose==1){Rprintf("QTLmixture called\n");}
int iem= 0, newNaug, i, j;
char varknown, biasadj='n';
double oldlogL=-10000, delta=1.0, calc_i, logP=0.0, Pscale=1.75;
double calc_ii;
vector indweight, Ploci, Fy;
indweight= newvector(Nind);
newNaug= (fitQTL=='n' ? Naug : 3*Naug);
Fy= newvector(newNaug);
logP= Nloci*log(Pscale); // only for computational accuracy
varknown= (((*variance)==-1.0) ? 'n' : 'y' );
Ploci= newvector(newNaug);
#ifndef ALONE
R_CheckUserInterrupt(); /* check for ^C */
R_ProcessEvents();
R_FlushConsole();
#endif
if ((REMLorML=='0')&&(varknown=='n')){
// Rprintf("INFO: REML\n");
}
if (REMLorML=='1') {
// Rprintf("INFO: ML\n");
varknown='n'; biasadj='n';
}
for (i=0; i<newNaug; i++){
Ploci[i]= 1.0;
}
if (fitQTL=='n'){
//Rprintf("FitQTL=N\n");
for (j=0; j<Nloci; j++){
for (i=0; i<Naug; i++)
Ploci[i]*= Pscale;
//Here we have ProbLeft
if ((position[j]=='L')||(position[j]=='U')){
for (i=0; i<Naug; i++){
calc_i= prob(loci,r,i,j,'1',crosstype,1,0,1);
//calc_ii= probnew(MendelM,loci,r,i,j,'1',crosstype,1,0,1);
Ploci[i]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
}
if ((position[j]=='L')||(position[j]=='M')){
for (i=0; i<Naug; i++){
calc_i = prob(loci,r,i,j,loci[j+1][i],'F',0,0,0);
//calc_ii = probnew(MendelM,loci,r,i,j,loci[j+1][i],'F',0,0,0);
Ploci[i]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
}
}
}else{
// Rprintf("FitQTL=Y\n");
for (j=0; j<Nloci; j++)
{ for (i=0; i<Naug; i++)
{ Ploci[i]*= Pscale; Ploci[i+Naug]*= Pscale; Ploci[i+2*Naug]*= Pscale;
// only for computational accuracy; see use of logP
}
if ((position[j]=='L')||(position[j]=='U'))
{
//Here we don't have any f2 dependancies anymore by using the prob function
if (cofactor[j]<='1')
for (i=0; i<Naug; i++)
{
calc_i= prob(loci,r,i,j,'1',crosstype,1,0,1);
//calc_ii= probnew(MendelM,loci,r,i,j,'1',crosstype,1,0,1);
Ploci[i]*= calc_i; Ploci[i+Naug]*= calc_i; Ploci[i+2*Naug]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
else
for (i=0; i<Naug; i++)
{
//startvalues for each new chromosome
Ploci[i]*= start_prob(crosstype,'0');
Ploci[i+Naug]*= start_prob(crosstype,'1');
Ploci[i+2*Naug] *= start_prob(crosstype,'2');
}
// QTL='0', '1' or'2'
}
if ((position[j]=='L')||(position[j]=='M'))
{ if ((cofactor[j]<='1')&&(cofactor[j+1]<='1'))
for (i=0; i<Naug; i++){
calc_i = prob(loci,r,i,j,loci[j+1][i],crosstype,0,0,0);
//calc_ii = probnew(MendelM,loci,r,i,j,loci[j+1][i],crosstype,0,0,0);
Ploci[i]*= calc_i; Ploci[i+Naug]*= calc_i; Ploci[i+2*Naug]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
else if (cofactor[j]<='1') // locus j+1 == QTL
for (i=0; i<Naug; i++)
{ // QTL=='0' What is the prob of finding an '0' at J=1
calc_i = prob(loci,r,i,j,'0',crosstype,1,0,0);
//calc_ii = probnew(MendelM,loci,r,i,j,'0',crosstype,1,0,0);
Ploci[i]*= calc_i;
// QTL=='1'
calc_i = prob(loci,r,i,j,'1',crosstype,1,0,0);
//calc_ii = probnew(MendelM,loci,r,i,j,'1',crosstype,1,0,0);
Ploci[i+Naug]*= calc_i;
// QTL=='2'
calc_i = prob(loci,r,i,j,'2',crosstype,1,0,0);
//calc_ii = probnew(MendelM,loci,r,i,j,'2',crosstype,1,0,0);
Ploci[i+2*Naug]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
else // locus j == QTL
for (i=0; i<Naug; i++)
{ // QTL=='0'
calc_i = prob(loci,r,i,j+1,'0',crosstype,1,-1,0);
//calc_ii = probnew(MendelM,loci,r,i,j+1,'0',crosstype,1,-1,0);
Ploci[i]*= calc_i;
// QTL=='1'
calc_i = prob(loci,r,i,j+1,'1',crosstype,1,-1,0);
//calc_ii = probnew(MendelM,loci,r,i,j+1,'1',crosstype,1,-1,0);
Ploci[i+Naug]*= calc_i;
// QTL=='2'
calc_i = prob(loci,r,i,j+1,'2',crosstype,1,-1,0);
//calc_ii = probnew(MendelM,loci,r,i,j+1,'2',crosstype,1,-1,0);
Ploci[i+2*Naug]*= calc_i;
//Rprintf("DEBUG: Prob vs ProbNew: %f %f\n",calc_i,calc_ii);
}
}
}
}
// Rprintf("INFO: Done fitting QTL's\n");
if ((*weight)[0]== -1.0)
{ for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (fitQTL=='n')
{ for (i=0; i<Naug; i++) indweight[ind[i]]+=Ploci[i];
for (i=0; i<Naug; i++) (*weight)[i]= Ploci[i]/indweight[ind[i]];
}
else
{ for (i=0; i<Naug; i++) indweight[ind[i]]+=Ploci[i]+Ploci[i+Naug]+Ploci[i+2*Naug];
for (i=0; i<Naug; i++)
{ (*weight)[i] = Ploci[i]/indweight[ind[i]];
(*weight)[i+Naug] = Ploci[i+Naug]/indweight[ind[i]];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]/indweight[ind[i]];
}
}
}
//Rprintf("Weights done\n");
//Rprintf("Individual->trait->cofactor->weight\n");
//for (int j=0; j<Nind; j++){
// Rprintf("%d->%f,%d,%f %f\n",j,y[j],cofactor[j],(*weight)[j],Ploci[j]);
//}
double logL=0;
vector indL;
indL= newvector(Nind);
while ((iem<em)&&(delta>1.0e-5))
{
iem+=1;
if (varknown=='n') *variance=-1.0;
//Rprintf("Checkpoint_b\n");
logL= regression(Nind, Nloci, cofactor, loci, y,
weight, ind, Naug, variance, Fy, biasadj,fitQTL,dominance);
logL=0.0;
//Rprintf("regression ready\n");
for (i=0; i<Nind; i++) indL[i]= 0.0;
if (fitQTL=='n') // no QTL fitted
for (i=0; i<Naug; i++)
{ (*weight)[i]= Ploci[i]*Fy[i];
indL[ind[i]]= indL[ind[i]] + (*weight)[i];
}
else // QTL moved along the chromosomes
for (i=0; i<Naug; i++)
{ (*weight)[i]= Ploci[i]*Fy[i];
(*weight)[i+Naug] = Ploci[i+Naug]* Fy[i+Naug];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]*Fy[i+2*Naug];
indL[ind[i]]+=(*weight)[i]+(*weight)[i+Naug]+(*weight)[i+2*Naug];
}
for (i=0; i<Nind; i++) logL+=log(indL[i])-logP;
for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (fitQTL=='n')
{ for (i=0; i<Naug; i++) indweight[ind[i]]+=(*weight)[i];
for (i=0; i<Naug; i++) (*weight)[i]/=indweight[ind[i]];
}
else
{ for (i=0; i<Naug; i++)
indweight[ind[i]]+=(*weight)[i]+(*weight)[i+Naug]+(*weight)[i+2*Naug];
for (i=0; i<Naug; i++)
{ (*weight)[i] /=indweight[ind[i]];
(*weight)[i+Naug] /=indweight[ind[i]];
(*weight)[i+2*Naug]/=indweight[ind[i]];
}
}
delta= absdouble(logL-oldlogL);
oldlogL= logL;
}
//Rprintf("EM Finished\n");
// bias adjustment after finished ML estimation via EM
if ((REMLorML=='0')&&(varknown=='n'))
{
// RRprintf("Checkpoint_c\n");
*variance=-1.0;
biasadj='y';
logL= regression(Nind, Nloci, cofactor, loci, y,
weight, ind, Naug, variance, Fy, biasadj,fitQTL,dominance);
logL=0.0;
for (int _i=0; _i<Nind; _i++) indL[_i]= 0.0;
if (fitQTL=='n')
for (i=0; i<Naug; i++)
{ (*weight)[i]= Ploci[i]*Fy[i];
indL[ind[i]]+=(*weight)[i];
}
else
for (i=0; i<Naug; i++)
{ (*weight)[i]= Ploci[i]*Fy[i];
(*weight)[i+Naug]= Ploci[i+Naug]*Fy[i+Naug];
(*weight)[i+2*Naug]= Ploci[i+2*Naug]*Fy[i+2*Naug];
indL[ind[i]]+=(*weight)[i];
indL[ind[i]]+=(*weight)[i+Naug];
indL[ind[i]]+=(*weight)[i+2*Naug];
}
for (i=0; i<Nind; i++) logL+=log(indL[i])-logP;
for (i=0; i<Nind; i++) indweight[i]= 0.0;
if (fitQTL=='n')
{ for (i=0; i<Naug; i++) indweight[ind[i]]+=(*weight)[i];
for (i=0; i<Naug; i++) (*weight)[i]/=indweight[ind[i]];
}
else
{ for (i=0; i<Naug; i++)
{ indweight[ind[i]]+=(*weight)[i];
indweight[ind[i]]+=(*weight)[i+Naug];
indweight[ind[i]]+=(*weight)[i+2*Naug];
}
for (i=0; i<Naug; i++)
{ (*weight)[i] /=indweight[ind[i]];
(*weight)[i+Naug] /=indweight[ind[i]];
(*weight)[i+2*Naug]/=indweight[ind[i]];
}
}
}
//for (i=0; i<Nind; i++){
// Rprintf("IND %d Ploci: %f Fy: %f UNLOG:%f LogL:%f LogL-LogP: %f\n",i,Ploci[i],Fy[i],indL[i],log(indL[i]),log(indL[i])-logP);
//}
Free(Fy);
Free(Ploci);
Free(indweight);
Free(indL);
return logL;
}
SEXP regression_Laplace(SEXP Rlocations, SEXP Robservations, SEXP Rmesh, SEXP Rorder, SEXP Rlambda,
SEXP Rcovariates, SEXP RBCIndices, SEXP RBCValues, SEXP DOF, SEXP RGCVmethod, SEXP Rnrealizations, SEXP RRNGstate, SEXP Rsolver, SEXP Rnprocessors, SEXP Rhosts)
{
//Set data
RegressionData regressionData(Rlocations, Robservations, Rorder, Rlambda, Rcovariates, RBCIndices, RBCValues, DOF, RGCVmethod, Rnrealizations, RRNGstate, Rsolver, Rnprocessors, Rhosts);
//std::cout<< "Data loaded"<<std::endl;
SEXP result = NILSXP;
if(regressionData.getOrder()==1)
{
MeshHandler<1> mesh(Rmesh);
//std::cout<< "Mesh loaded"<<std::endl;
MixedFERegression<RegressionData, IntegratorTriangleP2,1> regression(mesh,regressionData);
regression.smoothLaplace();
const std::vector<VectorXr>& solution = regression.getSolution();
const std::vector<Real>& dof = regression.getDOF();
const std::vector<Real>& var = regression.getVar();
//Copy result in R memory
result = PROTECT(Rf_allocVector(VECSXP, 4));
SET_VECTOR_ELT(result, 0, Rf_allocMatrix(REALSXP, solution[0].size(), solution.size()));
SET_VECTOR_ELT(result, 1, Rf_allocVector(REALSXP, solution.size()));
SET_VECTOR_ELT(result, 2, Rf_allocVector(REALSXP, solution.size()));
SET_VECTOR_ELT(result, 3, Rf_allocVector(STRSXP, 1));
Real *rans = REAL(VECTOR_ELT(result, 0));
for(UInt j = 0; j < solution.size(); j++)
{
for(UInt i = 0; i < solution[0].size(); i++)
rans[i + solution[0].size()*j] = solution[j][i];
}
Real *rans2 = REAL(VECTOR_ELT(result, 1));
for(UInt i = 0; i < solution.size(); i++)
{
rans2[i] = dof[i];
}
Real *rans3 = REAL(VECTOR_ELT(result, 2));
for(UInt i = 0; i < solution.size(); i++)
{
rans3[i] = var[i];
}
std::string RNGstate = regression.getFinalRNGstate();
SET_STRING_ELT(VECTOR_ELT(result, 3), 0, Rf_mkChar(RNGstate.c_str()));
UNPROTECT(1);
}
else if(regressionData.getOrder()==2)
{
MeshHandler<2> mesh(Rmesh);
//std::cout<< "Mesh loaded"<<std::endl;
MixedFERegression<RegressionData, IntegratorTriangleP4,2> regression(mesh,regressionData);
regression.smoothLaplace();
const std::vector<VectorXr>& solution = regression.getSolution();
const std::vector<Real>& dof = regression.getDOF();
const std::vector<Real>& var = regression.getVar();
//Copy result in R memory
result = PROTECT(Rf_allocVector(VECSXP, 4));
SET_VECTOR_ELT(result, 0, Rf_allocMatrix(REALSXP, solution[0].size(), solution.size()));
SET_VECTOR_ELT(result, 1, Rf_allocVector(REALSXP, solution.size()));
SET_VECTOR_ELT(result, 2, Rf_allocVector(REALSXP, solution.size()));
SET_VECTOR_ELT(result, 3, Rf_allocVector(STRSXP, 1));
Real *rans = REAL(VECTOR_ELT(result, 0));
for(UInt j = 0; j < solution.size(); j++)
{
for(UInt i = 0; i < solution[0].size(); i++)
rans[i + solution[0].size()*j] = solution[j][i];
}
Real *rans2 = REAL(VECTOR_ELT(result, 1));
for(UInt i = 0; i < solution.size(); i++)
{
rans2[i] = dof[i];
}
Real *rans3 = REAL(VECTOR_ELT(result, 2));
for(UInt i = 0; i < solution.size(); i++)
{
rans3[i] = var[i];
}
std::string RNGstate = regression.getFinalRNGstate();
SET_STRING_ELT(VECTOR_ELT(result, 3), 0, Rf_mkChar(RNGstate.c_str()));
UNPROTECT(1);
}
return(result);
}
void c_reg_r2(DCELL * result, DCELL * values, int n, const void *closure)
{
regression(result, values, n, REGRESSION_COEFF_DET);
}
void c_reg_c(DCELL * result, DCELL * values, int n, const void *closure)
{
regression(result, values, n, REGRESSION_OFFSET);
}
void c_reg_m(DCELL * result, DCELL * values, int n, const void *closure)
{
regression(result, values, n, REGRESSION_SLOPE);
}
SEXP regression_Laplace(SEXP Rlocations, SEXP Robservations, SEXP Rmesh, SEXP Rorder, SEXP Rlambda,
SEXP Rcovariates, SEXP RBCIndices, SEXP RBCValues, SEXP DOF)
{
//Set data
RegressionData regressionData(Rlocations, Robservations, Rorder, Rlambda, Rcovariates, RBCIndices, RBCValues, DOF);
//std::cout<< "Data loaded"<<std::endl;
SEXP result;
if(regressionData.getOrder()==1)
{
MeshHandler<1> mesh(Rmesh);
//std::cout<< "Mesh loaded"<<std::endl;
MixedFERegression<RegressionData, IntegratorTriangleP2,1> regression(mesh,regressionData);
regression.smoothLaplace();
const std::vector<VectorXr>& solution = regression.getSolution();
const std::vector<Real>& dof = regression.getDOF();
//Copy result in R memory
result = PROTECT(allocVector(VECSXP, 2));
SET_VECTOR_ELT(result, 0, allocMatrix(REALSXP, solution[0].size(), solution.size()));
SET_VECTOR_ELT(result, 1, allocVector(REALSXP, solution.size()));
Real *rans = REAL(VECTOR_ELT(result, 0));
for(int j = 0; j < solution.size(); j++)
{
for(int i = 0; i < solution[0].size(); i++)
rans[i + solution[0].size()*j] = solution[j][i];
}
Real *rans2 = REAL(VECTOR_ELT(result, 1));
for(int i = 0; i < solution.size(); i++)
{
rans2[i] = dof[i];
}
UNPROTECT(1);
}
else if(regressionData.getOrder()==2)
{
MeshHandler<2> mesh(Rmesh);
//std::cout<< "Mesh loaded"<<std::endl;
MixedFERegression<RegressionData, IntegratorTriangleP4,2> regression(mesh,regressionData);
regression.smoothLaplace();
const std::vector<VectorXr>& solution = regression.getSolution();
const std::vector<Real>& dof = regression.getDOF();
//Copy result in R memory
result = PROTECT(allocVector(VECSXP, 2));
SET_VECTOR_ELT(result, 0, allocMatrix(REALSXP, solution[0].size(), solution.size()));
SET_VECTOR_ELT(result, 1, allocVector(REALSXP, solution.size()));
Real *rans = REAL(VECTOR_ELT(result, 0));
for(int j = 0; j < solution.size(); j++)
{
for(int i = 0; i < solution[0].size(); i++)
rans[i + solution[0].size()*j] = solution[j][i];
}
Real *rans2 = REAL(VECTOR_ELT(result, 1));
for(int i = 0; i < solution.size(); i++)
{
rans2[i] = dof[i];
}
UNPROTECT(1);
}
return(result);
}
void main ()
{
int position,choix=-1,choix1=-1,choix1_2=-1,N,i=1; /*Déclaration des variables*/
float Xi[MAX],Yi[MAX],result[10];
float ProduitXiYi[MAX];
float carre_ecart_a_moyenne_Xi[MAX];
float carre_ecart_a_moyenne_Yi[MAX];
int j = 0;
while (j < 53)
{
Xi[j] = data[0].country_nb[j];
Yi[j] = data[8].country_nb[j];
j++;
}
/*Appel de la fonction d'affichage d'en-tête*/
entete();
/********/
/* MENU */
/********/
while(choix!=0)
{
titre("Menu Principale:");
printf("\nEntrez le num%cro de l\'op%cration d%csir%ce:\n",130,130,130,130);
printf("\n(1) Entrer o%c modifier les donn%ces (Xi et Yi).",151,130);
printf("\n(2) D%cterminer l\'%cquation de la droite",130,130);
printf("\n(3) Afficher le tableau des valeurs interm%cdiaires.",130);
printf("\n(4) Afficher les r%csultats.",130);
printf("\n(5) Sauvegadrer les donn%ces dans un fichier.",130);
printf("\n(0) Quitter le programme.");
printf("\n\n Quel est votre choix? :");
scanf("%d",&choix);
switch (choix)
{
case 1:
{ choix1=-1;choix1_2=-1;
while(choix1!=0)
{
titre("Menu Donnees:");
printf("\nEntrez le num%cro de l\'op%cration d%csir%ce:\n",130,130,130,130);
printf("\n(1) Entrer des nouvelles valeurs.");
printf("\n(2) Modiffier les valeurs existantes.");
printf("\n(3) Revenir au menu principale.");
printf("\n(0) Quitter le programme.");
printf("\n\n Quel est votre choix? :");
scanf("%d",&choix1);
switch (choix1)
{
case 1:
{
titre("Donnees:");/*Fonction d'affichage de titre*/
/*Appel de la fonction d'entrée du nombre d'élement*/
N=nbrelement();
i=1;
/*Entree des élements Xi*/
titre("Entree des valeurs de Xi:");/*Fonction d'affichage de titre*/
while (i<(N+1))
{
printf("Entrez la valeur de X%d: ",i);
scanf("%f",&Xi[i]);i++;
};
i=1;
/*Entree des élements Yi*/
titre("Entree des valeurs de Yi:");/*Fonction d'affichage de titre*/
while (i<(N+1))
{
printf("Entrez la valeur de Y%d: ",i);
scanf("%f",&Yi[i]);i++;
}
printf("\nTappez une touche pour revenir au menu pr%cc%cdant:",130,130);
getchar();
getchar();
printf("\n\n");
};break;
case 2:
{
choix1_2=-1;
while(choix1_2!=0)
{
titre("Menu Modiffication Donnees");
printf("\nEntrez le num%cro de l\'op%cration d%csir%ce:\n",130,130,130,130);
printf("\n(1) Modifier un %cl%cment des Xi.",130,130);
printf("\n(2) Modifier un %cl%cment des Yi.",130,130);
printf("\n(3) Revenir au menu pr%cc%cdant.",130,130);
printf("\n(4) Revenir au menu principale.");
printf("\n(0) Quitter le programme.");
printf("\n\n Quel est votre choix? :");
scanf("%d",&choix1_2);
switch (choix1_2)
{
case 1:
{
titre("Modiffication d'un element des Xi:");
printf("Entrez la position de l\'%cl%cment dans le tableau:",130,130);
scanf("%d",&position);
printf("\nEntrez la nouvelle valeur de X%d:",position);
scanf("%lf",&Xi[position]);
printf("\n Modification %cffectu%ce...\n",130,130);
};break;
case 2:
{
printf("\n\nEntrez la position de l\'%cl%cment dans le tableau:",130,130);
scanf("%d",&position);
printf("\nEntrez la nouvelle valeur de Y%d:",position);
scanf("%lf",&Yi[position]);
printf("\n Modification %cffectu%ce...\n",130,130);
};break;
case 3:choix1=-1;choix1_2=0;break;
case 4:choix1_2=0;choix1=0;choix=-1;break;
case 0:choix1=0;choix1_2=0;break;
default:;break;
}
}
};break;
case 3:choix=-1;choix1=0;break;
case 0:choix=0;choix1=0;break;
default:printf("\n Entr%ce non valide!");break;
}
}
};break;
case 2:
{
/*Appel de la fonction de regression linéaire*/
regression(Xi,Yi,N,result,ProduitXiYi,carre_ecart_a_moyenne_Xi,carre_ecart_a_moyenne_Yi);
printf("\nOp%Cration termin%ce...\n",130,130);
/*Affichage de l'éqation et de la corrélation "r"*/
aff_equation(result);
printf("\nCoefficient de corr%clation:=> r = %lf\n\n",130,result[9]);
printf("Tappez une touche pour revenir au menu pr%cc%cdant:",130,130);
getchar();
getchar();
printf("\n\n");
};break;
case 3:
{
/*Affichage du tableau des resultats*/
affich_tab(result,Xi,Yi,ProduitXiYi,carre_ecart_a_moyenne_Xi,carre_ecart_a_moyenne_Yi,N);
printf("\nTappez une touche pour revenir au menu pr%cc%cdant:",130,130);
getchar();
getchar();
printf("\n\n");
};break;
case 4:
{
/*Affichage des résultats*/
affichage(result);
printf("\nTappez une touche pour revenir au menu pr%cc%cdant:",130,130);
getchar();
};break;
case 5:
{
fichier(result,Xi,Yi,ProduitXiYi,carre_ecart_a_moyenne_Xi,carre_ecart_a_moyenne_Yi,N);
printf("\nTappez une touche pour revenir au menu pr%cc%cdant:",130,130);
getchar();
}
case 0:;break;
default:printf("\nEntree non valide!\n");break;
};
}
getchar();
}
