adaboost<-function (formula, ech.appt, ech.test, mfinal=50, prof=3) 
{
    # Version élémentaire d'adaboost réel adaptée pour la prévision 
    # d'une variable binomiale par agrégation d'arbres binaires.
    #  
    # La fonction estime l'arbre sur ech.appt 
    # et prévoit ech.test en retournant un vecteur de {-1, 1}^n.
    # Les données sont dans des data frames. La variable reponse est un facteur.
    # 
    # mfinal   : nombre max d'arbres
    # maxdepth : profondeur max de l'arbre
    # Le programme considère connaitre la réponse de l'échantillon test. Pour observer le 
    # comportement de l'algorithme. En situation opérationnelle, ce n'est pas le cas. 
        ## tailles des échantillons
        nappt    <- dim(ech.appt)[1]         
        ntest    <- dim(ech.test)[1]
        ## Initialisations
        w       <<- rep(1/nappt,nappt)
        pappt   <- rep(0,nappt)
        ptest   <- rep(0,ntest)             
        fappt   <- rep(0,nappt)
        ftest   <- rep(0,ntest)       
        sappt   <- matrix(0, nappt, mfinal)
        stest   <- matrix(0, ntest, mfinal)
        ## variable reponse transformee en -1 1
        yappt=2*as.numeric(model.frame(formula=formula,data=ech.appt)[,1])-3
	ytest=2*as.numeric(model.frame(formula=formula,data=ech.test)[,1])-3
        cat("m"," Ajustement ","*"," Test ","\n")
        ## Iterations
        for (m in 1:mfinal)
          {            
            cat(m,"   ")
            ## paramètres de  rpart
            cntrl  <- rpart.control(maxdepth=prof, maxcompete=0,
                                    maxsurrogate=0, cp=0, xval=0)
            ## ajustement de l'arbre
            estim    <- rpart(formula=formula, data= ech.appt, weights = w, control = cntrl)
            pappt <- predict(estim,type="prob")[,2]
            ## pour que les log soient tjs definis
            pappt[pappt<.00001]=.00001         
            pappt[pappt>.99999]=.99999
            ptest <- predict(estim, newdata = ech.test,type="prob")[,2]
            ptest[ptest<.00001]=.00001
            ptest[ptest>.99999]=.99999
            fappt=log(pappt/(1-pappt))/2
            ftest=log(ptest/(1-ptest))/2
            ## Mises à jour des poids
            w<<-w*exp(-yappt*fappt)
            w<<-w/sum(w)
            ## stockage des resultats
            sappt[,m] <- fappt
            stest[,m] <- ftest
            ## calculer l'erreur d'ajustement
            rappt=sign(apply(sappt,1,sum))
	    rtest=sign(apply(stest,1,sum))
            err.ajust=(sum(rep(1,nappt)[yappt != rappt])/nappt)*100 
	    err.test=(sum(rep(1,ntest)[ytest != rtest])/ntest)*100 
            cat(err.ajust,"  *  ",err.test,"\n")
          }
        ## Sortie des prévisions de l'echantillon validation ou test
        sign(apply(stest,1,sum))
}