/* ============================= */
void projX (double **tabX, double **projsurX){
int nlX,ncX,i,j;
double **provi1, **provi2, **provi3;
nlX=tabX[0][0];
ncX=tabX[1][0];
taballoc(&provi1,ncX,ncX);
prodmatAtAB (tabX, provi1); /* provi1=XtX */
taballoc(&provi2,ncX,ncX);
dinvG(provi1,provi2); /* provi2=(XtX)-1 */
freetab(provi1);
/*taballoc(&provi1,nlX,ncX);
prodmatABC(tabX,provi2,provi1); provi1=X(XtX)-1
*/
taballoc(&provi3,ncX,nlX);
for (i=1; i<=nlX;i++){
for (j=1; j<=ncX;j++){
provi3[j][i]=tabX[i][j]; /* provi3=Xt */
}
}
prodmatABC(provi2,provi3,projsurX); /* projsurX=(XtX)-1Xt */
freetab(provi2);
freetab(provi3);
}
/*DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
$ WORK, LWORK, INFO ) */
void dinvG(double **X, double **X_inv)
{
int i,j, k, l,error,size,lwork;
size=X[1][0];
double *A = (double *)calloc((size_t)size*size, sizeof(double));/*doubleArray(size*size);*/
double *D = (double *)calloc((size_t)size, sizeof(double));/*doubleArray(size*1);*/
double *U = (double *)calloc((size_t)size*size, sizeof(double));
double *V = NULL,work1,*work;
double **XU, **XUred;
const char jobu='A',jobvt='N';
taballoc(&XU,size,size);
lwork=-1;
for (i = 0, j = 1; j <= size; j++) {
for (k = 1; k <= size; k++) {
A[i] = X[k][j];
i++;
}
}
F77_CALL(dgesvd)(&jobu, &jobvt,&size, &size,A, &size, D,U,&size,V,&size,&work1, &lwork,&error);
lwork=(int)floor(work1);
if (work1-lwork>0.5) lwork++;
work=(double *)calloc((size_t)lwork,sizeof(double));
/* actual call */
F77_NAME(dgesvd)(&jobu, &jobvt,&size, &size,A, &size, D,U,&size,V,&size,work, &lwork,&error);
free(work);
if (error) {
Rprintf("error in svd: %d\n", error);
}
i = 0;
l=0;
for ( j = 1; j <= size; j++) {
for (k = 1; k <= size; k++) {
XU[k][j] = U[i];
i++;
}
if (D[j-1]>0.00000000001) l=l+1;
}
taballoc(&XUred,size,l);
for (i=1;i<=size;i++) {
for (k=1;k<=l;k++) {
XUred[i][k]=pow(D[k-1],-0.5)*XU[i][k];
}
}
prodmatAAtB (XUred, X_inv);
freetab(XUred);
free(A);
free(D);
free(U);
freetab(XU);
}
double traceXtdLXq (double **X, double **L, double *d, double *q)
/* Produit matriciel XtDLXQ avec LX comme lag.matrix */
{
/* Declarations de variables C locales */
int j, i, lig, col;
double **auxi, **A, trace;
/* Allocation memoire pour les variables C locales */
lig = X[0][0];
col = X[1][0];
taballoc(&auxi, lig, col);
taballoc(&A, col, col);
/* Calcul de LX */
prodmatABC(L, X, auxi);
/* Calcul de DLX */
for (i=1;i<=lig;i++) {
for (j=1;j<=col;j++) {
auxi[i][j] = auxi[i][j] * d[i];
}
}
/* Calcul de XtDLX */
prodmatAtBC(X,auxi,A);
/* Calcul de trace(XtDLXQ) */
trace=0;
for (i=1;i<=col;i++) {
trace = trace + A[i][i] * q[i];
}
/* Libération des réservations locales */
freetab (auxi);
freetab (A);
return(trace);
}
double testFreducedmodel(double **predX, double **projectX, double **projectXZ, double **tabres, double **tabXZ, double Fobs, int q, int n, int p, int nperm){
int i,j,k,nrowY,ncolY,NGT=0, ncolX, ncolXZ;
double **Yperm,R2X=0,R2XZ, Fi,**tabpredX,**tabpredXZ, **proviX, **proviXZ, **tabX;
nrowY=predX[0][0];
ncolY=predX[1][0];
ncolXZ=tabXZ[1][0];
ncolX=ncolXZ-1;
taballoc(&Yperm,nrowY,ncolY);
taballoc(&tabpredXZ,nrowY,ncolY);
taballoc(&proviXZ,ncolXZ,ncolY);
if(ncolX>0){
taballoc(&tabpredX,nrowY,ncolY);
taballoc(&proviX,ncolX,ncolY);
taballoc(&tabX,nrowY, ncolX);
for (i=1;i<=nrowY;i++){
for (j=1;j<=ncolX;j++){
tabX[i][j]=tabXZ[i][j];
}
}
}
for (i=1;i<=nperm;i++){
aleapermutmat (tabres);
for (k=1;k<=nrowY;k++){
for (j=1;j<=ncolY;j++){
Yperm[k][j]=predX[k][j]+tabres[k][j];
}
}
prodmatABC(projectXZ,Yperm,proviXZ);
prodmatABC(tabXZ,proviXZ,tabpredXZ);
if(ncolX>0){
prodmatABC(projectX,Yperm,proviX);
prodmatABC(tabX,proviX,tabpredX);
}
if(ncolX>0){
R2X=calcR2(Yperm,tabpredX);
}
R2XZ=calcR2(Yperm,tabpredXZ);
Fi=calcF(R2X,R2XZ,q,n,p);
if (Fi>=Fobs) NGT=NGT+1;
}
freetab(Yperm);
freetab(tabpredXZ);
freetab(proviXZ);
if(ncolX>0){
freetab(tabpredX);
freetab(tabX);
freetab(proviX);
}
return(((double)NGT+1)/((double)nperm+1));
}
char*
atom(char *str)
{
uint h;
Stringtab *tab;
h = hash(str) % nelem(stab);
for(tab=stab[h]; tab; tab=tab->link)
if(strcmp(str, tab->str) == 0)
return tab->str;
tab = taballoc();
tab->str = xstrdup(str);
tab->link = stab[h];
stab[h] = tab;
return tab->str;
}
void repClass(int *ioptsm1,
int *ngr1,
int *nbech1,
int *nlig1,
int *nclatot1,
int *maxnlim1,
int *pb,
int *ncla,
int *tablim1,
double *hp,
int *nech,
double *tabh1)
{
int i, j, k, ilig, numpic, nclasspic, numclasspic, iech;
int ioptsm, ngr, nbech, nlig, nclatot, maxnlim;
double xinf, xsup, maxpic, x;
double **tablim;
double **tabh;
/*
/ recover arguments
*/
ioptsm = *ioptsm1;
ngr = *ngr1;
nbech = *nbech1;
nlig = *nlig1;
nclatot = *nclatot1;
maxnlim = *maxnlim1;
/*
/ declare and allocate memory for two dimensional tables
*/
taballoc(&tablim, maxnlim+1, ngr);
taballoc(&tabh, nbech, nclatot);
/*
/ recover the table of class limits
*/
k=0;
for (i=1; i<=maxnlim+1; i++) {
for (j=1; j<=ngr; j++) {
tablim[i][j] = (double) tablim1[k];
k=k+1;
}
}
if (ioptsm == 1) {
/*
/ compute the sum of peaks within each class
*/
numpic = 0;
for (ilig=1; ilig<=nlig; ilig++) {
nclasspic = 0;
numpic = numpic + 1;
x = (double) pb[numpic-1];
for (i=1; i<=ngr; i++) {
for (j=2; j<=ncla[i-1]+1; j++) {
xinf = (double) tablim[j-1][i];
xsup = (double) tablim[j][i];
if ((xinf <= x ) && (x < xsup)) {
numclasspic = nclasspic + j - 1;
tabh[(int) nech[ilig-1] ][numclasspic] = tabh[(int) nech[ilig-1] ][numclasspic] + hp[ilig-1];
goto suite;
}
}
nclasspic = nclasspic + ncla[i-1];
}
suite:;
}
} else {
/*
/ compute the max of peaks within each class
*/
for (iech=1; iech<=nbech; iech++) {
numpic = 0;
maxpic = 0;
for (ilig=1; ilig<=nlig; ilig++) {
numpic = numpic + 1;
if (nech[ilig-1] == iech) {
x = (double) pb[numpic-1];
nclasspic = 0;
for (i=1; i<=ngr; i++) {
for (j=2; j<=ncla[i-1]+1; j++) {
numclasspic = nclasspic + j - 1;
xinf = (double) tablim[j-1][i];
xsup = (double) tablim[j][i];
if ((xinf <= x ) && (x < xsup)) {
if (tabh[iech][numclasspic] < hp[ilig-1]) {
tabh[iech][numclasspic] = hp[ilig-1];
}
}
}
nclasspic = nclasspic + ncla[i-1];
}
}
}
}
}
/*
/ set up output table
*/
k=0;
for (i=1; i<=nbech; i++) {
for (j=1; j<=nclatot; j++) {
tabh1[k] = tabh[i][j];
k=k+1;
}
}
/*
/ free declared memory
*/
freetab (tablim);
freetab (tabh);
}
void gearymoran (int *param, double *data, double *bilis,
double *obs, double *result, double *obstot, double *restot)
{
/* Declarations des variables C locales */
int nobs, nvar, nrepet, i, j, k, krepet, kvar ;
int *numero;
double provi;
double *poili;
double **mat, **tab, **tabperm;
/* Allocation memoire pour les variables C locales */
nobs = param[0];
nvar = param [1];
nrepet = param [2];
vecalloc(&poili,nobs);
taballoc(&mat,nobs,nobs);
taballoc(&tab,nobs,nvar);
taballoc(&tabperm,nobs,nvar);
vecintalloc (&numero, nobs);
/* Définitions des variables C locales */
k = 0;
for (i=1; i<=nvar; i++) {
for (j=1; j<=nobs; j++) {
tab[j][i] = data[k] ;
k = k+1 ;
}
}
k = 0;
provi = 0;
for (j=1; j<=nobs; j++) {
for (i=1; i<=nobs; i++) {
mat[i][j] = bilis[k] ;
provi = provi + bilis[k];
k = k+1 ;
}
}
for (j=1; j<=nobs; j++) {
for (i=1; i<=nobs; i++) {
mat[i][j] = mat[i][j]/provi ;
}
}
/* mat contient une distribution de fréquence bivariée */
for (j=1; j<=nobs; j++) {
provi = 0;
for (i=1; i<=nobs; i++) {
provi = provi + mat[i][j] ;
}
poili[j] = provi;
}
/* poili contient la distribution marginale
le test sera du type xtPx avec x centré normé pour la pondération
marginale et A = QtFQ soit la matrice des pij-pi.p.j */
matmodifcn(tab,poili);
/* le tableau est normalisé pour la pondération marginale de la forme*/
for (j=1; j<=nobs; j++) {
for (i=1; i<=nobs; i++) {
mat[i][j] = mat[i][j] -poili[i]*poili[j] ;
}
}
for (kvar=1; kvar<=nvar; kvar++) {
provi = 0;
for (j=1; j<=nobs; j++) {
for (i=1; i<=nobs; i++) {
provi = provi + tab[i][kvar]*tab[j][kvar]*mat[i][j] ;
}
}
obs[kvar-1] = provi;
}
k=0;
/* les résultats se suivent par simulation */
for (krepet=1; krepet<=nrepet; krepet++) {
getpermutation (numero, krepet);
matpermut (tab, numero, tabperm);
matmodifcn (tabperm,poili);
for (kvar=1; kvar<=nvar; kvar++) {
provi = 0;
for (j=1; j<=nobs; j++) {
for (i=1; i<=nobs; i++) {
provi = provi + tabperm[i][kvar]*tabperm[j][kvar]*mat[i][j] ;
}
}
result[k] = provi;
k = k+1;
}
}
/* libération mémoire locale */
freevec(poili);
freetab(mat);
freeintvec(numero);
freetab(tab);
freetab(tabperm);
}
void VarianceDecompInOrthoBasis (int *param, double *z, double *matvp,
double *phylogram, double *phylo95,double *sig025, double *sig975,
double *R2Max, double *SkR2k, double*Dmax, double *SCE, double *ratio)
{
/* param contient 4 entiers : nobs le nombre de points, npro le nombre de vecteurs
nrepet le nombre de permutations, posinega la nombre de vecteurs de la classe posi
qui est nul si cette notion n'existe pas. Exemple : la base Bscores d'une phylogénie a posinega = 0
mais la base Ascores a posinega à prendre dans Adim
z est un vecteur à nobs composantes de norme 1
pour la pondération uniforme. matvp est une matrice nobsxnpro contenant en
colonnes des vecteurs orthonormés pour la pondération uniforme. En géné
La procédure placera
dans phylogram les R2 de la décomposition de z dans la base matvp
dans phylo95 les quantiles 0.95 des R2
dans sig025 les quantiles 0.025 des R2 cumulés
dans sig975 les quantiles 0.975 des R2 cumulés
Ecrit à l'origine pour les phylogénies
peut servir pour une base de vecteurs propres de voisinage */
/* Declarations des variables C locales */
int nobs, npro, nrepet, i, j, k, n1, n2, n3, n4;
int irepet, posinega, *numero, *vecrepet;
double **vecpro, *zperm, *znorm;
double *locphylogram, *modelnul;
double a1, provi, **simul, *copivec, *copicol;
/* Allocation memoire pour les variables C locales */
nobs = param[0];
npro = param [1];
nrepet = param [2];
posinega = param[3];
vecalloc (&znorm, nobs);
vecalloc (&zperm, nobs);
vecalloc (&copivec, npro);
vecalloc (&copicol, nrepet);
taballoc (&vecpro, nobs, npro);
taballoc (&simul, nrepet, npro);
vecalloc (&locphylogram, npro);
vecalloc (&modelnul, npro);
vecintalloc (&numero, nobs);
vecintalloc (&vecrepet, nrepet);
/* Définitions des variables C locales */
for (i = 1 ; i<= nobs; i++) znorm[i] = z[i-1];
for (i = 1 ; i<= npro; i++) modelnul[i] = (double) i/ (double) npro;
k = 0;
for (j=1; j<=npro; j++) {
for (i=1; i<=nobs; i++) {
vecpro[i][j] = matvp[k] ;
k = k+1 ;
}
}
/* calcul du phylogramme observé */
for (j = 1; j<= npro; j++) {
provi = 0;
for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*znorm[i];
provi = provi*provi/nobs/nobs;
locphylogram[j] = provi;
}
for (i =1 ; i<= npro ; i++) phylogram[i-1] = locphylogram[i];
/* calcul des simulations
Chaque ligne de simul est un phylogramme après permutation des données */
for (irepet=1; irepet<=nrepet; irepet++) {
getpermutation (numero, irepet);
vecpermut (znorm, numero, zperm);
provi = 0;
for (j = 1; j<= npro; j++) {
provi = 0;
for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*zperm[i];
provi = provi*provi/nobs/nobs;
simul[irepet][j] = provi;
}
}
/* calcul du test sur le max du phylogramme */
for (irepet=1; irepet<=nrepet; irepet++) {
for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
R2Max[irepet] = maxvec(copivec);
provi=0;
for (j=1; j<=npro; j++) provi = provi + j*simul[irepet][j];
SkR2k[irepet] =provi;
if (posinega>0) {
provi=0;
for (j=1; j<posinega; j++) provi = provi + simul[irepet][j];
ratio[irepet] = provi;
}
}
R2Max[0] = maxvec(locphylogram);
provi=0;
for (j=1; j<=npro; j++) provi = provi + j*locphylogram[j];
SkR2k[0] =provi;
if (posinega>0) {
provi=0;
for (j=1; j<posinega; j++) provi = provi + locphylogram[j];
ratio[0] = provi;
}
/* quantiles 95 du sup */
n1 = (int) floor (nrepet*0.95);
n2 = (int) ceil (nrepet*0.95);
for (i =1; i<=npro; i++) {
for (irepet = 1; irepet<= nrepet; irepet++) {
copicol[irepet] = simul [irepet][i];
}
trirap (copicol, vecrepet);
phylo95[i-1] = 0.5*(copicol[n1]+copicol[n2]);
}
for (irepet=1; irepet<=nrepet; irepet++) {
provi = 0;
for (j=1; j<=npro; j++) {
provi = provi + simul[irepet][j];
copivec[j] = provi;
}
for (j=1; j<=npro; j++) simul[irepet][j] = copivec[j];
}
n1 = (int) floor (nrepet*0.025);
n2 = (int) ceil (nrepet*0.025);
n3 = (int) floor (nrepet*0.975);
n4 = (int) ceil (nrepet*0.975);
/* quantiles 2.5 du cumul */
for (i =1; i<=npro; i++) {
for (irepet = 1; irepet<= nrepet; irepet++) {
copicol[irepet] = simul [irepet][i];
}
trirap (copicol, vecrepet);
sig025[i-1] = 0.5*(copicol[n1]+copicol[n2]);
sig975[i-1] = 0.5*(copicol[n3]+copicol[n4]);
}
provi = 0;
for (j=1; j<=npro; j++) {
a1 = modelnul[j];
provi = provi + locphylogram[j];
locphylogram[j] = provi-a1;
for (irepet = 1; irepet<= nrepet; irepet++) {
simul [irepet][j] = simul [irepet][j]-a1;
}
}
/* simul contient maintenant les cumulés simulés en écarts */
/* locphylogram contient maintenant les cumulés observés en écart*/
/* Dmax */
for (j=1; j<=npro; j++) {
for (irepet=1; irepet<=nrepet; irepet++) {
for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
Dmax[irepet] = maxvec(copivec);
provi=0;
for (j=1; j<=npro; j++) provi = provi + copivec[j]* copivec[j];
SCE[irepet] =provi;
}
}
Dmax[0] = maxvec (locphylogram);
provi=0;
for (j=1; j<=npro; j++) provi = provi +locphylogram[j]*locphylogram[j];
SCE[0] =provi;
/* retour */
freevec (znorm);
freevec (modelnul);
freevec(copivec);
freevec(copicol);
freevec (zperm);
freetab (vecpro);
freetab (simul);
freevec (locphylogram);
freeintvec (numero);
freeintvec (vecrepet);
}
void testglobal(double *eigenvec, double *eigenval, int *nlig, int *ncol, double *xR, int *nsim, double *sim){
int k,nl,nc,i,j;
double **Evec,*x,*xperm,*cor,*Eval;
/* 1 I : somme (lambda)*R2 */
/* 2 I+ : somme (lambda posi)*R2 */
/* 3 I- : somme (lambda nega)*R2 */
nl=*nlig;
nc=*ncol;
taballoc(&Evec,nl,nc);
vecalloc(&Eval,nc);
vecalloc(&cor,nc);
vecalloc(&x,nl);
vecalloc(&xperm,nl);
k = 0;
for (i=1; i<=nl; i++) {
for (j=1; j<=nc; j++) {
Evec[i][j] = eigenvec[k];
k = k + 1;
}
}
for (i=1; i<=nl; i++) {
x[i]=xR[i-1];
xperm[i]=x[i];
}
for (i=1; i<=nc; i++) {
Eval[i]=eigenval[i-1];
}
prodatBc(x, Evec,cor);
for(i=1;i<=nc;i++){
sim[0]=sim[0]+Eval[i]*cor[i]*cor[i];
if(Eval[i]>0.0){
sim[1]=sim[1]+Eval[i]*cor[i]*cor[i];
}
if(Eval[i]<0.0){
sim[2]=sim[2]+Eval[i]*cor[i]*cor[i];
}
}
for (i=1;i<=*nsim;i++){
aleapermutvec (xperm);
prodatBc(xperm, Evec,cor);
for(k=1;k<=nc;k++){
sim[3*i]=sim[3*i]+Eval[k]*cor[k]*cor[k];
if(Eval[k]>0.0){
sim[3*i+1]=sim[3*i+1]+Eval[k]*cor[k]*cor[k];
}
if(Eval[k]<0.0){
sim[3*i+2]=sim[3*i+2]+Eval[k]*cor[k]*cor[k];
}
}
}
freevec(Eval);
freetab(Evec);
freevec(cor);
freevec(x);
freevec(xperm);
}
void forwardsel (double *tabXR, double *tabYR, int *nrowXR, int *ncolXR, int *ncolYR, double *pvalue, int *ordre,
double *Fvalue, int *nperm, double *R2cum, double *adjR2cum, int *K, double *R2seuil, double *adjR2seuil, double *R2more, int *nbcovar, double *alpha, int *verbose){
/* CANOCO 4.5 p. 49 */
/* nouvelle version 01/11/2004 */
/* on ne stocke plus le projecteur au complet (qui est n x n)
ce qui permet d'economiser de la RAM quand n est grand
modifie aussi testFreducedmodel */
int i,j,k,l,nrowX,ncolX, ncolY, *vecrest, *vecsel, R2maxj=0;
double **tabX, **tabY, **tabres, **tabpred1, **tabpred2, **tabXnew, R2max=0, adjR2max=0,R2j, R2X, R2XZ, Fobs,**projectX,**projectXZ, **provi;
nrowX=*nrowXR;
ncolX=*ncolXR;
ncolY=*ncolYR;
taballoc (&tabX, nrowX, ncolX);
taballoc (&tabY, nrowX, ncolY);
taballoc (&tabres, nrowX, ncolY);
taballoc (&tabpred1, nrowX, ncolY);
taballoc (&tabpred2, nrowX, ncolY);
vecintalloc(&vecrest,ncolX);
vecintalloc(&vecsel,ncolX);
taballoc (&projectX, 1,nrowX);
/* Passage des objets R en C */
k = 0;
for (i=1; i<=nrowX; i++) {
for (j=1; j<=ncolX; j++) {
tabX[i][j] = tabXR[k];
k = k + 1;
}
}
k = 0;
for (i=1; i<=nrowX; i++) {
for (j=1; j<=ncolY; j++) {
tabY[i][j] = tabYR[k];
k = k + 1;
tabpred1[i][j]=0;
}
}
for (i=1; i<=ncolX; i++) vecrest[i]=i;
R2X=0;
for (i=1; i<=ncolX; i++){
if ((R2max>*R2seuil) || (i>*K) || (i>(nrowX-1)) || (adjR2max>*adjR2seuil)) {
if ((i>*K) )
Rprintf("Procedure stopped (K criteria)\n");
if ((i>(nrowX-1)))
Rprintf("Procedure stopped: number of variables included equals number of rows minus one. All is explained ! Redo your analysis with other parameters.\n");
break;
}
if(*verbose == 1){
Rprintf("Testing variable %d\n",i);
}
R2max=0;
adjR2max=0;
R2maxj=0;
taballoc(&tabXnew, nrowX, i);
taballoc(&projectXZ, i, nrowX);
taballoc(&provi,i,ncolY);
for (j=1; j<=ncolX; j++){
if (vecrest[j]>0){ /* Selection de la variable j base sur le R2 */
vecsel[i]=j;
constnewX(tabX,tabXnew,vecsel);
projX(tabXnew,projectXZ);
prodmatABC(projectXZ,tabY,provi);
prodmatABC(tabXnew,provi,tabpred2);
R2j=calcR2(tabY,tabpred2);
if (R2j>R2max) {
R2max=R2j;
adjR2max=calcR2adj(R2max,nrowX,i);
R2maxj=j;
}
}
} /* for (j=1; j<=ncolX; j++) */
/* test de la variable j selectionne */
if ((i>1) && (fabs(R2max-R2cum[i-2])<*R2more)){
Rprintf("Procedure stopped (R2more criteria): variable %d explains only %f of the variance.\n",i,(fabs(R2max-R2cum[i-2])));
freetab(tabXnew);
break;
}
if ((R2max>*R2seuil)){
Rprintf("Procedure stopped (R2thresh criteria) R2cum = %f with %d variables (> %f)\n", R2max, i, *R2seuil);
break;
}
if ((adjR2max>*adjR2seuil)){
Rprintf("Procedure stopped (adjR2thresh criteria) adjR2cum = %f with %d variables (> %f)\n", adjR2max, i, *adjR2seuil);
break;
}
vecsel[i]=R2maxj;
R2cum[i-1]=R2max;
adjR2cum[i-1]=adjR2max;
ordre[i-1]=vecsel[i];
vecrest[R2maxj]=0;
constnewX(tabX,tabXnew,vecsel);
projX(tabXnew,projectXZ);
prodmatABC(projectXZ,tabY,provi);
prodmatABC(tabXnew,provi,tabpred2);
for (k=1;k<=nrowX;k++){
for (l=1;l<=ncolY;l++){
tabres[k][l]=tabY[k][l]-tabpred1[k][l];
}
}
R2XZ=R2max;
Fobs=calcF(R2X,R2XZ,1,nrowX,i+(*nbcovar));
Fvalue[i-1]=Fobs;
pvalue[i-1]=testFreducedmodel(tabpred1,projectX,projectXZ,tabres, tabXnew, Fobs,1,nrowX,i+(*nbcovar),*nperm);
for (k=1;k<=nrowX;k++){
for (l=1;l<=ncolY;l++){
tabpred1[k][l]=tabpred2[k][l];/* mettre dans pred1 les predictions du nouvo model */
}
}
freetab(projectX);
taballoc(&projectX, i, nrowX);
for (k=1;k<=i;k++){
for (l=1;l<=nrowX;l++){
projectX[k][l]=projectXZ[k][l];
}
}
R2X=R2XZ;
freetab(tabXnew);
freetab(projectXZ);
freetab(provi);
if ((pvalue[i-1]>*alpha)) {
Rprintf("Procedure stopped (alpha criteria): pvalue for variable %d is %f (> %f)\n",i,pvalue[i-1],*alpha);
ordre[i-1]=0;
break;
}
}/* for (i=1; i<=ncolX; i++) */
freetab(projectX);
freeintvec(vecsel);
freeintvec(vecrest);
freetab(tabX);
freetab(tabY);
freetab(tabres);
freetab(tabpred1);
freetab(tabpred2);
}
