Valid XHTML     Valid CSS2    

 

Programmer en R

Session de formation, décembre 2013

gilles.hunault "at" univ-angers.fr

                    

 

Solutions pour la séance numéro 2 (énoncés)

  1. Il y a trois types de boucles : la boucle pour (for), la boucle tant_que (while) et la boucle répéter_jusquà (repeat). break permet de quitter une boucle, c'est-à-dire d'aller à l'instruction qui suit la fin de boucle.

    La boucle POUR est une boucle générale d'itération pour une suite de valeurs (vecteur, liste, matrice...). C'est donc plus une boucle POUR_CHAQUE qu'une simple boucle POUR classique. La syntaxe est for (ELEMENT in SEQUENCE) {...} avec comme cas particulier 1:n pour SEQUENCE. La boucle TANT_QUE requiert une condition à tester. Si le résultat est vrai, on repasse dans le corps de boucle qui est délimité par les accolades. La syntaxe est while ( CONDITION ) { ... }. La boucle REPETER_JUSQUA exécute le corps de boucle jusqu'à que ce break soit rencontré. La syntaxe est repeat { ... }.

    Une boucle POUR utilise en général un nombre fixe de valeurs, parfois paramétré comme dans for (ind in 1:n). La valeur de la séquence est utilisée une fois pour toutes ; ainsi n<-3 ; for (i in 1:n) { print(i) ; n<-5} n'affichera que trois valeurs et en sortie de boucle, i vaudra 3. Une boucle REPETER est toujours exécutée au moins une fois et peut servir à implémenter un interpréteur de commandes. La boucle TANT_QUE peut ne pas exécuter de code si la condition est fausse dès le départ. Il est possible de forcer la machine à recommencer à exécuter le corps de boucle à partir du début à l'aide de next. L'instruction break quitte la boucle la plus interne en cas de boucles imbriquées.

    Il ne faut pas écrire 1:n-1 mais 1:(n-1) ou (1:n) - 1 suivant ce que l'on veut obtenir à cause de la priorité de l'opérateur :. D'ailleurs, il est conseillé de mettre des parenthèses dès que cela se complique. Ainsi a/b/c n'est pas lisible, même si cela un sens (et une valeur). Pour retrouver l'aide sur le symbole :, il faut utiliser help(`:`) avec le symbole "antiquote" obtenu avec AltGr+è sur un clavier français ou plus simplement avec help(":").

    1:length(v) est dangereux car si length(v) vaut 0, R exécutera une boucle en décroissant de 1 à 0. A la limite, on pourrait écrire 1:max(1,length(v)) mais seq(v) est plus concis. Donc il faut préferer for (elt in struct) si on n'a pas besoin des indices de boucle ou for (ind in seq(stru)) si on doit utiliser les indices.

    Voici quelques exemples de boucles pour vérifier tout cela :

    
         # boucle POUR sur vecteur explicite     
              
         cat("vecteur :\n")     
         vect <- c(1,8,3)     
         for (elt in vect) { print(elt) }     
              
         # boucle POUR sur séquence de 1 à n     
              
         cat("séquence :\n")     
         pdv <- 1:4 # plage de valeurs     
         for (ind in pdv) { print(ind) }     
              
         # boucle POUR sur liste     
              
         cat("liste :\n")     
         maListe <- list(a=1,b=c(2,3),c=4,d=NA,e="FIN")     
         for (li in maListe) { print(li) }     
              
         # boucle POUR sur matrice     
              
         cat("matrice :\n")     
         mdata <- outer(1:2,3:5) # vous connaissez outer ?     
         print(mdata)     
         for (elt in mdata) { print(elt) }     
              
         # boucle POUR et NEXT     
              
         somme <- 0     
         for (ind in 1:100) {     
           somme <- somme + 1/ind     
           if (ind==6) { cat("...\n") }     
           if ( (ind>5) & (ind<95)) { next }     
           cat(sprintf("%03d",ind),sprintf("%10.6f",somme),"\n")     
         } # fin pour     
              
         # boucle TANT_QUE     
              
         nb <- 1     
         while (nb*nb<200) { nb <- nb + 1 }     
         cat(" le premier entier dont le carré dépasse 200 est ",nb,"\n")     
              
         # boucles imbriquées et BREAK     
              
         cat("table des puissances inférieures à 1 million\n")     
         indi <- 1     
         while (indi<10) {     
           indj <- 1     
           while (indj<10) {     
             puiss <- indi**indj     
             if (puiss<=10**6) {     
                cat(sprintf("%9d",puiss))     
             } else {     
               break     
             } # fin si     
             indj <- indj + 1     
           } # fin tant que     
           cat("\n")     
           indi <- indi + 1     
         } # fin tant que     
              
         # boucle infinie d'interpréteur     
              
         repeat {     
           cat("Donner un entier dont vous voulez le carré ou 0 pour arrêter : ")     
           rep <- as.numeric(readline())     
           if (rep==0) { break }     
           cat(" le carre de ",rep," est ",rep**2,"\n")     
         } # fin répéter_jusquà     
              
    
    
         vecteur :     
         [1] 1     
         [1] 8     
         [1] 3     
         séquence :     
         [1] 1     
         [1] 2     
         [1] 3     
         [1] 4     
         liste :     
         [1] 1     
         [1] 2 3     
         [1] 4     
         [1] NA     
         [1] "FIN"     
         matrice :     
              [,1] [,2] [,3]     
         [1,]    3    4    5     
         [2,]    6    8   10     
         [1] 3     
         [1] 6     
         [1] 4     
         [1] 8     
         [1] 5     
         [1] 10     
         001   1.000000     
         002   1.500000     
         003   1.833333     
         004   2.083333     
         005   2.283333     
         ...     
         095   5.136346     
         096   5.146763     
         097   5.157072     
         098   5.167277     
         099   5.177378     
         100   5.187378     
          le premier entier dont le carré dépasse 200 est  15     
         table des puissances inférieures à 1 000 000     
                 1        1        1        1        1        1        1        1        1     
                 2        4        8       16       32       64      128      256      512     
                 3        9       27       81      243      729     2187     6561    19683     
                 4       16       64      256     1024     4096    16384    65536   262144     
                 5       25      125      625     3125    15625    78125   390625     
                 6       36      216     1296     7776    46656   279936     
                 7       49      343     2401    16807   117649   823543     
                 8       64      512     4096    32768   262144     
                 9       81      729     6561    59049   531441     
         Donner un entier dont vous voulez le carré ou 0 pour arrêter :     
         5     
         le carre de  5  est  25     
         Donner un entier dont vous voulez le carré ou 0 pour arrêter :     
         8     
         le carre de  8  est  64     
         Donner un entier dont vous voulez le carré ou 0 pour arrêter :     
         0     
              
    

    Pour les autres questions posées, nous fournissons le code suivant et son résultat d'exécution :

    
         # boucles avec un pas variable     
              
         nombre <- 0     
         for (ind in 1:10) {     
           if (ind <= 5) {     
             nombre <- nombre + 1     
           } else {     
             if (nombre==5) { nombre = 1 }     
             nombre <- nombre * 10     
           } # fin si     
           cat(" étape ",sprintf("%2d",ind)," n = ",sprintf("%8d",nombre),"\n")     
         } # fin pour ind     
              
         # boucle pour un ensemble de valeurs particulières     
              
         vect <- c(12,38,45,70,50)     
         cat(" pour le vecteur ",vect,"\n")     
              
         for (ind in 1:length(vect)) {     
           cat(paste("V[",ind,"] = ",vect[ind],sep="","\n"))     
         } # fin pour     
              
         vect <- c(12,38,45,70,50)     
         for (elt in vect) {     
           cat("valeur ",elt,"\n")     
         } # fin pour     
              
         # calcul de la racine d'un nombre par récurence     
              
         racine <- function(X,prec=10**(-4),debug=TRUE) {     
              
             valp  <- 0     
             valc  <- 1     
             while (abs(valc-valp)>prec) {     
               valp <- valc     
               valc <- (X/(valc*2)) + (valc/2)     
               # pour debug : cat(" valeur ",valc,"\n")     
             } # fin tant que     
              
             if (debug) { cat(" racine de ",X," vaut à peu prés : ",valc, " ; vraie valeur ",sqrt(X)," différence ",valc-sqrt(X),"\n") }     
              
             return( valc )     
              
         } # fin de fonction     
              
         racine(2)     
         racine(3,0.1)     
              
         rdt <- racine(3,0.1,debug=FALSE) # sans affichage     
              
    
    
          étape   1  n =         1     
          étape   2  n =         2     
          étape   3  n =         3     
          étape   4  n =         4     
          étape   5  n =         5     
          étape   6  n =        10     
          étape   7  n =       100     
          étape   8  n =      1000     
          étape   9  n =     10000     
          étape  10  n =    100000     
          pour le vecteur  12 38 45 70 50     
         V[1] = 12     
         V[2] = 38     
         V[3] = 45     
         V[4] = 70     
         V[5] = 50     
         valeur  12     
         valeur  38     
         valeur  45     
         valeur  70     
         valeur  50     
          racine de  2  vaut à peu prés :  1.414214  ; vraie valeur  1.414214  différence  1.594724e-12     
         [1] 1.414214     
          racine de  3  vaut à peu prés :  1.732143  ; vraie valeur  1.732051  différence  9.204957e-05     
         [1] 1.732143     
              
    
  2. Pour dichotomiser, il faut commencer par créer un vecteur de même longueur que V. Utiliser rep() pour cela est une bonne solution. Mettre des NA est prudent, mais non optimal. La solution avec une boucle est facile à suivre, car il n'y a qu'un test en si/alors/sinon dans la boucle. Pour faire plus simple, il faut se rappeler que R sait faire des tests sur tout un vecteur à la fois. On peut donc définir un filtre et mettre VRAI si le filtre s'applique, FAUX sinon. Enfin, pour optimiser, on peut tout initialiser à FAUX et remplacer avec des VRAI si la condition d'infériorité est vérifiée.

    
              
         #############################################################     
              
         dichotomiseVersion1 <- function(vecteur,seuil) {     
              
         #############################################################     
              
         if (missing(seuil)) {     
           cat("Paramètre seuil manquant.\n")     
           cat("Rappel de la syntaxe de la fonction : \n")     
           cat("    dichotomiseVersion1(vecteur,seuil) \n")     
           cat("Exemple d'utilisation de la fonction : \n")     
           cat("    dichotomiseVersion1(vecteur=1:20,seuil=5) \n")     
           cat("La fonction renvoie un vecteur de TRUE et FALSE suivant \n")     
           cat("que les éléments du vecteur sont STRICTEMENT inférieurs au seuil ou non.\n\n")     
           return()     
         } # fin de si     
              
         # version avec une boucle et un test en si     
              
         nbe     <- length(vecteur)     
         vectBin <- rep(NA,nbe)     
         for (ide in 1:nbe) {     
           if (vecteur[ide]<seuil) {     
              vectBin[ide] <- TRUE     
           } else {     
              vectBin[ide] <- FALSE     
           } # fin de si     
         } # fin pour ide     
              
         return( vectBin )     
              
         } # fin de fonction dichotomiseVersion1     
              
         #############################################################     
              
         dichotomiseVersion2 <- function(vecteur,seuil) {     
              
         #############################################################     
              
         if (missing(seuil)) {     
           cat("\nParamètre seuil manquant.\n")     
           cat("Rappel de la syntaxe de la fonction : \n")     
           cat("    dichotomiseVersion2(vecteur,seuil) \n")     
           cat("Exemple d'utilisation de la fonction : \n")     
           cat("    dichotomiseVersion2(vecteur=1:20,seuil=5) \n")     
           cat("La fonction renvoie un vecteur de TRUE et FALSE suivant \n")     
           cat("que les éléments du vecteur sont STRICTEMENT inférieurs au seuil ou non.\n\n")     
           return()     
         } # fin de si     
              
         # version sans boucle et non optimisée     
              
         nbe     <- length(vecteur)     
         vectBin <- rep(NA,nbe)     
         filtre  <- vecteur<seuil     
         vectBin[  filtre ] <- TRUE     
         vectBin[ !filtre ] <- FALSE     
              
         return( vectBin )     
              
         } # fin de fonction dichotomiseVersion2     
              
         #############################################################     
              
         dichotomiseVersion3 <- function(vecteur,seuil) {     
              
         #############################################################     
              
         if (missing(seuil)) {     
           cat("\nParamètre seuil manquant.\n")     
           cat("Rappel de la syntaxe de la fonction : \n")     
           cat("    dichotomiseVersion3(vecteur,seuil) \n")     
           cat("Exemple d'utilisation de la fonction : \n")     
           cat("    dichotomiseVersion3(vecteur=1:20,seuil=5) \n")     
           cat("La fonction renvoie un vecteur de TRUE et FALSE suivant \n")     
           cat("que les éléments du vecteur sont STRICTEMENT inférieurs au seuil ou non.\n\n")     
           return()     
         } # fin de si     
              
         # version optimisée et sans boucle     
              
         vectBin <- rep(FALSE,length(vecteur))     
         vectBin[ vecteur<seuil ] <- TRUE     
              
         return( vectBin )     
              
         } # fin de fonction dichotomiseVersion3     
              
              
    
    
         > source("dichotomise.r",echo=TRUE)     
              
         > dichotomiseVersion1()     
         Paramètre seuil manquant.     
         Rappel de la syntaxe de la fonction :     
             dichotomiseVersion1(vecteur,seuil)     
         Exemple d'utilisation de la fonction :     
             dichotomiseVersion1(vecteur=1:20,seuil=5)     
         La fonction renvoie un vecteur de TRUE et FALSE suivant     
         que les éléments du vecteur sont STRICTEMENT inférieurs au seuil ou non.     
              
         NULL     
              
         > dichotomiseVersion1(1:20,5)     
              
          [1]  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE     
         [15] FALSE FALSE FALSE FALSE FALSE FALSE     
              
         > dichotomiseVersion2()     
              
         Paramètre seuil manquant.     
         Rappel de la syntaxe de la fonction :     
             dichotomiseVersion2(vecteur,seuil)     
         Exemple d'utilisation de la fonction :     
             dichotomiseVersion2(vecteur=1:20,seuil=5)     
         La fonction renvoie un vecteur de TRUE et FALSE suivant     
         que les éléments du vecteur sont STRICTEMENT inférieurs au seuil ou non.     
              
         NULL     
              
         > dichotomiseVersion2(vecteur=1:20,seuil=5)     
          [1]  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE     
         [15] FALSE FALSE FALSE FALSE FALSE FALSE     
              
         > dichotomiseVersion3(vecteur=1:20,seuil=5)     
          [1]  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE     
         [15] FALSE FALSE FALSE FALSE FALSE FALSE     
              
    

    Une fois les valeurs logiques obtenues, puisque FALSE vaut 0 et TRUE vaut 1, il suffit de leur ajouter 1 pour obtenir des indices utilisables. Il faut juste mettre les adjectifs ou les valeurs souhaitées dans le bon ordre, soit ici "vieux" avant "jeune" et "blue" avant "red" :

    
         vectAges <- round( runif(10,20,30) )     
         cat(" les ages ")     
         print(vectAges)     
              
         vectLogi <- dichotomiseVersion3(vectAges,25)     
         cat(" les valeurs logiques ")     
         print(vectLogi)     
              
         vectAdje <- c("vieux","jeune")[ 1+vectLogi ]     
         cat(" les adjectifs ")     
         print(vectAdje)     
              
         coulAges <- c("blue","red")     
         vectCoul <- coulAges[ 1+vectLogi ]     
         cat(" les couleurs ")     
         print(vectCoul)     
              
         # utilisons cela pour tracer les ages en couleurs     
              
         plot( vectAges, pch=19,col=vectCoul )     
         plot( vectAges, pch=21,bg=vectCoul,col="black" )     
              
         coulAges <- c("yellow","red")     
         vectCoul <- coulAges[ 1+vectLogi ]     
         vectCex  <- c(2,0.5)[1 + vectLogi ]     
              
         par( oma=rep(1,4) ) # pour ne pas être trop près des bords     
              
         graphique <- ""     # à permuter éventuellement     
         graphique <- "png"  # à permuter éventuellement     
              
         if (graphique=="png") {     
           nomgr <- "agesCoul.png"     
           gr(nomgr) # fonction (gH) pour png() spécial "grands écrans"     
         } # fin si     
              
         plot( vectAges, pch=21,bg=vectCoul,col="black",     
               cex=vectCex,main="Jeunes et Vieux en couleurs",     
               xlab = "", ylab= "Age"     
         ) # fin de plot     
              
         legend(x="topleft",legend=c("vieux","jeune"),col="black",     
            pt.bg=c("yellow","red"),pch=21,bg="lightblue" # attention à bg et pt.bg     
         ) # de plot     
              
         if (graphique!="") {     
           dev.off()     
           cat(" graphique ",nomgr," généré \n")     
         } # fin si     
              
    
    
          les ages              [1] 27 26 24 25 21 23 22 30 21 21     
              
          les valeurs logiques  [1] FALSE FALSE  TRUE FALSE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE     
          les adjectifs         [1] "vieux" "vieux" "jeune" "vieux" "jeune" "jeune" "jeune" "vieux" "jeune" "jeune"     
          les couleurs          [1] "blue" "blue" "red"  "blue" "red"  "red"  "red"  "blue" "red"  "red"     
              
          graphique  agesCoul.png  généré     
              
    

    agesCoul2.png

  3. Trouver les positions du minimum, c'est passer en revue tous les éléments et retenir leur position à chaque fois que l'élément est égal au minimum. Il n'est pas possible de prédire la longueur du vecteur des positions et une solution comme pdm <- c(pdm,position) dans une boucle est particulièrement inefficace. Une solution plus élégante consiste à retenir les indices correspondant au minimum via (1:length(vect))[vect==max(vect)] mais il est sans doute plus lisible de séparer et détailler la génération des indices, le filtre et l'extraction des indices en trois affectations, comme dans la fonction posMinV3(). Comme R dispose d'une fonction (sans doute vectorielle) nommée which(), le mieux est de l'utiliser.

    
              
         ######################################################################     
              
         posMinV1 <- function(vect) {     
              
         ######################################################################     
              
         # lent : on part d'un vecteur vide et on lui ajoute chaque position vue du minimum     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV1(vect).\n")     
         } else {     
           pdm <- c()           # c() est la notation pour le vecteur vide     
           nbe <- length(vect)     
           vm  <- min(vect)     # valeur du Minimum     
           for (ide in 1:nbe) {     
             # pour debug : cat(" ide ",sprintf("%3d",ide)," x = ",vect[ide]," donc pdm " , pdm,"\n")     
             if (vect[ide]==vm) { pdm <- c(pdm,ide) }     
           } # fin pour ide     
           return(pdm)     
         } # fin si     
              
         } # fin de fonction posMinV1     
              
         ######################################################################     
              
         posMinV2 <- function(vect) {     
              
         ######################################################################     
              
         # rapide ? on utilise la comparaison vectorielle avec ==     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV2(vect).\n")     
         } else {     
           return( (1:length(vect))[vect==min(vect)] )     
         } # fin si     
              
         } # fin de fonction posMinV2     
              
         ######################################################################     
              
         posMinV3 <- function(vect) {     
              
         ######################################################################     
              
         # sans doute aussi rapide que posMinV2 mais plus lisible     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV3(vect).\n")     
         } else {     
           pdv <- 1:length(vect)  # plage de variation des indices     
           flt <- vect==min(vect) # filtre     
           pdm <- pdv[ flt ]     
           return(pdm)     
         } # fin si     
              
         } # fin de fonction posMinV3     
              
         ######################################################################     
              
         posMinV4 <- function(vect) {     
              
         ######################################################################     
              
         # sans doute aussi rapide que posMinV2 mais plus lisible     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV4(vect).\n")     
         } else {     
           pdv <- 1:length(vect)  # plage de variation des indices     
           vmi <- min(vect)       # valeur du min     
           flt <- vect==vmi       # filtre     
           pdm <- pdv[ flt ]     
           return(pdm)     
         } # fin si     
              
         } # fin de fonction posMinV4     
              
         ######################################################################     
              
         posMinV5 <- function(vect) {     
              
         ######################################################################     
              
         # on utilise which     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV5(vect).\n")     
         } else {     
           return( which(vect==min(vect)) )     
         } # fin si     
              
         } # fin de fonction posMinV5     
              
         ######################################################################     
              
         posMinV6 <- function(vect) {     
              
         ######################################################################     
              
         # on utilise which et on sort min(vect) du test     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV6(vect).\n")     
         } else {     
           vmi <- min(vect)       # valeur du min     
           return( which(vect==vmi) )     
         } # fin si     
              
         } # fin de fonction posMinV6     
              
    
    
         > source("posmin.r")     
              
         > (va <- rbinom(n=30,size=8,prob=0.2))     
          [1] 4 1 2 2 2 2 0 3 1 3 1 1 0 2 0 3 2 1 2 4 1 2 2 0 2 3 0 3 1 4     
              
         > posMinV1()     
         Syntax: posMinV1(vect).     
              
         > posMinV1(va)     
         [1]  7 13 15 24 27     
              
         > posMinV2(va)     
         [1]  7 13 15 24 27     
              
         > posMinV3(va)     
         [1]  7 13 15 24 27     
              
         > posMinV4(va)     
         [1]  7 13 15 24 27     
              
         > posMinV5(va)     
         [1]  7 13 15 24 27     
              
         > posMinV6(va)     
         [1]  7 13 15 24 27     
              
    

    Si, pour une raison ou pour une autre, on ne peut pas prédire la taille du résultat et si on doit absolument passer par une boucle pour, l'optimisation consiste à ne PAS changer la taille du vecteur résultat à chaque passage dans la boucle mais à le faire «de temps en temps», quand la taille ne suffit plus. Si (par sondage, expertise, test...) on connait en gros l'augmentation de la taille, on peut en profiter pour ne pas trop augmenter à chaque fois la taille ; sinon on peut choisir de la doubler 

    
              
         ######################################################################     
              
         posMinV1bis <- function(vect) {     
              
         ######################################################################     
              
         # on alloue au départ 5 positions de minimum (variable alloc)     
         # et on rajoute 5 NA quand on a rempli ces positions     
              
         if (missing(vect)) {     
           cat("\nSyntax: posMinV1bis(vect).\n")     
         } else {     
              
           alloc <- 5     
           pdm   <- rep(NA,alloc)     
           nbe   <- length(vect)     
           vm    <- min(vect) # Valeur du Minimum     
           nb    <- 0 # nombre de positions vues du minimum     
           for (ide in 1:nbe) {     
             if (vect[ide]==vm) {     
               nb <- nb + 1 # et une position de plus     
               # si cela risque de déborder, on alloue plus de place     
               if (nb>length(pdm)) {     
                 length(pdm) <- length(pdm) + alloc  # mette ici 2*length(alloc) pour doubler la place     
               } # fin si     
               pdm[nb] <- ide     
             } # fin si     
             # pour debug :     
             cat(" ide ",sprintf("%3d",ide)," x = ",vect[ide]," donc pdm " , pdm,"\n")     
           } # fin pour ide     
              
           # pour ne pas renvoyer de NA, soit     
              
             pdm<- na.omit(pdm)     
              
           # soit     
              
             pdm <- pdm[ 1:nb ]     
              
           return(pdm)     
              
         } # fin si     
              
         } # fin de fonction posMinV1bis     
              
         # des 1 et des 2, avec en gros 2/3 de 1     
         vectAlea <-  1 + rbinom(n=30,size=1,p=2/3)     
              
         cat("Vecteur")     
         cat(vectAlea,"\n")     
         posMinV1bis( vectAlea )     
              
    
    
         Vecteur1 2 2 2 1 2 2 1 1 2 1 1 2 2 2 1 1 2 2 1 1 2 2 1 1 2 2 2 1 1     
          ide    1  x =  1  donc pdm  1 NA NA NA NA     
          ide    2  x =  2  donc pdm  1 NA NA NA NA     
          ide    3  x =  2  donc pdm  1 NA NA NA NA     
          ide    4  x =  2  donc pdm  1 NA NA NA NA     
          ide    5  x =  1  donc pdm  1 5 NA NA NA     
          ide    6  x =  2  donc pdm  1 5 NA NA NA     
          ide    7  x =  2  donc pdm  1 5 NA NA NA     
          ide    8  x =  1  donc pdm  1 5 8 NA NA     
          ide    9  x =  1  donc pdm  1 5 8 9 NA     
          ide   10  x =  2  donc pdm  1 5 8 9 NA     
          ide   11  x =  1  donc pdm  1 5 8 9 11     
          ide   12  x =  1  donc pdm  1 5 8 9 11 12 NA NA NA NA     
          ide   13  x =  2  donc pdm  1 5 8 9 11 12 NA NA NA NA     
          ide   14  x =  2  donc pdm  1 5 8 9 11 12 NA NA NA NA     
          ide   15  x =  2  donc pdm  1 5 8 9 11 12 NA NA NA NA     
          ide   16  x =  1  donc pdm  1 5 8 9 11 12 16 NA NA NA     
          ide   17  x =  1  donc pdm  1 5 8 9 11 12 16 17 NA NA     
          ide   18  x =  2  donc pdm  1 5 8 9 11 12 16 17 NA NA     
          ide   19  x =  2  donc pdm  1 5 8 9 11 12 16 17 NA NA     
          ide   20  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 NA     
          ide   21  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 21     
          ide   22  x =  2  donc pdm  1 5 8 9 11 12 16 17 20 21     
          ide   23  x =  2  donc pdm  1 5 8 9 11 12 16 17 20 21     
          ide   24  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 21 24 NA NA NA NA     
          ide   25  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 NA NA NA     
          ide   26  x =  2  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 NA NA NA     
          ide   27  x =  2  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 NA NA NA     
          ide   28  x =  2  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 NA NA NA     
          ide   29  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 29 NA NA     
          ide   30  x =  1  donc pdm  1 5 8 9 11 12 16 17 20 21 24 25 29 30 NA     
          [1]  1  5  8  9 11 12 16 17 20 21 24 25 29 30     
              
    
  4. On peut utiliser la fonction duree() que nous avions définie dans la séance 1 et qui n'est pas exactement la même que celle définie dans statgh.r, ce qui peut se voir ici.

    Voici des exemples de temps d'exécution pour la dichotomisation :

    
          # chargement des trois fonctions     
              
          source("dichotomise.r",encoding="latin1")     
              
          # définition d'un même jeu de données aléatoire pour comparaison     
              
          nbVal    <- 5*10**6     
          vectAlea <- round( runif(n=nbVal,min=1,max=100) )     
              
          # vitesses d'exécution     
              
          cat(" pour dichotomiseVersion1(vectAlea,seuil=50) : ")     
          duree( v1 <- dichotomiseVersion1(vectAlea,seuil=50) ) # en gros 27.4 s     
              
          cat(" pour dichotomiseVersion2(vectAlea,seuil=50) : ")     
          duree( v2 <- dichotomiseVersion1(vectAlea,seuil=50) ) # environ 27.7 s     
              
          cat(" pour dichotomiseVersion3(vectAlea,seuil=50) : ")     
          duree( v3 <- dichotomiseVersion1(vectAlea,seuil=50) ) # à peu près 26.5 s     
              
          # et si on comparait avec ifelse ?     
              
          cat(" pour ifelse(vectAlea<seuil,TRUE,FALSE) : ")     
          duree( v4 <- ifelse(vectAlea<50,TRUE,FALSE) ) # à peu près 3.8 s     
              
          # et avec le simple test vectoriel ?     
              
          cat(" pour vectAlea<seuil : ")     
          duree( v5 <- vectAlea<50)  # à peu près 0.17 s     
              
              
    
    
          pour dichotomiseVersion1(vectAlea,seuil=50) : durée =  28 s     
          pour dichotomiseVersion2(vectAlea,seuil=50) : durée =  27 s     
          pour dichotomiseVersion3(vectAlea,seuil=50) : durée =  26 s     
          pour ifelse(vectAlea<seuil,TRUE,FALSE)      : durée =   4 s     
          pour vectAlea<seuil                         : durée =   0.2 s     
              
    

    et des exemples de temps d'exécution pour les positions du minimum :

    
          # chargement des trois fonctions     
              
          source("posmin.r",encoding="latin1")     
              
          # définition d'un même jeu de données aléatoire pour comparaison     
              
          nbVal    <- 5*10**6     
          vectAlea <- round( runif(n=nbVal,min=1,max=100) )     
              
          # vitesses d'exécution     
              
          cat(" pour posMinV1(vectAlea) : ")     
          duree( posMinV1(vectAlea) )     
              
          cat(" pour posMinV2(vectAlea) : ")     
          duree( posMinV2(vectAlea) )     
              
          cat(" pour posMinV3(vectAlea) : ")     
          duree( posMinV3(vectAlea) )     
              
          cat(" pour posMinV4(vectAlea) : ")     
          duree( posMinV4(vectAlea) )     
              
          cat(" pour posMinV5(vectAlea) : ")     
          duree( posMinV5(vectAlea) )     
              
          cat(" pour posMinV6(vectAlea) : ")     
          duree( posMinV6(vectAlea) )     
              
    
    
         source("durees4.r",encoding="latin1")     
              
          pour posMinV1(vectAlea) : durée   =  10.980100 s     
          pour posMinV2(vectAlea) : durée   =  0.4090939 s     
          pour posMinV3(vectAlea) : durée   =  0.5339005 s     
          pour posMinV4(vectAlea) : durée   =  0.4145384 s     
          pour posMinV5(vectAlea) : durée   =  0.2373221 s     
          pour posMinV6(vectAlea) : durée   =  0.1609249 s     
              
    

    Comme le fichier .Rdata, le fichier .Rprofile est un fichier texte qui contient du code R que R consulte automatiquement. Il peut y en avoir un pour l'utilisateur (configuration générale) et un dans le sous-répertoire courant (configuration spécialisée). De plus R permet de définir des fonctions .First() et .Last() bien utiles, par exemple pour afficher un message de bienvenue, ou pour sauvegarder de façon incrémentale tout le travail effectué. Si on place le code de la fonction duree() dans .Rprofile, alors duree() est définie et donc utilisable dès que R est chargé.

    Voici quelques liens pour approfondir cette notion de profil :

    customizing R explications du site Quick-R
    configure R R for dummies
    Rprofile York Wiki for statistical consulting

    Comme déjà dit plus haut, les options se gèrent via la fonction options() du package base. Il est donc intéressant de mettre le paramétrage désiré des options dans un fichier .Rprofile.

  5. Pour stopper l'exécution, on peut utiliser la fonction stop(). Pour poser une question à l'utilisateur, readline() est un bon choix. Notre fonction attends() montre comment utiliser ces deux fonctions ensemble. Sys.sleep(n) attend n secondes avant de continuer.

    
         # démonstration de stop, Sys.sleep et attends     
              
         demo1 <- function() {     
              
          for (idv in 1:10) {     
            cat("i = ",idv,"\n")     
            if (idv==5) {     
              stop("j'arrête à 5 !\n")     
            } # fin si     
          } # fin pour     
              
         } # fin de fonction demo1     
              
         # -----------------------------------     
              
         demo2 <- function() {     
              
          for (idv in 1:10) {     
            cat("i = ",idv,"\n")     
            if (idv==6) {     
              stop("j'arrête à 6 !\n",call.=FALSE)     
            } # fin si     
          } # fin pour     
              
         } # fin de fonction demo2     
              
         # -----------------------------------     
              
         demo3 <- function() {     
              
          cat(Sys.time()," ou encore ",format(Sys.time(),"%a %d %b %Y à %X"),"\n")     
          cat("(pause de 5 secondes : )\n")     
          Sys.sleep( 5 )     
          cat(Sys.time()," ou encore ",format(Sys.time(),"%a %d %b %Y à %X"),"\n")     
              
         } # fin de fonction demo3     
              
         # -----------------------------------     
              
         demo4 <- function() {     
              
          for (idv in 1:10) {     
            cat("\ni = ",idv)     
            attends("       -- on continue ? ")     
          } # fin pour     
              
         } # fin de fonction demo4     
              
         # -----------------------------------     
         # à décommenter, mais demo1() et demo2() arrêtent l'éxécution     
         # demo1()     
         # demo2()     
         # demo3()     
         # demo4()     
              
    
    
         # -- demo1()     
              
         i =  1     
         i =  2     
         i =  3     
         i =  4     
         i =  5     
         Erreur dans demo1() : j'arrête à 5 !     
              
         # -- demo2()     
              
         i =  1     
         i =  2     
         i =  3     
         i =  4     
         i =  5     
         i =  6     
              
         Erreur : j'arrête à 6 !     
              
         # -- demo3()     
              
         1328282464  ou encore  ven. 03 févr. 2012 à 16:21:04     
         (pause de 5 secondes : )     
         1328282469  ou encore  ven. 03 févr. 2012 à 16:21:09     
              
         # -- demo4() : on a appuyé 3 fois sur entrée, puis on     
         #              a tapé non et "enter"     
              
         i =  1       -- on continue ?     
              
         i =  2       -- on continue ?     
              
         i =  3       -- on continue ?     
              
         i =  4       -- on continue ? non     
              
    
  6. Voici un exemple de fonction possible pour tester si un fichier existe basée sur file.exists() décrite dans files :

    
         testeFichier <- function(nomDeFichier="") {     
              
           while (nomDeFichier=="") {     
             nomDeFichier <- readline("donner un nom de fichier : ")     
           } # fin de si     
              
           if (file.exists(nomDeFichier)) {     
             cat(" le fichier ",nomDeFichier," existe.\n")     
           } else {     
             cat(" le fichier ",nomDeFichier," n'existe pas.\n")     
           } # fin de si     
              
         } # fin de fonction testeFichier     
              
    

    La fonction R qui permet de choisir interactivement est file.choose(). R renvoie alors le chemin d'accès complet au fichier.

  7. Nous proposons deux façons de procéder, suivant que l'on veut juste un affichage ou un tableau de résultats. On remarquera qu'un fichier vide (comme vide.txt) a bien une ligne, vide, mais une ligne quand même.

    
         actionFichier <- function(nomFichier) {     
         #--------------------------------     
              
             if (!file.exists(nomFichier)) {     
               cat(nomFichier," n'existe pas \n")     
             } else {     
               fh   <- file(nomFichier,open="r")     
               vlig <- readLines(fh,n=-1)     
               nbl  <- length(vlig)     
               close(fh)     
               cat(sprintf("%-15s",nomFichier)," contient ",sprintf("%6d",nbl)," ligne(s).\n") ;     
             } # fin si     
              
         } # fin de fonction actionFichier     
              
         actionFichiers <- function(listeFichiers) {     
         #----------------------------------------     
              
           for (fichier in listeFichiers) {     
             actionFichier( fichier )     
           } # fin pour     
              
         } # fin de fonction actionFichiers     
              
         # ====================================     
              
         actionSurFichier <- function(nomFichier="") {     
         #--------------------------------     
              
             # code -2 si nom de fichier vide     
              
             if (nchar(nomFichier)==0) {     
               return(-2)     
             } # fin si     
              
             # code -1 si fichier non vu     
              
             if (!file.exists(nomFichier)) {     
               return(-1)     
             } # fin si     
              
             # si on arrive ici, le fichier existe     
              
             fh   <- file(nomFichier,open="r")     
             vlig <- readLines(fh,n=-1)     
             nbl  <- length(vlig)     
             close(fh)     
              
             return(nbl)     
              
         } # fin de fonction actionSurFichier     
              
         actionSurFichiers <- function(listeFichiers) {     
         #----------------------------------------     
              
           mdr             <- matrix(nrow=length(listeFichiers),ncol=1)     
           colnames(mdr)   <- c("Nb Lignes")     
           vecteurFichiers <- listeFichiers     
           row.names(mdr)  <- listeFichiers     
           for (ific in seq(listeFichiers)) {     
             fichier     <- listeFichiers[[ific]] # remarquer les doubles crochets     
             mdr[ific,1] <- actionSurFichier( fichier )     
           } # fin pour     
              
           return( mdr)     
              
         } # fin de fonction actionSurFichiers     
              
         # ====================================     
              
         cats("Liste des fichiers :")     
         lstFic <- c("bete.txt","histoire.txt","simple.txt","vide.txt",paste("f",sprintf("%02d",5:6),".txt",sep=""))     
         cat(lstFic,"\n")     
              
         cats("Démonstration de actionFichiers")     
         actionFichiers(lstFic)     
              
         # remarque : on aurait aussi pu utiliser : null <- lapply(FUN=actionFichier,X=lstFic)     
              
         cats("Démonstration de actionSurFichiers")     
         res <- actionSurFichiers(lstFic)     
         print(res)     
              
    
    
              
         Liste des fichiers :     
         ====================     
              
         bete.txt histoire.txt simple.txt f05.txt f06.txt     
              
         Démonstration de actionFichiers     
         ===============================     
              
         bete.txt  n'existe pas     
         histoire.txt     contient       1  ligne(s).     
         simple.txt       contient      58  ligne(s).     
         f05.txt          contient       5  ligne(s).     
         f06.txt          contient       6  ligne(s).     
              
         Démonstration de actionSurFichiers     
         ==================================     
              
                      Nb Lignes     
         bete.txt            -1     
         histoire.txt         1     
         simple.txt          58     
         f05.txt              5     
         f06.txt              6     
              
    

    L'instruction paste("fic",1:3,".txt",sep="") est l'équivalent de c("fic1.txt","fic2.txt","fic3.txt").

    "fic01.txt fic02.txt fic03.txt" s'obtient par paste("fic",sprintf("%02d",1:3),".txt",sep="",collapse=" "). Indéendamment du fait de savoir s'il faut produire une seule chaine ou un vecteur de chaines, cette deuxième écriture de chaque nom de fichier est sans doute meilleure que la première quand on a beaucoup de fichiers parce qu'on peut alors les avoir dans l'ordre facilement (sinon fic1.txt est suivi de fic10.txt au lieu de fic2.txt).

    Il est possible d'obtenir des listes de fichiers de fichiers avec les fonctions list.files() et list.dirs(). Attention : pour list.files il faut nommer impérativement le paramètre pattern. Ainsi list.files(pattern="*.txt") est correct, alors que list.files("*.txt") est incorrect. Comme notre fonction accepte une structure en entrée, on peut exécuter actionSurFichiers(list.files(pattern="*.txt")). Il est possible de choisir interactivement un nom de fichier si on utilise file.choose() dont l'aide est dans files et on dispose alors du chemin d'accès complet au fichier, pas seulement de son nom et de son extension.

    Telle que nous avons écrit la fonction actionSurFichiers() avec les doubles crochets, les appels avec une vecteur et une liste sont acceptés, mais si on a mis tous les noms de fichier dans une seule chaine, il faut «splitter»la chaine :

    
         actionSurFichiers( c("f05.txt","simple.txt") )     
         actionSurFichiers( list("f05.txt","simple.txt") )     
         # not run : actionSurFichiers( "f05.txt simple.txt" )     
         actionSurFichiers( unlist( strsplit(x="f05.txt simple.txt",split=" ") ) )     
         actionSurFichiers( unlist( strsplit(x="f05.txt     simple.txt",split="\\s+") ) )     
              
    
    
                    Nb Lignes     
         f05.txt            5     
         simple.txt        58     
                    Nb Lignes     
         f05.txt            5     
         simple.txt        58     
                    Nb Lignes     
         f05.txt            5     
         simple.txt        58     
                    Nb Lignes     
         f05.txt            5     
         simple.txt        58     
              
    
  8. R dispose d'un vecteur letters des 26 lettres minuscules et du vecteur LETTERS pour les majuscules. Couplé à paste() ce vecteur permet de générer des noms de fichier. Pour tester si une chaine correspond à un modèle, on peut utiliser les expressions régulières via regexpr() mais attention : le point a alors un sens spécial, celui de n'importe quel caractère. Un «vrai» point doit se noter \. mais comme on est dans une chaine de caractères, le slash doit être doublé. Par contre, le caractère * des noms de fichiers classiques doit s'écrire .* car * seul n'est qu'un facteur de répétition signifiant 0 fois ou plus.

    Voir notre tuteur à titre de rappel sur les expressions régulières.

    Comme regexpr renvoie entre autres la position entière positive où on trouve l'expression régulière ou -1 si elle n'est pas trouvée, il suffit d'utiliser v > 0 comme filtre si v est le vecteur résultat de regexpr pour gérer les éléments qui correspondent. Comme on peut le voir ci-dessous, regexpr traite aussi bien les vecteurs que les listes car les listes peuvent être assimilées à des vecteurs via l'indexation avec des crochets...

    
           nbf       <- 6     
           listeFic1 <- paste("Comp", LETTERS[1:nbf], "liste.txt", sep="")     
           listeFic1 <- c("fic44abcnum.pair.txt",listeFic1, "fic44d38num.pair.txt")     
           listeFic2 <- as.list( listeFic1 )     
              
           cat("Voici tous les fichiers :\n")     
           print(cbind(listeFic1),quote=FALSE)     
              
           cat("\nCeux qui correspondent au modèle fic44*num.pair.txt (mode vecteur): \n")     
           ficFlt1 <- regexpr("fic44.*num\\.pair\\.txt",listeFic1,perl=TRUE) > 0     
           print(cbind( listeFic1[ ficFlt1 ] ) )     
              
           cat("\nCeux qui correspondent au modèle fic44*num.pair.txt (mode liste) : \n")     
           ficFlt2 <- regexpr("fic44.*num\\.pair\\.txt",listeFic2,perl=TRUE) > 0     
           print(cbind( listeFic2[ ficFlt2 ] ) )     
              
           cat("\nlisteFic1 ")     
           if (is.vector(listeFic1)) {     
             cat("est")     
           } else {     
             cat("n'est pas")     
           } # fin si     
           cat(" un vecteur. " )     
           cat("listeFic1 ")     
           if (is.list(listeFic1)) {     
             cat("est")     
           } else {     
             cat("n'est pas")     
           } # fin si     
           cat(" une liste.\n\n" )     
              
           if (is.vector(listeFic2)) {     
             cat("listeFic2 est un vecteur. ")     
           } else {     
             cat("listeFic2 n'est pas un vecteur. ")     
           } # fin si     
              
           if (is.list(listeFic2)) {     
             cat("listeFic2 est une liste.\n")     
           } else {     
             cat("listeFic2 n'est pas une liste.\n")     
           } # fin si     
              
              
    
    
         Voici tous les fichiers :     
              listeFic1     
         [1,] fic44abcnum.pair.txt     
         [2,] CompAliste.txt     
         [3,] CompBliste.txt     
         [4,] CompCliste.txt     
         [5,] CompDliste.txt     
         [6,] CompEliste.txt     
         [7,] CompFliste.txt     
         [8,] fic44d38num.pair.txt     
              
         Ceux qui correspondent au modèle fic44*num.pair.txt (mode vecteur):     
              [,1]     
         [1,] "fic44abcnum.pair.txt"     
         [2,] "fic44d38num.pair.txt"     
              
         Ceux qui correspondent au modèle fic44*num.pair.txt (mode liste) :     
              [,1]     
         [1,] "fic44abcnum.pair.txt"     
         [2,] "fic44d38num.pair.txt"     
              
         listeFic1 est un vecteur. listeFic1 n'est pas une liste.     
              
         listeFic2 est un vecteur. listeFic2 est une liste.     
              
    
  9. y~x est une formule, (de classe formula), de type langage et de mode appel (call). L'afficher avec print se contente d'afficher la formule alors que son tracé aboutit aux points de y en fonction de x. Son résumé est des plus succincts ! lm(y~x) est une liste assez compliquée de 12 éléments, certains étant des vecteurs. Son affichage ne fournit que les coefficients du modèle linéaire alors que son tracé fournit 4 graphiques de diagnostic (par défaut, sur les 6 possibles). Son résumé affiche des statistiques sur les résidus, sur les coefficients et sur la qualité d'ajustement du modèle.

    anova( lm(y~x) ) est un objet encore plus complexe, qui participe de deux classes (anova et data.frame). Son affichage fournit le tableau classique d'analyse de la variance, son tracé est celui d'un data.frame, il s'agit donc de pairs(obj3) et son résumé est ici assez peu intéressant (c'est celui, usuel, des variables quantitatives) car il s'applique au tableau 5x2 des résultats.

    summary( anova(lm(y~x)) ) est justement ce tableau de résultats, de classe tableau, et en format caractère. Donc vouloir le tracer ou en demander un résumé provoque une erreur.

    
          her  <- lit.dar.wd("her.dar")     
              
          attach(her) # plus pratique ici que her$taille ou her[,"taille"]     
                      # et plus sûr que her[,3]     
              
          # --------------------------------------     
              
          obj1 <- poids ~ taille # plus "sensé" que taille~poids     
          obj2 <- lm( obj1 )     
          obj3 <- anova( obj2 )     
          obj4 <- summary( obj3 )     
              
          # --------------------------------------     
              
          analyseObjet <- function(x) {     
            return( c( paste(class(x),collapse=" "), typeof(x), mode(x), storage.mode(x) ) )     
          } # fin de fonction analyseObjet     
              
          mdr <- rbind( # matrice des résultats     
            analyseObjet(obj1)  ,     
            analyseObjet(obj2)  ,     
            analyseObjet(obj3)  ,     
            analyseObjet(obj4)     
            ) # fin de rbind     
              
          colnames(mdr)  <- c("class()","typeof()","mode()","storage.mode()")     
          row.names(mdr) <- paste("obj",sprintf("%02d",1:nrow(mdr)),sep="")     
          cat("\nVoici les caractéristiques des objets\n")     
          print( mdr, quote=FALSE )     
              
          cat("\nUne façon courte de voir les objets et leur type utilise ls.str() :\n")     
          ls.str(pattern="^obj[0-9]*$")     
              
              
          # --------------------------------------     
              
          pps <- function(x) {     
              
            obj <- get(x)     
              
            cats(paste("print de",x))     
            print(obj) ;     
              
            cats(paste("plot de",x),"-")     
            plot(obj,main=paste("OBJET ",x))  ;     
            cat("... ok\n")     
              
            cats(paste("summary de",x),"-")     
            print(summary(obj) )     
              
          } # fin de fonction pps     
              
          sapply(FUN=pps, X=c("obj1","obj2","obj3","obj4") )     
              
          detach(her) # à ne pas oublier !     
              
    
    
              
         Voici les caractéristiques des objets     
               class()          typeof()  mode()    storage.mode()     
         obj01 formula          language  call      language     
         obj02 lm               list      list      list     
         obj03 anova data.frame list      list      list     
         obj04 table            character character character     
              
         Une façon courte de voir les objets et leur type utilise ls.str() :     
              
         obj1 : Class 'formula' length 3 poids ~ taille     
              
         obj2 : List of 12     
          $ coefficients : Named num [1:2] -74.464 0.879     
          $ residuals    : Named num [1:80] -6.803 -7.824 -4.224 0.853 -7.187 ...     
          $ effects      : Named num [1:80] -646.6 76.56 -4.67 1.03 -6.78 ...     
          $ rank         : int 2     
          $ fitted.values: Named num [1:80] 83.5 73.2 85.5 78.8 76.4 ...     
          $ assign       : int [1:2] 0 1     
          $ qr           :List of 5     
          $ df.residual  : int 78     
          $ xlevels      : Named list()     
          $ call         : language lm(formula = obj1)     
          $ terms        :Classes 'terms', 'formula' length 3 poids ~ taille     
          $ model        :'data.frame':	80 obs. of  2 variables:     
              
         obj3 : Classes 'anova' and 'data.frame':	2 obs. of  5 variables:     
          $ Df     : int  1 78     
          $ Sum Sq : num  5861 13902     
          $ Mean Sq: num  5861 178     
          $ F value: num  32.9 NA     
          $ Pr(>F) : num  1.77e-07 NA     
              
         obj4 :  'table' chr [1:7, 1:5] "Min.   : 1.00  " "1st Qu.:20.25  " ...     
              
         print de obj1     
         =============     
              
         poids ~ taille     
              
         plot de obj1     
         ------------     
              
         ... ok     
              
         summary de obj1     
         ---------------     
              
          Length   Class    Mode     
               3 formula    call     
              
         print de obj2     
         =============     
              
              
         Call:     
         lm(formula = obj1)     
              
         Coefficients:     
         (Intercept)       taille     
            -74.4636       0.8786     
              
              
         plot de obj2     
         ------------     
              
         Tapez <Entrée> pour voir le graphique suivant     
         Tapez <Entrée> pour voir le graphique suivant     
         Tapez <Entrée> pour voir le graphique suivant     
         Tapez <Entrée> pour voir le graphique suivant     
         ... ok     
              
         summary de obj2     
         ---------------     
              
              
         Call:     
         lm(formula = obj1)     
              
         Residuals:     
             Min      1Q  Median      3Q     Max     
         -22.349  -8.107  -1.220   7.307  49.114     
              
         Coefficients:     
                     Estimate Std. Error t value Pr(>|t|)     
         (Intercept) -74.4636    25.6353  -2.905  0.00478 **     
         taille        0.8786     0.1532   5.734 1.77e-07 ***     
         ---     
         Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1     
              
         Residual standard error: 13.35 on 78 degrees of freedom     
         Multiple R-squared: 0.2966,	Adjusted R-squared: 0.2875     
         F-statistic: 32.88 on 1 and 78 DF,  p-value: 1.771e-07     
              
              
         print de obj3     
         =============     
              
         Analysis of Variance Table     
              
         Response: poids     
                   Df Sum Sq Mean Sq F value    Pr(>F)     
         taille     1   5861  5861.0  32.884 1.771e-07 ***     
         Residuals 78  13902   178.2     
         ---     
         Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1     
              
         plot de obj3     
         ------------     
              
         ... ok     
              
         summary de obj3     
         ---------------     
              
                Df            Sum Sq         Mean Sq          F value     
          Min.   : 1.00   Min.   : 5861   Min.   : 178.2   Min.   :32.88     
          1st Qu.:20.25   1st Qu.: 7871   1st Qu.:1598.9   1st Qu.:32.88     
          Median :39.50   Median : 9882   Median :3019.6   Median :32.88     
          Mean   :39.50   Mean   : 9882   Mean   :3019.6   Mean   :32.88     
          3rd Qu.:58.75   3rd Qu.:11892   3rd Qu.:4440.3   3rd Qu.:32.88     
          Max.   :78.00   Max.   :13902   Max.   :5861.0   Max.   :32.88     
                                                           NA's   : 1.00     
              Pr(>F)     
          Min.   :1.771e-07     
          1st Qu.:1.771e-07     
          Median :1.771e-07     
          Mean   :1.771e-07     
          3rd Qu.:1.771e-07     
          Max.   :1.771e-07     
          NA's   :1.000e+00     
              
         print de obj4     
         =============     
              
                Df            Sum Sq         Mean Sq          F value     
          Min.   : 1.00   Min.   : 5861   Min.   : 178.2   Min.   :32.88     
          1st Qu.:20.25   1st Qu.: 7871   1st Qu.:1598.9   1st Qu.:32.88     
          Median :39.50   Median : 9882   Median :3019.6   Median :32.88     
          Mean   :39.50   Mean   : 9882   Mean   :3019.6   Mean   :32.88     
          3rd Qu.:58.75   3rd Qu.:11892   3rd Qu.:4440.3   3rd Qu.:32.88     
          Max.   :78.00   Max.   :13902   Max.   :5861.0   Max.   :32.88     
                                                           NA's   : 1.00     
              Pr(>F)     
          Min.   :1.771e-07     
          1st Qu.:1.771e-07     
          Median :1.771e-07     
          Mean   :1.771e-07     
          3rd Qu.:1.771e-07     
          Max.   :1.771e-07     
          NA's   :1.000e+00     
              
         plot de obj4     
         ------------     
              
         Erreur dans tabulate(Ind[, dimd]) : 'bin' must be numeric or a factor     
              
    

    Pour voir en détail le contenu d'un objet un peu complexe, on peut utiliser la fonction unclass(), mais cela est parfois très long :

    
          her  <- lit.dar.wd("her.dar")     
              
          attach(her) # plus pratique ici que her$taille ou her[,"taille"]     
                      # et plus sûr que her[,3]     
              
          # --------------------------------------     
              
          obj1 <- poids ~ taille # plus "sensé" que taille~poids     
          obj2 <- lm( obj1 )     
          obj3 <- anova( obj2 )     
          obj4 <- summary( obj3 )     
              
          # --------------------------------------     
              
          unclassGH <- function(x) {     
              
            obj <- get(x)     
              
            cats(paste("unclass de",x))     
            print( unclass(obj) )     
              
          } # fin de fonction unclassGH     
              
          sapply(FUN=unclassGH, X=c("obj1","obj2","obj3","obj4") )     
              
          detach(her) # à ne pas oublier !     
              
    
    
         unclass de obj1     
         ===============     
              
         poids ~ taille     
         attr(,".Environment")     
         <environment: R_GlobalEnv>     
              
         unclass de obj2     
         ===============     
              
         $coefficients     
         (Intercept)      taille     
         -74.4636321   0.8785688     
              
         $residuals     
                   1           2           3           4           5           6           7           8           9 [...]     
          -6.8030379  -7.8237829  -4.2237461   0.8533768  -7.1866306  -4.2887627 -12.7266380  15.8919382   1.5319456     
                  42          43          44          45          46          47          48          49          50     
          -6.0509242 -15.6259518   8.0740482  -0.8516840 -11.6252289  -8.2909684   4.0897693  22.1105144 -12.5931005     
              
         $effects     
          (Intercept)       taille     
         -646.6037771   76.5574385   -4.6655445    1.0326892   -6.7784878   -4.2156928  -12.0896648   16.3818061 [...]     
           -0.5070168   -4.3095178  -15.8120189   -5.3976060  -14.1145199    9.5854801    1.2154788  -10.3834898     
           -5.6621672  -15.4387817  -15.4380469   -4.4465814     
              
         $rank     
         [1] 2     
              
         $fitted.values     
                1        2        3        4        5        6        7        8        9       10       11  [...]     
         83.50304 73.22378 85.52375 78.84662 76.38663 79.98876 73.92664 75.50806 77.96805 71.90593 66.10738     
               56       57       58       59       60       61       62       63       64       65       66     
         69.88522 70.85165 63.64738 69.00665 66.98594 61.01168 66.98594 65.22881 60.74811 67.24952 56.26741     
              
         $assign     
         [1] 0 1     
              
         $qr     
         $qr     
            (Intercept)        taille     
         1   -8.9442719 -1.494051e+03     
         2    0.1118034  8.713881e+01     
         3    0.1118034 -1.581023e-01     
         4    0.1118034 -7.088517e-02     
         5    0.1118034 -3.875253e-02     
         6    0.1118034 -8.580390e-02     
         7    0.1118034 -6.619889e-03     
         8    0.1118034 -2.727659e-02     
         9    0.1118034 -5.940923e-02     
         10   0.1118034  1.977478e-02     
         [...]     
         70   0.1118034  6.338336e-02     
         71   0.1118034  1.035492e-01     
         72   0.1118034  1.448626e-01     
         73   0.1118034  2.355225e-01     
         74   0.1118034  8.977803e-02     
         75   0.1118034  1.678144e-01     
         76   0.1118034  3.698869e-02     
         77   0.1118034  1.299438e-01     
         78   0.1118034 -5.022847e-02     
         79   0.1118034 -2.153861e-02     
         80   0.1118034  2.699503e-01     
         attr(,"assign")     
         [1] 0 1     
              
         $qraux     
         [1] 1.111803 1.002561     
              
         $pivot     
         [1] 1 2     
              
         $tol     
         [1] 1e-07     
              
         $rank     
         [1] 2     
              
         attr(,"class")     
         [1] "qr"     
              
         $df.residual     
         [1] 78     
              
         $xlevels     
         named list()     
              
         $call     
         lm(formula = obj1)     
              
         $terms     
         poids ~ taille     
         attr(,"variables")     
         list(poids, taille)     
         attr(,"factors")     
                taille     
         poids       0     
         taille      1     
         attr(,"term.labels")     
         [1] "taille"     
         attr(,"order")     
         [1] 1     
         attr(,"intercept")     
         [1] 1     
         attr(,"response")     
         [1] 1     
         attr(,".Environment")     
         <environment: R_GlobalEnv>     
         attr(,"predvars")     
         list(poids, taille)     
         attr(,"dataClasses")     
             poids    taille     
         "numeric" "numeric"     
              
         $model     
            poids taille     
         1   76.7  179.8     
         2   65.4  168.1     
         3   81.3  182.1     
         4   79.7  174.5     
         5   69.2  171.7     
         6   75.7  175.8     
         7   61.2  168.9     
         8   91.4  170.7     
         9   79.5  173.5     
         10  63.0  166.6     
         [...]     
         70  81.6  162.8     
         71  67.0  159.3     
         72  51.2  155.7     
         73  88.7  147.8     
         74  56.3  160.5     
         75  61.2  153.7     
         76  64.1  165.1     
         77  56.2  157.0     
         78  61.5  172.7     
         79  59.1  170.2     
         80  45.7  144.8     
              
              
         unclass de obj3     
         ===============     
              
         $Df     
         [1]  1 78     
              
         $`Sum Sq`     
         [1]  5861.041 13902.074     
              
         $`Mean Sq`     
         [1] 5861.0414  178.2317     
              
         $`F value`     
         [1] 32.88439       NA     
              
         $`Pr(>F)`     
         [1] 1.770625e-07           NA     
              
         attr(,"row.names")     
         [1] "taille"    "Residuals"     
         attr(,"heading")     
         [1] "Analysis of Variance Table\n" "Response: poids"     
              
         unclass de obj4     
         ===============     
              
                Df              Sum Sq           Mean Sq            F value            Pr(>F)     
          "Min.   : 1.00  " "Min.   : 5861  " "Min.   : 178.2  " "Min.   :32.88  " "Min.   :1.771e-07  "     
          "1st Qu.:20.25  " "1st Qu.: 7871  " "1st Qu.:1598.9  " "1st Qu.:32.88  " "1st Qu.:1.771e-07  "     
          "Median :39.50  " "Median : 9882  " "Median :3019.6  " "Median :32.88  " "Median :1.771e-07  "     
          "Mean   :39.50  " "Mean   : 9882  " "Mean   :3019.6  " "Mean   :32.88  " "Mean   :1.771e-07  "     
          "3rd Qu.:58.75  " "3rd Qu.:11892  " "3rd Qu.:4440.3  " "3rd Qu.:32.88  " "3rd Qu.:1.771e-07  "     
          "Max.   :78.00  " "Max.   :13902  " "Max.   :5861.0  " "Max.   :32.88  " "Max.   :1.771e-07  "     
          NA                NA                NA                 "NA's   : 1.00  " "NA's   :1.000e+00  "     
         $obj1     
         poids ~ taille     
         attr(,".Environment")     
         <environment: R_GlobalEnv>     
              
         $obj2     
         $obj2$coefficients     
         (Intercept)      taille     
         -74.4636321   0.8785688     
              
         $obj2$residuals     
                   1           2           3           4           5           6           7           8           9          10 [...]     
          -6.8030379  -7.8237829  -4.2237461   0.8533768  -7.1866306  -4.2887627 -12.7266380  15.8919382   1.5319456  -8.9059297     
                  42          43          44          45          46          47          48          49          50          51     
          -6.0509242 -15.6259518   8.0740482  -0.8516840 -11.6252289  -8.2909684   4.0897693  22.1105144 -12.5931005  11.0340776     
              
         $obj2$effects     
          (Intercept)       taille     
         -646.6037771   76.5574385   -4.6655445    1.0326892   -6.7784878   -4.2156928  -12.0896648   16.3818061    1.7929832  [...]     
              
           -0.5070168   -4.3095178  -15.8120189   -5.3976060  -14.1145199    9.5854801    1.2154788  -10.3834898   -6.2646682     
              
           -5.6621672  -15.4387817  -15.4380469   -4.4465814     
              
         $obj2$rank     
         [1] 2     
              
         $obj2$fitted.values     
                1        2        3        4        5        6        7        8        9       10       11       12       13  [...]     
         83.50304 73.22378 85.52375 78.84662 76.38663 79.98876 73.92664 75.50806 77.96805 71.90593 66.10738 77.96805 88.68659     
               56       57       58       59       60       61       62       63       64       65       66       67       68     
         69.88522 70.85165 63.64738 69.00665 66.98594 61.01168 66.98594 65.22881 60.74811 67.24952 56.26741 59.86954 76.38663     
              
         $obj2$assign     
         [1] 0 1     
              
         $obj2$qr     
         $qr     
            (Intercept)        taille     
         1   -8.9442719 -1.494051e+03     
         2    0.1118034  8.713881e+01     
         3    0.1118034 -1.581023e-01     
         4    0.1118034 -7.088517e-02     
         5    0.1118034 -3.875253e-02     
         6    0.1118034 -8.580390e-02     
         7    0.1118034 -6.619889e-03     
         8    0.1118034 -2.727659e-02     
         9    0.1118034 -5.940923e-02     
         10   0.1118034  1.977478e-02     
         [...]     
         70   0.1118034  6.338336e-02     
         71   0.1118034  1.035492e-01     
         72   0.1118034  1.448626e-01     
         73   0.1118034  2.355225e-01     
         74   0.1118034  8.977803e-02     
         75   0.1118034  1.678144e-01     
         76   0.1118034  3.698869e-02     
         77   0.1118034  1.299438e-01     
         78   0.1118034 -5.022847e-02     
         79   0.1118034 -2.153861e-02     
         80   0.1118034  2.699503e-01     
         attr(,"assign")     
         [1] 0 1     
              
         $qraux     
         [1] 1.111803 1.002561     
              
         $pivot     
         [1] 1 2     
              
         $tol     
         [1] 1e-07     
              
         $rank     
         [1] 2     
              
         attr(,"class")     
         [1] "qr"     
              
         $obj2$df.residual     
         [1] 78     
              
         $obj2$xlevels     
         named list()     
              
         $obj2$call     
         lm(formula = obj1)     
              
         $obj2$terms     
         poids ~ taille     
         attr(,"variables")     
         list(poids, taille)     
         attr(,"factors")     
                taille     
         poids       0     
         taille      1     
         attr(,"term.labels")     
         [1] "taille"     
         attr(,"order")     
         [1] 1     
         attr(,"intercept")     
         [1] 1     
         attr(,"response")     
         [1] 1     
         attr(,".Environment")     
         <environment: R_GlobalEnv>     
         attr(,"predvars")     
         list(poids, taille)     
         attr(,"dataClasses")     
             poids    taille     
         "numeric" "numeric"     
              
         $obj2$model     
            poids taille     
         1   76.7  179.8     
         2   65.4  168.1     
         3   81.3  182.1     
         4   79.7  174.5     
         5   69.2  171.7     
         6   75.7  175.8     
         7   61.2  168.9     
         8   91.4  170.7     
         9   79.5  173.5     
         10  63.0  166.6     
         [...]     
         70  81.6  162.8     
         71  67.0  159.3     
         72  51.2  155.7     
         73  88.7  147.8     
         74  56.3  160.5     
         75  61.2  153.7     
         76  64.1  165.1     
         77  56.2  157.0     
         78  61.5  172.7     
         79  59.1  170.2     
         80  45.7  144.8     
              
              
         $obj3     
         $obj3$Df     
         [1]  1 78     
              
         $obj3$`Sum Sq`     
         [1]  5861.041 13902.074     
              
         $obj3$`Mean Sq`     
         [1] 5861.0414  178.2317     
              
         $obj3$`F value`     
         [1] 32.88439       NA     
              
         $obj3$`Pr(>F)`     
         [1] 1.770625e-07           NA     
              
         attr(,"row.names")     
         [1] "taille"    "Residuals"     
         attr(,"heading")     
         [1] "Analysis of Variance Table\n" "Response: poids"     
              
         $obj4     
                Df              Sum Sq           Mean Sq            F value            Pr(>F)     
          "Min.   : 1.00  " "Min.   : 5861  " "Min.   : 178.2  " "Min.   :32.88  " "Min.   :1.771e-07  "     
          "1st Qu.:20.25  " "1st Qu.: 7871  " "1st Qu.:1598.9  " "1st Qu.:32.88  " "1st Qu.:1.771e-07  "     
          "Median :39.50  " "Median : 9882  " "Median :3019.6  " "Median :32.88  " "Median :1.771e-07  "     
          "Mean   :39.50  " "Mean   : 9882  " "Mean   :3019.6  " "Mean   :32.88  " "Mean   :1.771e-07  "     
          "3rd Qu.:58.75  " "3rd Qu.:11892  " "3rd Qu.:4440.3  " "3rd Qu.:32.88  " "3rd Qu.:1.771e-07  "     
          "Max.   :78.00  " "Max.   :13902  " "Max.   :5861.0  " "Max.   :32.88  " "Max.   :1.771e-07  "     
          NA                NA                NA                 "NA's   : 1.00  " "NA's   :1.000e+00  "     
              
              
    

    On peut vérifier avec notre fonction analyseObjet() que unclass() a enlevé une partie de la structure des données :

    
          her  <- lit.dar.wd("her.dar")     
              
          attach(her) # plus pratique ici que her$taille ou her[,"taille"]     
                      # et plus sûr que her[,3]     
              
          # --------------------------------------     
              
          obj1 <- poids ~ taille # plus "sensé" que taille~poids     
          obj2 <- lm( obj1 )     
          obj3 <- anova( obj2 )     
          obj4 <- summary( obj3 )     
              
          uobj1 <- unclass( obj1 )     
          uobj2 <- unclass( obj2 )     
          uobj3 <- unclass( obj3 )     
          uobj4 <- unclass( obj4 )     
              
          # --------------------------------------     
              
          analyseObjet <- function(x) {     
            return( c( paste(class(x),collapse=" "), typeof(x), mode(x), storage.mode(x) ) )     
          } # fin de fonction analyseObjet     
              
          mdr <- rbind( # matrice des résultats     
            analyseObjet(uobj1)  ,     
            analyseObjet(uobj2)  ,     
            analyseObjet(uobj3)  ,     
            analyseObjet(uobj4)     
            ) # fin de rbind     
              
          colnames(mdr)  <- c("class()","typeof()","mode()","storage.mode()")     
          row.names(mdr) <- paste("obj",sprintf("%02d",1:nrow(mdr)),sep="")     
          cat("\nVoici les caractéristiques des objets après unclass\n")     
          print( mdr, quote=FALSE )     
              
          cat("\nUne façon courte de voir les objets et leur type utilise ls.str() :\n")     
          ls.str(pattern="^uobj[0-9]*$")     
              
              
    
    
              
         Voici les caractéristiques des objets après unclass     
               class() typeof()  mode()    storage.mode()     
         obj01 call    language  call      language     
         obj02 list    list      list      list     
         obj03 list    list      list      list     
         obj04 matrix  character character character     
              
         Une façon courte de voir les objets et leur type utilise ls.str() :     
              
         uobj1 : length 3 poids ~ taille     
              
         uobj2 : List of 12     
          $ coefficients : Named num [1:2] -74.464 0.879     
          $ residuals    : Named num [1:80] -6.803 -7.824 -4.224 0.853 -7.187 ...     
          $ effects      : Named num [1:80] -646.6 76.56 -4.67 1.03 -6.78 ...     
          $ rank         : int 2     
          $ fitted.values: Named num [1:80] 83.5 73.2 85.5 78.8 76.4 ...     
          $ assign       : int [1:2] 0 1     
          $ qr           :List of 5     
          $ df.residual  : int 78     
          $ xlevels      : Named list()     
          $ call         : language lm(formula = obj1)     
          $ terms        :Classes 'terms', 'formula' length 3 poids ~ taille     
          $ model        :'data.frame':	80 obs. of  2 variables:     
              
         uobj3 : List of 5     
          $ Df     : int [1:2] 1 78     
          $ Sum Sq : num [1:2] 5861 13902     
          $ Mean Sq: num [1:2] 5861 178     
          $ F value: num [1:2] 32.9 NA     
          $ Pr(>F) : num [1:2] 1.77e-07 NA     
              
         uobj4 :  chr [1:7, 1:5] "Min.   : 1.00  " "1st Qu.:20.25  " "Median :39.50  " "Mean   :39.50  " "3rd Qu.:58.75  "     
         "Max.   :78.00  " NA "Min.   : 5861  " "1st Qu.: 7871  " "Median : 9882  " "Mean   : 9882  "     
         [...]     
              
    
  10. Pour un «bel» affichage des résidus, il faut d'abord enlever le mode ASK qui demande d'appuyer sur <Entrée> pour passer au graphique suivant. Comme c'est un paramètre graphique, il suffit d'écrire par(ask=FALSE). Nous avions vu, dans la correction de l'exercice 4 du cours 1, qu'il y avait une fonction nommée plot.lm(). La lecture de son fichier d'aide montre que son paramètre which permet de choisir le graphique voulu. Il suffit donc d'exécuter une boucle POUR de 1 à 6 pour tracer les diagnostics de résidus :

    
              
          plotResidus <- function(x,y,fichier="")  {     
              
            pdv <- 1:6 # plage de variation des 6 graphiques     
            par(ask=FALSE)     
            ml <- lm( y~x)     
            if (fichier!="") {     
              fichiers <- paste(fichier,pdv,".png",sep="")     
            } # fin si     
              
            for (idt in 1:6) {     
              if (fichier!="") {     
                gr( fichiers[idt] ) # gr() est une fonction (gH)     
              } # fin si     
              
              plot.lm(ml,which=idt)     
              
              if (fichier!="") {     
                dev.off()     
                cat("Fichier",fichiers[idt],"généré.\n")     
              } # fin si     
            } # fin pour idt     
              
          } # fin de fonction plotResidus     
              
          # exemples d'utilisation :     
              
          her  <- lit.dar.wd("her.dar")     
          plotResidus(her$taille,her$poids,fichier="")     
          plotResidus(her$taille,her$poids,fichier="residusHer")     
              
              
    
    
         Fichier residusHer1.png généré.     
         Fichier residusHer2.png généré.     
         Fichier residusHer3.png généré.     
         Fichier residusHer4.png généré.     
         Fichier residusHer5.png généré.     
         Fichier residusHer6.png généré.     
              
    
    her1.png

              

    her2.png

              

    her3.png

              

    her4.png

              

    her5.png

              

    her6.png

    Les graphiques ci-dessus utilisent des couleurs différentes pour les hommes et les femmes. Cela a été obtenu à l'aide de l'ellipse ajoutée en fin de fonction plotResidus(x,y,f) :

    
              
          plotResidus <- function(x,y,fichier="",...)  {     
              
            # ajouter l'ellipse permet de peaufiner le graphique,     
            # par exemple de mettres des couleurs pour les hommes     
            # et les femmes, pour les moins de 45 ans...     
              
            pdv <- 1:6 # plage de variation des 6 graphiques     
            par(ask=FALSE)     
            ml <- lm( y~x)     
            if (fichier!="") {     
              fichiers <- paste(fichier,pdv,".png",sep="")     
            } # fin si     
              
            for (idt in 1:6) {     
              if (fichier!="") {     
                gr( fichiers[idt] ) # gr() est une fonction (gH)     
              } # fin si     
              
              plot.lm(ml,which=idt,...)   # c'est ici qu'on utilise l'ellipse     
              
              if (fichier!="") {     
                dev.off()     
                cat("Fichier",fichiers[idt],"généré.\n")     
              } # fin si     
            } # fin pour idt     
              
          } # fin de fonction plotResidus     
              
          # exemples d'utilisation :     
              
          her             <- lit.dar.wd("her.dar")     
          couleurSexe     <- c("red","blue")     
          couleurSexeHer  <- couleurSexe[ her$sexe + 1 ]     
              
          plotResidus(x=her$taille,y=her$poids,fichier="her",bg=couleurSexeHer,pch=21)     
          # attention : legend ne s'applique qu'au dernier tracé, APRES la fonction     
          legend(x="topleft",legend=c("femme","homme"),pt.bg=couleurSexe,pch=21)     
              
          url  <- "http://forge.info.univ-angers.fr/~gh/wstat/Mef/wcgs.dar"     
          wcgs <- lit.dar(url)     
              
          # il est prudent de convertir les données en valeurs compréhensibles     
          # pour la France ; on rajoute aussi une classe d'age     
              
          wcgs2 <- transform(wcgs,     
            taille = HEIGHT*2.54,     
            poids  = WEIGHT*0.453592,     
            clage  = ifelse(AGE<45,0,1)     
          ) # fin de transform     
              
          couleurAge     <- c("green","orange")     
          couleurAgeWcgs <- couleurAge[ wcgs2$clage + 1 ]     
              
          # vérification de la transformation et tracé     
              
          print(tail(round(  wcgs2[,c("HEIGHT","taille","WEIGHT","poids","AGE","clage")],1 )))     
          plotResidus(wcgs2$taille,wcgs2$poids,fichier="residusWcgs",pch=21,bg=couleurAgeWcgs)     
              
              
    
    
         Fichier her1.png généré.     
         Fichier her2.png généré.     
         Fichier her3.png généré.     
         Fichier her4.png généré.     
         Fichier her5.png généré.     
         Fichier her6.png généré.     
              
                HEIGHT taille WEIGHT poids AGE clage     
         P02076     72  182.9    180  81.6  45     1     
         P06045     71  180.3    154  69.9  47     1     
         P03091     74  188.0    195  88.5  41     0     
         P10013     71  180.3    185  83.9  53     1     
         P13033     67  170.2    150  68.0  54     1     
         P10219     69  175.3    205  93.0  48     1     
              
         Fichier residusWcgs1.png généré.     
         Fichier residusWcgs2.png généré.     
         Fichier residusWcgs3.png généré.     
         Fichier residusWcgs4.png généré.     
         Fichier residusWcgs5.png généré.     
         Fichier residusWcgs6.png généré.     
              
    
    residusWcgs1.png

              

    residusWcgs2.png

              

    residusWcgs3.png

              

    residusWcgs4.png

              

    residusWcgs5.png

              

    residusWcgs6.png

    Il est en général utile d'ajouter l'ellipse à la fin de la liste des paramètres lorsqu'on définit une fonction qui produit un graphique, car cela permet d'ajouter des paramètres graphiques "à la volée".

  11. Voici une fonction d'affichage en colonnes possible :

    
         enColonnes <- function(vecteur,nbCol=4,largeur=7,nbDec=3) {     
              
           cat("Affichage des",length(vecteur)," valeurs de \"V\" sur",nbCol,     
                    " colonnes, largeur=",largeur," avec",nbDec,"décimales\n")     
           format <- paste(" %",largeur,".",nbDec,"f",sep="")     
           v      <- sprintf(format,vecteur)     
           for (ide in seq(v)) {     
             cat(v[ide]," ")     
             if ((ide%%nbCol)==0) { cat("\n") }     
           } # fin pour ide     
           cat("\n")     
              
         } # fin de fonction enColonnes     
              
              
    

    Pour un vecteur, on peut certainement s'en dispenser car avec options(width) et round() on peut faire tout aussi bien et même mieux puisqu'alors R affiche les indices de début de ligne :

    
         > options(width=80)     
         > print( round(va,3) )     
              
           [1] 0.073 0.676 0.691 0.069 0.257 0.701 0.919 0.260 0.019 0.937 0.470 0.598     
          [13] 0.842 0.954 0.275 0.742 0.112 0.597 0.234 0.655 0.943 0.306 0.282 0.680     
          [25] 0.049 0.750 0.318 0.100 0.536 0.057 0.132 0.095 0.090 0.806 0.500 0.538     
          [37] 0.624 0.855 0.916 0.437 0.068 0.454 0.307 0.004 0.439 0.163 0.569 0.524     
          [49] 0.023 0.847 0.803 0.277 0.440 0.694 0.467 0.936 0.469 0.934 0.163 0.310     
          [61] 0.477 0.754 0.608 0.844 0.134 0.102 0.622 0.496 0.486 0.010 0.614 0.796     
          [73] 0.231 0.877 0.333 0.665 0.660 0.108 0.937 0.615 0.761 0.330 0.394 0.990     
          [85] 0.290 0.192 0.805 0.489 0.797 0.018 0.747 0.712 0.241 0.122 0.936 0.795     
          [97] 0.326 0.971 0.933 0.878 0.314 0.518 0.021 0.505 0.240 0.999 0.744 0.284     
         [109] 0.125 0.807 0.361 0.361 0.137 0.150 0.210 0.493 0.651     
              
    

    Attention quand même au fait que R n'accepte pas d'afficher des milliers de lignes par défaut (voir options(max.print), message [getOption("max.print") est atteint --- n lignes omises]) mais ce peut être intéressant pour gagner de la place à l'affichage pour des «dataframes» avec peu de colonnes, comme nos données personnes.dar.

  12. Voici une implémentation d'une fonction pour visualiser tous les paramètres graphiques et son affichage complet :

    
         parPrint <- function() {     
              
         # mieux que : print( par() )     
         # sachant que ni sort( par() ) ni order( par() ) ne fonctionnent     
              
         lesPg <- par()     
         nomPg <- names(lesPg)     
         idx   <- order(nomPg)     
         nbElt <- length(lesPg)     
         matPg <- matrix(nrow=nbElt,ncol=3)     
         colnames(matPg) <- c("Paramètre","Longueur","Valeur")     
              
         for (idp in 1:nbElt) {     
           jdp          <- idx[idp]     
           matPg[idp,1] <- nomPg[jdp]     
           eltPg        <- lesPg[[jdp]]     
           lngElt       <- length(eltPg)     
           matPg[idp,2] <- lngElt     
           if (lngElt==1) {     
             if (is.na(eltPg)) {     
                eltPg <- "<<NA>>"     
             } # finsi     
             if (is.null(eltPg)) {     
                eltPg <- "<<nul>>"     
             } # finsi     
             if (eltPg=="") {     
                eltPg <- "<<vide>>"     
             } # finsi     
             matPg[idp,3] <- eltPg     
           } else {     
             if (is.numeric(eltPg)) {     
               eltPg <- round(eltPg,2)     
             } # finsi     
             strValeurPg  <- ghtrim(paste(eltPg,collapse=" "))     
             matPg[idp,3] <- strValeurPg     
           } # fin si     
         } # fin  pour idp     
              
         print(matPg,quote=FALSE)     
              
         } # fin de fonction parPrint     
              
              
    
    
               Paramètre Longueur Valeur     
          [1,] adj       1        0.5     
          [2,] ann       1        TRUE     
          [3,] ask       1        FALSE     
          [4,] bg        1        white     
          [5,] bty       1        o     
          [6,] cex       1        1     
          [7,] cex.axis  1        1     
          [8,] cex.lab   1        1     
          [9,] cex.main  1        1.20000004768372     
         [10,] cex.sub   1        1     
         [11,] cin       2        0.15 0.2     
         [12,] col       1        black     
         [13,] col.axis  1        black     
         [14,] col.lab   1        black     
         [15,] col.main  1        black     
         [16,] col.sub   1        black     
         [17,] cra       2        10.8 14.4     
         [18,] crt       1        0     
         [19,] csi       1        0.2     
         [20,] cxy       2        0.01 0.02     
         [21,] din       2        14 12.26     
         [22,] err       1        0     
         [23,] family    1        <<vide>>     
         [24,] fg        1        black     
         [25,] fig       4        0 1 0 1     
         [26,] fin       2        14 12.26     
         [27,] font      1        1     
         [28,] font.axis 1        1     
         [29,] font.lab  1        1     
         [30,] font.main 1        2     
         [31,] font.sub  1        1     
         [32,] lab       3        5 5 7     
         [33,] las       1        0     
         [34,] lend      1        round     
         [35,] lheight   1        1     
         [36,] ljoin     1        round     
         [37,] lmitre    1        10     
         [38,] lty       1        solid     
         [39,] lwd       1        1     
         [40,] mai       4        1.02 0.82 0.82 0.42     
         [41,] mar       4        5.1 4.1 4.1 2.1     
         [42,] mex       1        1     
         [43,] mfcol     2        1 1     
         [44,] mfg       4        1 1 1 1     
         [45,] mfrow     2        1 1     
         [46,] mgp       3        3 1 0     
         [47,] mkh       1        0.001     
         [48,] new       1        FALSE     
         [49,] oma       4        0 0 0 0     
         [50,] omd       4        0 1 0 1     
         [51,] omi       4        0 0 0 0     
         [52,] pch       1        1     
         [53,] pin       2        12.76 10.42     
         [54,] plt       4        0.06 0.97 0.08 0.93     
         [55,] ps        1        12     
         [56,] pty       1        m     
         [57,] smo       1        1     
         [58,] srt       1        0     
         [59,] tck       1        <<NA>>     
         [60,] tcl       1        -0.5     
         [61,] usr       4        0 1 0 1     
         [62,] xaxp      3        0 1 5     
         [63,] xaxs      1        r     
         [64,] xaxt      1        s     
         [65,] xlog      1        FALSE     
         [66,] xpd       1        FALSE     
         [67,] yaxp      3        0 1 5     
         [68,] yaxs      1        r     
         [69,] yaxt      1        s     
         [70,] ylbias    1        0.1     
         [71,] ylog      1        FALSE     
              
    

    Comme code d'une fonction qui affiche toutes les options de la configuration de R, nous vous proposons

    
         optionsPrint <- function(triType=FALSE) {     
              
         # mieux que options()     
         # sachant que ni sort( options() ) ni order( options() ) ne fonctionnent     
              
         lesOpt <- options()     
         leso   <- options()     
         nomOpt <- names(lesOpt)     
         typOpt <- lapply(X=lesOpt,FUN=typeof)     
         if (triType) {     
             idx    <- order(unlist(unname(as.vector(typOpt))),nomOpt)     
         } else {     
             idx    <- order(nomOpt)     
         } # finsi     
         nbElt  <- length(lesOpt)     
         matOpt <- matrix(nrow=nbElt,ncol=4)     
         colnames(matOpt) <- c("Option","Type","Longueur","Valeur")     
              
         for (idp in 1:nbElt) {     
           jdp           <- idx[idp]     
           matOpt[idp,1] <- nomOpt[jdp]     
           eltOpt        <- lesOpt[[jdp]]     
           lngElt        <- length(eltOpt)     
           matOpt[idp,2] <- typeof(eltOpt)     
           matOpt[idp,3] <- lngElt     
              
           if (typeof(eltOpt)=="closure") {     
              matOpt[idp,4] <-  "<<function...>>"     
           } else if (typeof(eltOpt)=="list") {     
              matOpt[idp,4] <-  paste(names(eltOpt),eltOpt,sep="=",collapse=" ")     
           } else {     
              if (lngElt==1) {     
                if (is.na(eltOpt)) {     
                   eltOpt <- "<<NA>>"     
                } # finsi     
                if (is.null(eltOpt)) {     
                   eltOpt <- "<<nul>>"     
                } # finsi     
                if (eltOpt=="") {     
                   eltOpt <- "<<vide>>"     
                } # finsi     
                matOpt[idp,4] <- eltOpt     
              } else {     
                if (is.numeric(eltOpt)) {     
                  eltOpt <- round(eltOpt,2)     
                } # finsi     
                strValeurPg  <- ghtrim(paste(eltOpt,collapse=" "))     
                matOpt[idp,4] <- strValeurPg     
              } # fin si     
           } # fin si     
         } # fin  pour idp     
              
         print(matOpt,quote=FALSE)     
              
         } # fin de fonction optionsPrint     
              
    
    
              
         Toutes les options par ordre alphabétique     
         =========================================     
              
               Option                Type      Longueur Valeur     
          [1,] add.smooth            logical   1        TRUE     
          [2,] bitmapType            character 1        cairo     
          [3,] browser               closure   1        <<function...>>     
          [4,] browserNLdisabled     logical   1        FALSE     
          [5,] check.bounds          logical   1        FALSE     
          [6,] continue              character 1        +     
          [7,] contrasts             character 2        contr.treatment contr.poly     
          [8,] defaultPackages       character 6        datasets utils grDevices graphics stats methods     
          [9,] demo.ask              character 1        default     
         [10,] device                character 1        RStudioGD     
         [11,] device.ask.default    logical   1        FALSE     
         [12,] digits                integer   1        7     
         [13,] dvipscmd              character 1        dvips     
         [14,] echo                  logical   1        TRUE     
         [15,] editor                character 1        vi     
         [16,] encoding              character 1        native.enc     
         [17,] example.ask           character 1        default     
         [18,] expressions           integer   1        5000     
         [19,] help.ports            integer   1        34298     
         [20,] help.search.types     character 3        vignette demo help     
         [21,] help.try.all.packages logical   1        FALSE     
         [22,] help_type             character 1        html     
         [23,] HTTPUserAgent         character 1        R (2.14.1 x86_64-pc-linux-gnu x86_64 linux-gnu)     
         [24,] internet.info         double    1        2     
         [25,] keep.source           logical   1        TRUE     
         [26,] keep.source.pkgs      logical   1        FALSE     
         [27,] locatorBell           logical   1        TRUE     
         [28,] mailer                character 1        mailto     
         [29,] max.print             double    1        10000     
         [30,] menu.graphics         logical   1        FALSE     
         [31,] na.action             character 1        na.omit     
         [32,] OutDec                character 1        .     
         [33,] pager                 character 1        /usr/lib64/R/bin/pager     
         [34,] papersize             character 1        a4     
         [35,] pdfviewer             character 1        /usr/bin/xdg-open     
         [36,] pkgType               character 1        source     
         [37,] printcmd              character 1        /usr/bin/lpr     
         [38,] prompt                character 1        >     
         [39,] repos                 character 1        http://cran.univ-lyon1.fr/     
         [40,] rl_word_breaks        character 1         \t\n"\\'`><=%;,|&{()}     
         [41,] scipen                double    1        0     
         [42,] show.coef.Pvalues     logical   1        TRUE     
         [43,] show.error.messages   logical   1        TRUE     
         [44,] show.signif.stars     logical   1        TRUE     
         [45,] str                   list      3        strict.width=no digits.d=3 vec.len=4     
         [46,] stringsAsFactors      logical   1        TRUE     
         [47,] texi2dvi              character 1        /usr/bin/texi2dvi     
         [48,] timeout               double    1        60     
         [49,] ts.eps                double    1        1e-05     
         [50,] ts.S.compat           logical   1        FALSE     
         [51,] unzip                 character 1        /usr/bin/unzip     
         [52,] useFancyQuotes        logical   1        TRUE     
         [53,] verbose               logical   1        FALSE     
         [54,] warn                  double    1        0     
         [55,] warning.length        integer   1        1000     
         [56,] width                 integer   1        150     
              
         Toutes les options par type puis par ordre alphabétique     
         =======================================================     
              
               Option                Type      Longueur Valeur     
          [1,] bitmapType            character 1        cairo     
          [2,] continue              character 1        +     
          [3,] contrasts             character 2        contr.treatment contr.poly     
          [4,] defaultPackages       character 6        datasets utils grDevices graphics stats methods     
          [5,] demo.ask              character 1        default     
          [6,] device                character 1        RStudioGD     
          [7,] dvipscmd              character 1        dvips     
          [8,] editor                character 1        vi     
          [9,] encoding              character 1        native.enc     
         [10,] example.ask           character 1        default     
         [11,] help.search.types     character 3        vignette demo help     
         [12,] help_type             character 1        html     
         [13,] HTTPUserAgent         character 1        R (2.14.1 x86_64-pc-linux-gnu x86_64 linux-gnu)     
         [14,] mailer                character 1        mailto     
         [15,] na.action             character 1        na.omit     
         [16,] OutDec                character 1        .     
         [17,] pager                 character 1        /usr/lib64/R/bin/pager     
         [18,] papersize             character 1        a4     
         [19,] pdfviewer             character 1        /usr/bin/xdg-open     
         [20,] pkgType               character 1        source     
         [21,] printcmd              character 1        /usr/bin/lpr     
         [22,] prompt                character 1        >     
         [23,] repos                 character 1        http://cran.univ-lyon1.fr/     
         [24,] rl_word_breaks        character 1         \t\n"\\'`><=%;,|&{()}     
         [25,] texi2dvi              character 1        /usr/bin/texi2dvi     
         [26,] unzip                 character 1        /usr/bin/unzip     
         [27,] browser               closure   1        <<function...>>     
         [28,] internet.info         double    1        2     
         [29,] max.print             double    1        10000     
         [30,] scipen                double    1        0     
         [31,] timeout               double    1        60     
         [32,] ts.eps                double    1        1e-05     
         [33,] warn                  double    1        0     
         [34,] digits                integer   1        7     
         [35,] expressions           integer   1        5000     
         [36,] help.ports            integer   1        34298     
         [37,] warning.length        integer   1        1000     
         [38,] width                 integer   1        150     
         [39,] str                   list      3        strict.width=no digits.d=3 vec.len=4     
         [40,] add.smooth            logical   1        TRUE     
         [41,] browserNLdisabled     logical   1        FALSE     
         [42,] check.bounds          logical   1        FALSE     
         [43,] device.ask.default    logical   1        FALSE     
         [44,] echo                  logical   1        TRUE     
         [45,] help.try.all.packages logical   1        FALSE     
         [46,] keep.source           logical   1        TRUE     
         [47,] keep.source.pkgs      logical   1        FALSE     
         [48,] locatorBell           logical   1        TRUE     
         [49,] menu.graphics         logical   1        FALSE     
         [50,] show.coef.Pvalues     logical   1        TRUE     
         [51,] show.error.messages   logical   1        TRUE     
         [52,] show.signif.stars     logical   1        TRUE     
         [53,] stringsAsFactors      logical   1        TRUE     
         [54,] ts.S.compat           logical   1        FALSE     
         [55,] useFancyQuotes        logical   1        TRUE     
         [56,] verbose               logical   1        FALSE     
              
    
  13. A notre connaissance, il n'y a que deux ouvrages qui traitent de R et SAS :

    non su non su
    Kleinman & Horton Muenchen

    La programmation en R et en Sas est très différente. En particulier, le langage de base de Sas ne travaille que sur des datasets et on n'a pas accès à des variables en mémoire comme sous R. Il n'y a pas de boucle ni de tests en Sas, sauf dans la "proc data" ou sauf à utiliser le langage des macros. Et encore, on ne dispose pas de listes ni de vecteurs, sauf à passer systématiquement par du découpage de chaines de caractères... Depuis SAS 9.0, on peut utiliser ODS pour accéder à tous les objets (variables et tableaux) produits, mais cela reste assez rigide et "lourd" à exécuter, voire fastidieux.

    Voir par exemple code SAS et macros SAS.

 

 

retour gH    Retour à la page principale de   (gH)