Packages

library(car) # pour leveneTest
library(psych) # pour describeBy
library(gplots) # pour plotmeans
library(ez) # pour ezANOVA, ezStats, ezPlot
library(ggpubr) # pour ggboxplot
library(phia) # pour testInteractions
library(RVAideMemoire) # pour cochran.qtest
library(ellipse) # pour plotcorr
library(corrplot) # pour corrplot
library(reshape2) # pour melt

Tests t de Student

un seul échantillon

Pour examiner les effets du tabagisme sur les performances, des chercheurs ont utilisé une tâche cognitive qui amenait les sujets, fumeurs actifs pendant l’exécution de la tâche ou juste avant, à lire un passage pour se le remémorer par la suite. Les nombres d’erreurs commises par 25 sujets ayant participé à l’expérience sont les suivants. Le nombre moyen d’erreurs commises dans la population des non-fumeurs est de 40.

erreurs <- data.frame(nb_erreurs = c(34, 65, 55, 33, 42, 54, 21, 44, 40, 42, 38, 50, 36, 61, 38, 75, 61, 51, 32, 47, 20, 25, 35, 30, 32))

la norme est de 40.

normalité

shapiro.test(erreurs$nb_erreurs)
## 
##  Shapiro-Wilk normality test
## 
## data:  erreurs$nb_erreurs
## W = 0.96924, p-value = 0.6259

le test t

t.test(erreurs, mu = 40, alternative = "greater")
## 
##  One Sample t-test
## 
## data:  erreurs
## t = 0.87684, df = 24, p-value = 0.1946
## alternative hypothesis: true mean is greater than 40
## 95 percent confidence interval:
##  37.67907      Inf
## sample estimates:
## mean of x 
##     42.44

S<A2>

Un psychologue a remarqué que les personnes qui fumaient le plus avaient tendance à contracter plus de rhumes que les fumeurs légers. Voici le nombre de rhumes contractés dans l’année dans un échantillon de 6 gros fumeurs et dans un échantillon de 7 fumeurs légers.

tabagisme <- data.frame(fumeurs = c(rep("gros", 6), rep("legers", 7)),rhumes = c(6, 4, 6, 4, 5, 5, 2, 1, 2, 7, 3, 4, 0))

normalité

tapply(tabagisme$rhumes,tabagisme$fumeurs,shapiro.test)
## $gros
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.85319, p-value = 0.167
## 
## 
## $legers
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.93192, p-value = 0.5674

Levene (homogénéité des variances)

nécessite car

leveneTest(rhumes ~ fumeurs, data = tabagisme)
## Warning in leveneTest.default(y = y, group = group, ...): group coerced to
## factor.
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  1.5273 0.2423
##       11

le test t

t.test(rhumes ~ fumeurs, data = tabagisme, var.equal = TRUE, alternative = "greater")
## 
##  Two Sample t-test
## 
## data:  rhumes by fumeurs
## t = 2.2893, df = 11, p-value = 0.02142
## alternative hypothesis: true difference in means between group gros and group legers is greater than 0
## 95 percent confidence interval:
##  0.4926082       Inf
## sample estimates:
##   mean in group gros mean in group legers 
##             5.000000             2.714286

S×A2

Une étude a pour but de mettre en évidence le fait qu’un lecteur se souviendra d’un plus grand nombre de mots dans un texte simple que dans un texte complexe. Pour valider cette hypothèse de recherche, on demande à 10 sujets de lire un texte simple, puis un texte complexe et pour chaque texte, de restituer les mots du texte. Les données sont le nombre de mots correctement restitués.

rappels <- data.frame(sujet = c(rep(c("s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10"), 2)), texte = c(rep("simple", 10), rep("complexe", 10)), mots = c(10, 5, 6, 3, 9, 8, 7, 5, 6, 5, 2, 1, 7, 4, 4, 5, 2, 5, 3, 4))

normalité des différences

texte_simple <- subset(rappels, texte == "simple")  # on extrait le premier groupe
texte_complexe <- subset(rappels, texte == "complexe")  # on extrait le deuxieme groupe
diff <- texte_simple$mots - texte_complexe$mots  # difference entre les deux conditions
shapiro.test(diff)
## 
##  Shapiro-Wilk normality test
## 
## data:  diff
## W = 0.94201, p-value = 0.5756

le test t

t.test(mots ~ texte, data = rappels, paired = TRUE, alternative = "less")  # test de Student
## 
##  Paired t-test
## 
## data:  mots by texte
## t = -2.8984, df = 9, p-value = 0.008821
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
##        -Inf -0.9923711
## sample estimates:
## mean of the differences 
##                    -2.7

Tests du chi-deux

Chi-deux, échantillons indépendants

Neyzi, Alp et Ohron (1975) se sont intéressés à l’effet de la classe socio-économique sur le développement physique des enfants turcs. Le développement physique était classifié sur une échelle de dp1 (aucun) à dp3 (développement complet) et la classe socio-économique des parents sur une échelle de dse1 à dse4.

donnees<-read.csv("developpement_physique.csv")
head(donnees)
##    DP  CSE
## 1 dp1 cse1
## 2 dp1 cse1
## 3 dp1 cse1
## 4 dp1 cse1
## 5 dp1 cse1
## 6 dp1 cse1

tableau de contingence

M<-table(donnees)
M
##      CSE
## DP    cse1 cse2 cse3 cse4
##   dp1   16   22   13   23
##   dp2   28   25   12   34
##   dp3   58   34   14   39

Visualisation graphique avec mosaicplot

mosaicplot(M,col=c("yellow","blue","red","green"))

test du chi-deux

chisq.test(M)
## 
##  Pearson's Chi-squared test
## 
## data:  M
## X-squared = 10.175, df = 6, p-value = 0.1175

effectifs théoriques

chisq.test(M)$expected
##      CSE
## DP        cse1     cse2      cse3     cse4
##   dp1 23.73585 18.84906  9.075472 22.33962
##   dp2 31.75472 25.21698 12.141509 29.88679
##   dp3 46.50943 36.93396 17.783019 43.77358

Test exact de Fisher

Quand au moins un effectif théorique est inférieur à 5. Efficace pour des tableaux 2x2.

On a un échantillon de 22 adolescents, que l’on sépare entre filles et garçons et entre ceux qui suivent un régime et ceux qui n’en suivent pas. L’hypothèse est que la proportion de filles qui suivent un régime est différente de celle des garçons.

regime<-read.csv("regime.csv")
head(regime)
##    genre regime
## 1 garcon    oui
## 2 garcon    non
## 3 garcon    non
## 4 garcon    non
## 5 garcon    non
## 6 garcon    non
table(regime)
##         regime
## genre    non oui
##   fille    2   8
##   garcon  11   1
chisq.test(table(regime))$expected
## Warning in chisq.test(table(regime)): Chi-squared approximation may be incorrect
##         regime
## genre         non      oui
##   fille  5.909091 4.090909
##   garcon 7.090909 4.909091
fisher.test(table(regime))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(regime)
## p-value = 0.001548
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.000480319 0.387238240
## sample estimates:
## odds ratio 
## 0.03007533

Chi-deux de Mc Nemar

Dans le cadre d’une étude sur le tabagisme chez la femme enceinte, on interroge 100 sujets au 3e et au 8e mois de grossesse. On obtient les résultats suivants.

tabagisme_femme_enceinte<-read.csv("tabagisme_femme_enceinte.csv")
head(tabagisme_femme_enceinte)
##   X3eme_mois X8eme_mois
## 1        non        oui
## 2        non        oui
## 3        non        oui
## 4        non        oui
## 5        non        oui
## 6        oui        oui
table(tabagisme_femme_enceinte)
##           X8eme_mois
## X3eme_mois non oui
##        non  45   5
##        oui  15  35
mcnemar.test(table(tabagisme_femme_enceinte))
## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  table(tabagisme_femme_enceinte)
## McNemar's chi-squared = 4.05, df = 1, p-value = 0.04417

Tests non paramétriques

Wilcoxon, un échantillon

Pour examiner les effets du tabagisme sur les performances, des chercheurs ont utilisé une tâche cognitive qui amenait les sujets, fumeurs actifs pendant l’exécution de la tâche ou juste avant, à lire un passage pour se le remémorer par la suite. Les nombres d’erreurs commises par 25 sujets ayant participé à l’expérience sont les suivants :

npex1<-data.frame(nb_erreurs=c(60,65,55,63,52,64,61,64,20,42,38,50,36,61,38,75,61,31,
    22,47,20,25,25,20,22))
head(npex1)
##   nb_erreurs
## 1         60
## 2         65
## 3         55
## 4         63
## 5         52
## 6         64
wilcox.test(npex1$nb_erreurs,mu=40,alternative="greater")
## Warning in wilcox.test.default(npex1$nb_erreurs, mu = 40, alternative =
## "greater"): cannot compute exact p-value with ties
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  npex1$nb_erreurs
## V = 219.5, p-value = 0.06402
## alternative hypothesis: true location is greater than 40

Wilcoxon Mann Whitney S<A2>

Un psychologue note le temps (en s) mis par des enfants, dont 7 sont considérés comme normaux et 8 comme mentalement retardés, pour accomplir une série de tâches manuelles simples.

npex2<-data.frame(vi_npex2=c(rep("normaux",7),rep("retardes",8)),vd_npex2=c(224,218,187,
    183,227,233,231,243,228,261,202,270,242,220,239))
head(npex2)
##   vi_npex2 vd_npex2
## 1  normaux      224
## 2  normaux      218
## 3  normaux      187
## 4  normaux      183
## 5  normaux      227
## 6  normaux      233
wilcox.test(vd_npex2~vi_npex2,alternative="less",data=npex2)
## 
##  Wilcoxon rank sum exact test
## 
## data:  vd_npex2 by vi_npex2
## W = 11, p-value = 0.02704
## alternative hypothesis: true location shift is less than 0

Wilcoxon apparié S×A2

Hollander et Wolfe (1973) ont mesuré un indice de dépression (Hamilton index) chez 9 patients victimes de dépression et d’anxiété avant et après le début d’une thérapie (administration de tranquilisants). Les chercheurs attendent une baisse de l’indice en cas de réussite.

npex3<-data.frame(sujet=rep(c("s1","s2","s3","s4","s5","s6","s7","s8","s9"),2),vi_npex3=
    c(rep("avant",9),rep("apres",9)),vd_npex3=c(1.83,0.5,1.62,2.08,1.68,1.88,1.05,
    3.06,1.3,0.878,0.547,0.598,2.05,1.06,1.29,1.06,3.14,1.29))
head(npex3)
##   sujet vi_npex3 vd_npex3
## 1    s1    avant     1.83
## 2    s2    avant     0.50
## 3    s3    avant     1.62
## 4    s4    avant     2.08
## 5    s5    avant     1.68
## 6    s6    avant     1.88
wilcox.test(vd_npex3~vi_npex3,alternative="less",paired=TRUE,data=npex3)
## Warning in wilcox.test.default(x = c(0.878, 0.547, 0.598, 2.05, 1.06, 1.29, :
## cannot compute exact p-value with ties
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  vd_npex3 by vi_npex3
## V = 10.5, p-value = 0.08635
## alternative hypothesis: true location shift is less than 0

Kruskal-Wallis S<An>

Le tableau suivant rassemble des données hypothétiques concernant trois méthodes utilisées pour réduire le stress chez 30 sujets. La première est basée sur un travail mental, la deuxième sur un entraînement physique et la troisième sur l’utilisation de médicaments. Les valeurs représentent l’efficacité de chaque méthode à réduire le stress. Plus une valeur est élevée, plus l’efficacité est grande.

npex4<-data.frame(vi_npex4=c(rep("mentale",10),rep("physique",10),rep("medicale",10)),vd_npex4=c(2,2,3,5,5,5,2,2,5,5,4,4,3,5,4,1,1,2,3,3,1,2,2,2,3,2,3,1,3,1))
head(npex4)
##   vi_npex4 vd_npex4
## 1  mentale        2
## 2  mentale        2
## 3  mentale        3
## 4  mentale        5
## 5  mentale        5
## 6  mentale        5
kruskal.test(vd_npex4~vi_npex4,data=npex4)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  vd_npex4 by vi_npex4
## Kruskal-Wallis chi-squared = 6.0948, df = 2, p-value = 0.04748

Friedman S×An

Une chercheuse s’intéresse à l’effet de l’âge sur les fonctions cognitives. Elle fait passer le Digit symbol subtest du WAIS à 8 sujets tous les 5 ans entre 60 et 70 ans : avant la retraite à 60 ans et après la retraite à 65 et 70 ans.

npex5<-data.frame(sujet=rep(c("s1","s2","s3","s4","s5","s6","s7","s8"),3),vi_npex5=c(rep
    ("60ans",8),rep("65ans",8),rep("70ans",8)),vd_npex5=c(55,63,49,51,44,50,60,55,
    50,60,51,50,39,50,57,54,45,53,47,47,34,47,50,48))
head(npex5)
##   sujet vi_npex5 vd_npex5
## 1    s1    60ans       55
## 2    s2    60ans       63
## 3    s3    60ans       49
## 4    s4    60ans       51
## 5    s5    60ans       44
## 6    s6    60ans       50
friedman.test(vd_npex5~vi_npex5|sujet,data=npex5)
## 
##  Friedman rank sum test
## 
## data:  vd_npex5 and vi_npex5 and sujet
## Friedman chi-squared = 14, df = 2, p-value = 0.0009119

Test Q de Cochran

Nous nous intéressons à l’influence du style d’interview sur les réponses des sujets à une enquête d’opinion. Nous pourrions entraîner un enquêteur a mener trois types différents d’interviews :

  • Interview 1 : intérêt, ton amical, enthousiasme,
  • Interview 2 : formalisme, réserve, courtoisie,
  • Interview 3 : manque d’interêt, ton abrupt, formalisme pesant.

L’enquêteur visite ensuite trois groupes de 18 foyers, et utilise le style 1 avec un groupe, le style 2 avec le 2e groupe et le style 3 avec le dernier groupe. Nous obtenons ainsi 18 triplets de foyers, comprenant chacun 3 foyers appariés selon des variables pertinentes. Pour chaque triplet, les trois élements sont afféctés au hasard aux trois conditions (styles d’interview). Nous mesurons ensuite l’effet du style d’interview en notant la réponse faite (oui/non) à un item particulier. Les données brutes en format long

style_interview<-read.csv("style_interview.csv")
head(style_interview)
##   triplet  style reponse
## 1     t01 style1       0
## 2     t02 style1       1
## 3     t03 style1       0
## 4     t04 style1       0
## 5     t05 style1       1
## 6     t06 style1       1

en format court

style_interview_court<-xtabs(reponse~triplet+style,data=style_interview)
head(style_interview_court)
##        style
## triplet style1 style2 style3
##     t01      0      0      0
##     t02      1      1      0
##     t03      0      1      0
##     t04      0      0      0
##     t05      1      0      0
##     t06      1      1      0

on peut aller du court au long avec melt

style_interview_long<-melt(style_interview_court)
head(style_interview_long)
##   triplet  style value
## 1     t01 style1     0
## 2     t02 style1     1
## 3     t03 style1     0
## 4     t04 style1     0
## 5     t05 style1     1
## 6     t06 style1     1

le tableau de contingence, deux possibilités, avec table en enlevant la première colonne au format long, ou avec xtabs

tableau1<-table(style_interview[,-1])
tableau1
##         reponse
## style     0  1
##   style1  5 13
##   style2  5 13
##   style3 15  3
tableau2<-xtabs(~style+reponse,data=style_interview)
tableau2
##         reponse
## style     0  1
##   style1  5 13
##   style2  5 13
##   style3 15  3
mosaicplot(tableau2,color=c("blue","white"))

Test Q de Cochran

nécessite RVAideMemoire

cochran.qtest(reponse~style|triplet,data=style_interview)
## 
##  Cochran's Q test
## 
## data:  reponse by style, block = triplet 
## Q = 16.6667, df = 2, p-value = 0.0002404
## alternative hypothesis: true difference in probabilities is not equal to 0 
## sample estimates:
## proba in group             <NA>            <NA> 
##       0.7222222       0.7222222       0.1666667

Anova S<An>

Un test de vocabulaire de 50 item est fait passer à 24 étudiants après une année d’étude d’une langue étrangère. Les étudiants sont divisés en trois groupes égaux selon leur méthode d’apprentissage : méthode auditive-orale (A), méthode basée sur la traduction (T) et méthode combinée (C). On s’intéresse au nombre de réponses justes au test.

vocabulaire<-data.frame(methode=c(rep("A",8),rep("T",8),rep("C",8)),resultat=c(37,30,26,31,32,19,37,28,27,24,22,19,20,23,14,15,20,31,24,21,17,18,23,18),stringsAsFactors=TRUE)
vocabulaire
##    methode resultat
## 1        A       37
## 2        A       30
## 3        A       26
## 4        A       31
## 5        A       32
## 6        A       19
## 7        A       37
## 8        A       28
## 9        T       27
## 10       T       24
## 11       T       22
## 12       T       19
## 13       T       20
## 14       T       23
## 15       T       14
## 16       T       15
## 17       C       20
## 18       C       31
## 19       C       24
## 20       C       21
## 21       C       17
## 22       C       18
## 23       C       23
## 24       C       18

représentation graphique

boxplot(resultat~methode,data=vocabulaire)

description quantitative

nécéssite psych

describeBy(vocabulaire$resultat,vocabulaire$methode)
## 
##  Descriptive statistics by group 
## group: A
##    vars n mean  sd median trimmed  mad min max range  skew kurtosis   se
## X1    1 8   30 5.9   30.5      30 5.19  19  37    18 -0.43    -0.97 2.09
## ------------------------------------------------------------ 
## group: C
##    vars n mean   sd median trimmed  mad min max range skew kurtosis   se
## X1    1 8 21.5 4.57   20.5    21.5 3.71  17  31    14 0.91    -0.44 1.61
## ------------------------------------------------------------ 
## group: T
##    vars n mean   sd median trimmed  mad min max range  skew kurtosis   se
## X1    1 8 20.5 4.44     21    20.5 3.71  14  27    13 -0.15    -1.49 1.57

normalité

tapply(vocabulaire$resultat,vocabulaire$methode,shapiro.test)
## $A
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.93786, p-value = 0.5901
## 
## 
## $C
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.8747, p-value = 0.1675
## 
## 
## $T
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.96266, p-value = 0.835

homogénéité des variances

nécessite car

leveneTest(resultat~methode,data=vocabulaire)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  2  0.2136 0.8094
##       21

représentation graphique des moyennes des groupes

nécessite gplots

plotmeans(resultat~methode,data=vocabulaire)

l’anova

anova1<-aov(resultat~methode,data=vocabulaire)
summary(anova1)
##             Df Sum Sq Mean Sq F value Pr(>F)   
## methode      2    436  218.00    8.67 0.0018 **
## Residuals   21    528   25.14                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

normalité des résidus

shapiro.test(anova1$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  anova1$residuals
## W = 0.98424, p-value = 0.9595

les contrastes

on vérifie l’ordre des modalités de la VI

levels(vocabulaire$methode)
## [1] "A" "C" "T"

Pour faire les deux contrastes suivants:

  • C vs A,T
  • A vs T

on entre les coefficients

c1<-c(-1,2,-1)
c2<-c(-1,0,1)
mat<-cbind(c1,c2)
mat
##      c1 c2
## [1,] -1 -1
## [2,]  2  0
## [3,] -1  1

et on indique les contrastes et on relance l’anova

contrasts(vocabulaire$methode)<-mat
anova2<-aov(resultat~methode,data=vocabulaire)
summary(anova2,split=list(methode=list("C vs A,T"=1,"A vs T"=2)))
##                     Df Sum Sq Mean Sq F value  Pr(>F)   
## methode              2    436   218.0   8.670 0.00180 **
##   methode: C vs A,T  1     75    75.0   2.983 0.09883 . 
##   methode: A vs T    1    361   361.0  14.358 0.00107 **
## Residuals           21    528    25.1                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Test post-hoc (Tukey)

TukeyHSD(anova1)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = resultat ~ methode, data = vocabulaire)
## 
## $methode
##     diff        lwr       upr    p adj
## C-A -8.5 -14.819404 -2.180596 0.007452
## T-A -9.5 -15.819404 -3.180596 0.002957
## T-C -1.0  -7.319404  5.319404 0.916388

Anova S×An

Dans une expérience sur les techniques graphiques, on demande à chacun des 10 participants experts dans l’art du dessin de reproduire un portrait en utilisant successivement un crayon, un pinceau ou un feutre. L’esthétisme des dessins, évalué par un groupe de juges, apparaît dans le tableau ci-dessous (une note plus élevée correspond à un esthétisme plus élevé).

esthetisme<-data.frame(sujet=rep(c("S1","S2","S3","S4","s5","S6","S7","S8","S9",
"S10"),3),outil=c(rep("crayon",10),rep("pinceau",10),rep("feutre",10)),note=c(10,18,
20,12,19,25,18,22,17,23,12,10,15,10,20,22,16,18,14,20,14,16,16,12,21,20,17,18,12,18),stringsAsFactors=TRUE)
esthetisme
##    sujet   outil note
## 1     S1  crayon   10
## 2     S2  crayon   18
## 3     S3  crayon   20
## 4     S4  crayon   12
## 5     s5  crayon   19
## 6     S6  crayon   25
## 7     S7  crayon   18
## 8     S8  crayon   22
## 9     S9  crayon   17
## 10   S10  crayon   23
## 11    S1 pinceau   12
## 12    S2 pinceau   10
## 13    S3 pinceau   15
## 14    S4 pinceau   10
## 15    s5 pinceau   20
## 16    S6 pinceau   22
## 17    S7 pinceau   16
## 18    S8 pinceau   18
## 19    S9 pinceau   14
## 20   S10 pinceau   20
## 21    S1  feutre   14
## 22    S2  feutre   16
## 23    S3  feutre   16
## 24    S4  feutre   12
## 25    s5  feutre   21
## 26    S6  feutre   20
## 27    S7  feutre   17
## 28    S8  feutre   18
## 29    S9  feutre   12
## 30   S10  feutre   18

description quantitative

nécessite ez

ezStats(esthetisme,wid=.(sujet),dv=.(note),within=.(outil))
##     outil  N Mean       SD     FLSD
## 1  crayon 10 18.4 4.647580 1.888667
## 2  feutre 10 16.4 3.062316 1.888667
## 3 pinceau 10 15.7 4.270051 1.888667

normalité

tapply(esthetisme$note,esthetisme$outil,shapiro.test)
## $crayon
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.9489, p-value = 0.6555
## 
## 
## $feutre
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.94659, p-value = 0.6284
## 
## 
## $pinceau
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.94006, p-value = 0.5537

homogénéité des covariances et anova

nécessite ez

ezANOVA(esthetisme,wid=.(sujet),dv=.(note),within=.(outil))
## $ANOVA
##   Effect DFn DFd        F          p p<.05        ges
## 2  outil   2  18 4.858845 0.02054183     * 0.08143795
## 
## $`Mauchly's Test for Sphericity`
##   Effect         W         p p<.05
## 2  outil 0.9094155 0.6839895      
## 
## $`Sphericity Corrections`
##   Effect       GGe   p[GG] p[GG]<.05      HFe      p[HF] p[HF]<.05
## 2  outil 0.9169395 0.02415         * 1.140002 0.02054183         *

anova avec la fonction aov

anova_exemple2<-aov(note~outil+Error(sujet/outil),data=esthetisme)
summary(anova_exemple2)
## 
## Error: sujet
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals  9  370.2   41.13               
## 
## Error: sujet:outil
##           Df Sum Sq Mean Sq F value Pr(>F)  
## outil      2  39.27  19.633   4.859 0.0205 *
## Residuals 18  72.73   4.041                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

représentation graphique des moyennes des groupes

nécessite ez

ezPlot(esthetisme,wid=.(sujet),dv=.(note),within=.(outil),x=.(outil))

Anova S<A×B>

Dans une expérience sur la mémoire verbale, un chercheur étudie les effets du niveau d’association entre les mots (bas, moyen, élevé) et de la longueur de la liste de mots à mémoriser (8, 12, 16 mots) sur le nombre de mots mémorisés par les participants. Neuf groupes indépendants sont soumis à l’expérience.

memoire<-data.frame(longueur=c(rep("8mots",12),rep("12mots",12),rep("16mots",12)),
association=c(rep("elevee",4),rep("moyenne",4),rep("basse",4),rep("elevee",4),
rep("moyenne",4),rep("basse",4),rep("elevee",4),rep("moyenne",4),rep("basse",4)),
nombre=c(8,7,8,8,6,5,6,6,6,3,3,5,12,12,11,12,11,9,8,10,5,8,6,5,10,10,13,11,12,14,
13,10,10,12,10,11),stringsAsFactors=TRUE)
memoire
##    longueur association nombre
## 1     8mots      elevee      8
## 2     8mots      elevee      7
## 3     8mots      elevee      8
## 4     8mots      elevee      8
## 5     8mots     moyenne      6
## 6     8mots     moyenne      5
## 7     8mots     moyenne      6
## 8     8mots     moyenne      6
## 9     8mots       basse      6
## 10    8mots       basse      3
## 11    8mots       basse      3
## 12    8mots       basse      5
## 13   12mots      elevee     12
## 14   12mots      elevee     12
## 15   12mots      elevee     11
## 16   12mots      elevee     12
## 17   12mots     moyenne     11
## 18   12mots     moyenne      9
## 19   12mots     moyenne      8
## 20   12mots     moyenne     10
## 21   12mots       basse      5
## 22   12mots       basse      8
## 23   12mots       basse      6
## 24   12mots       basse      5
## 25   16mots      elevee     10
## 26   16mots      elevee     10
## 27   16mots      elevee     13
## 28   16mots      elevee     11
## 29   16mots     moyenne     12
## 30   16mots     moyenne     14
## 31   16mots     moyenne     13
## 32   16mots     moyenne     10
## 33   16mots       basse     10
## 34   16mots       basse     12
## 35   16mots       basse     10
## 36   16mots       basse     11

de beaux boxplot

nécessite ggpubr

bxp<-ggboxplot(memoire,x="longueur",y="nombre",color="association")
bxp

homogénéité des variances

leveneTest(nombre~longueur*association,data=memoire)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  8  1.4306 0.2291
##       27

normalité par groupes

tapply(memoire$nombre,interaction(memoire$longueur,memoire$association),shapiro.test)
## $`12mots.basse`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.82743, p-value = 0.1612
## 
## 
## $`16mots.basse`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.86337, p-value = 0.2725
## 
## 
## $`8mots.basse`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.8494, p-value = 0.2242
## 
## 
## $`12mots.elevee`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.62978, p-value = 0.001241
## 
## 
## $`16mots.elevee`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.82743, p-value = 0.1612
## 
## 
## $`8mots.elevee`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.62978, p-value = 0.001241
## 
## 
## $`12mots.moyenne`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.99291, p-value = 0.9719
## 
## 
## $`16mots.moyenne`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.97137, p-value = 0.85
## 
## 
## $`8mots.moyenne`
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.62978, p-value = 0.001241

graphique pour l’interaction

attach(memoire)
interaction.plot(longueur,association,nombre,type="l",col=c(1:3))

detach(memoire)

anova

anova_memoire<-aov(nombre~longueur*association,data=memoire)
summary(anova_memoire)
##                      Df Sum Sq Mean Sq F value   Pr(>F)    
## longueur              2 177.72   88.86   63.98 5.69e-11 ***
## association           2  62.89   31.44   22.64 1.69e-06 ***
## longueur:association  4  34.11    8.53    6.14   0.0012 ** 
## Residuals            27  37.50    1.39                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

effets simples

nécessite phia

testInteractions(anova_memoire,fixed="association",across="longueur",adjustement="holm")
## F Test: 
## P-value adjustment method: holm
##           longueur1 longueur2 Df Sum of Sq     F    Pr(>F)    
##   basse        1.75      6.50  2    90.500 32.58 1.902e-07 ***
##  elevee        4.00      3.25  2    36.167 13.02   0.00011 ***
## moyenne        3.75      6.50  2    85.167 30.66 2.252e-07 ***
## Residuals                     27    37.500                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Anova S×A×B

Une entreprise a créé un nouveau programme d’entraînement pour son service client. Pour tester l’efficacité de ce programme, un échantillon de dix employés a été tiré au hasard et on a mesuré leurs performances dans trois domaines : produit (connaissance des produits et services de l’entreprise), client (capacité à traiter le client avec politesse et empathie) et action (capacité à prendre des initiatives pour aider le client). Ces dix employés ont suivi le nouveau programme d’entraînement et on a mesuré à nouveau leurs performances dans ces trois domaines.

sujet<-rep(c("s1","s2","s3","s4","s5","s6","s7","s8","s9","s10"),6)
domaine<-c(rep("produit",10),rep("client",10),rep("action",10),rep("produit",10),
rep("client",10),rep("action",10))
moment<-c(rep("avant",30),rep("apres",30))
vd_ex4<-c(13,12,17,12,19,6,17,18,23,18,12,19,19,25,27,12,18,29,30,12,17,18,24,25,19,
6,30,36,24,24,18,6,21,18,18,6,24,22,1,24,30,18,31,39,28,18,36,36,38,25,34,30,32,40,
27,23,38,40,32,34)
ex4<-data.frame(sujet,domaine,moment,vd_ex4,stringsAsFactors=TRUE)
ex4
##    sujet domaine moment vd_ex4
## 1     s1 produit  avant     13
## 2     s2 produit  avant     12
## 3     s3 produit  avant     17
## 4     s4 produit  avant     12
## 5     s5 produit  avant     19
## 6     s6 produit  avant      6
## 7     s7 produit  avant     17
## 8     s8 produit  avant     18
## 9     s9 produit  avant     23
## 10   s10 produit  avant     18
## 11    s1  client  avant     12
## 12    s2  client  avant     19
## 13    s3  client  avant     19
## 14    s4  client  avant     25
## 15    s5  client  avant     27
## 16    s6  client  avant     12
## 17    s7  client  avant     18
## 18    s8  client  avant     29
## 19    s9  client  avant     30
## 20   s10  client  avant     12
## 21    s1  action  avant     17
## 22    s2  action  avant     18
## 23    s3  action  avant     24
## 24    s4  action  avant     25
## 25    s5  action  avant     19
## 26    s6  action  avant      6
## 27    s7  action  avant     30
## 28    s8  action  avant     36
## 29    s9  action  avant     24
## 30   s10  action  avant     24
## 31    s1 produit  apres     18
## 32    s2 produit  apres      6
## 33    s3 produit  apres     21
## 34    s4 produit  apres     18
## 35    s5 produit  apres     18
## 36    s6 produit  apres      6
## 37    s7 produit  apres     24
## 38    s8 produit  apres     22
## 39    s9 produit  apres      1
## 40   s10 produit  apres     24
## 41    s1  client  apres     30
## 42    s2  client  apres     18
## 43    s3  client  apres     31
## 44    s4  client  apres     39
## 45    s5  client  apres     28
## 46    s6  client  apres     18
## 47    s7  client  apres     36
## 48    s8  client  apres     36
## 49    s9  client  apres     38
## 50   s10  client  apres     25
## 51    s1  action  apres     34
## 52    s2  action  apres     30
## 53    s3  action  apres     32
## 54    s4  action  apres     40
## 55    s5  action  apres     27
## 56    s6  action  apres     23
## 57    s7  action  apres     38
## 58    s8  action  apres     40
## 59    s9  action  apres     32
## 60   s10  action  apres     34

description quantitative des données

ezStats(ex4,wid=.(sujet),dv=.(vd_ex4),within=.(domaine,moment))
##   domaine moment  N Mean       SD     FLSD
## 1  action  apres 10 33.0 5.497474 3.845744
## 2  action  avant 10 22.3 8.069834 3.845744
## 3  client  apres 10 29.9 7.709302 3.845744
## 4  client  avant 10 20.3 7.087548 3.845744
## 5 produit  apres 10 15.8 8.337332 3.845744
## 6 produit  avant 10 15.5 4.790036 3.845744

représentation graphique

bxp4<-ggboxplot(ex4,x="domaine",y="vd_ex4",color="moment")
bxp4

normalité

tapply(ex4$vd_ex4,interaction(ex4$domaine,ex4$moment),shapiro.test)
## $action.apres
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.94947, p-value = 0.6622
## 
## 
## $client.apres
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.90547, p-value = 0.2513
## 
## 
## $produit.apres
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.83934, p-value = 0.04333
## 
## 
## $action.avant
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.95048, p-value = 0.6742
## 
## 
## $client.avant
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.88424, p-value = 0.1459
## 
## 
## $produit.avant
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.94319, p-value = 0.5891

Mauchly et l’anova avec ezANOVA

ezANOVA(ex4,wid=.(sujet),dv=.(vd_ex4),within=.(domaine,moment))
## $ANOVA
##           Effect DFn DFd         F            p p<.05       ges
## 2        domaine   2  18 25.848793 5.110847e-06     * 0.3738862
## 3         moment   1   9 19.422498 1.702749e-03     * 0.2089743
## 4 domaine:moment   2  18  9.742124 1.357729e-03     * 0.1086795
## 
## $`Mauchly's Test for Sphericity`
##           Effect         W         p p<.05
## 2        domaine 0.7879390 0.3854520      
## 4 domaine:moment 0.9113463 0.6898167      
## 
## $`Sphericity Corrections`
##           Effect       GGe        p[GG] p[GG]<.05       HFe        p[HF]
## 2        domaine 0.8250410 2.764502e-05         * 0.9864613 5.821960e-06
## 4 domaine:moment 0.9185657 1.935001e-03         * 1.1427904 1.357729e-03
##   p[HF]<.05
## 2         *
## 4         *

représentation graphique de l’interaction

ezPlot(ex4,dv=.(vd_ex4),wid=.(sujet),within=.(domaine,moment),x=.(domaine),
  do_lines=TRUE,do_bars=FALSE,split=.(moment))

anova avec aov

anova_ex4<-aov(vd_ex4~(domaine*moment)+Error(sujet/(domaine*moment)),data=ex4)
summary(anova_ex4)
## 
## Error: sujet
##           Df Sum Sq Mean Sq F value Pr(>F)
## Residuals  9   1491   165.7               
## 
## Error: sujet:domaine
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## domaine    2 1598.7   799.4   25.85 5.11e-06 ***
## Residuals 18  556.6    30.9                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: sujet:moment
##           Df Sum Sq Mean Sq F value Pr(>F)   
## moment     1  707.3   707.3   19.42 0.0017 **
## Residuals  9  327.7    36.4                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Error: sujet:domaine:moment
##                Df Sum Sq Mean Sq F value  Pr(>F)   
## domaine:moment  2  326.4  163.22   9.742 0.00136 **
## Residuals      18  301.6   16.75                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

les effets simples

à venir…

Anova S<A>×B

Le but est de vérifier l’hypothèse selon laquelle le niveau de rétention d’une liste de mots dépend de la profondeur de leur traitement dans la phase de mémorisation. Pour étudier le lien entre profondeur de traitement et taux de rétention, un chercheur a envisagé trois conditions expérimentales : addition des lettres (\(b_1\)), création de rimes (\(b_2\)), création d’adjectifs (\(b_3\)). Le chercheur veut aussi mettre en évidence un effet de l’âge. Non seulement les sujets jeunes devraient retenir plus de mots, mais la différence avec les sujets plus âgés devrait s’accroître avec la complexité du traitement requise dans les consignes. Les données concernant les 30 sujets sont les suivantes (nombre de mots correctement rappelés).

sujet<-rep(c("s1","s2","s3","s4","s5","s6","s7","s8","s9","s10","s11","s12","s13","s14","s15",
   "s16","s17","s18","s19","s20","s21","s22","s23","s24","s25","s26","s27","s28","s29","s30"),3)
age<-c(rep("jeune",15),rep("vieux",15),rep("jeune",15),rep("vieux",15),rep("jeune",15),
   rep("vieux",15))
condition<-c(rep("b1",30),rep("b2",30),rep("b3",30))
vd_ex5<-c(7,5,4,4,4,3,2,2,1,4,5,5,5,5,6,1,3,2,4,2,3,2,2,2,3,3,3,4,1,1,8,5,3,7,5,3,2,
1,3,5,6,5,6,4,5,4,3,3,2,2,2,1,1,2,2,3,3,3,4,5,6,6,6,9,10,6,7,5,7,4,8,7,7,6,8,4,3,2,2,
3,3,3,4,2,3,4,5,6,4,4)
ex5<-data.frame(sujet,age,condition,vd_ex5,stringsAsFactors=TRUE)
ex5
##    sujet   age condition vd_ex5
## 1     s1 jeune        b1      7
## 2     s2 jeune        b1      5
## 3     s3 jeune        b1      4
## 4     s4 jeune        b1      4
## 5     s5 jeune        b1      4
## 6     s6 jeune        b1      3
## 7     s7 jeune        b1      2
## 8     s8 jeune        b1      2
## 9     s9 jeune        b1      1
## 10   s10 jeune        b1      4
## 11   s11 jeune        b1      5
## 12   s12 jeune        b1      5
## 13   s13 jeune        b1      5
## 14   s14 jeune        b1      5
## 15   s15 jeune        b1      6
## 16   s16 vieux        b1      1
## 17   s17 vieux        b1      3
## 18   s18 vieux        b1      2
## 19   s19 vieux        b1      4
## 20   s20 vieux        b1      2
## 21   s21 vieux        b1      3
## 22   s22 vieux        b1      2
## 23   s23 vieux        b1      2
## 24   s24 vieux        b1      2
## 25   s25 vieux        b1      3
## 26   s26 vieux        b1      3
## 27   s27 vieux        b1      3
## 28   s28 vieux        b1      4
## 29   s29 vieux        b1      1
## 30   s30 vieux        b1      1
## 31    s1 jeune        b2      8
## 32    s2 jeune        b2      5
## 33    s3 jeune        b2      3
## 34    s4 jeune        b2      7
## 35    s5 jeune        b2      5
## 36    s6 jeune        b2      3
## 37    s7 jeune        b2      2
## 38    s8 jeune        b2      1
## 39    s9 jeune        b2      3
## 40   s10 jeune        b2      5
## 41   s11 jeune        b2      6
## 42   s12 jeune        b2      5
## 43   s13 jeune        b2      6
## 44   s14 jeune        b2      4
## 45   s15 jeune        b2      5
## 46   s16 vieux        b2      4
## 47   s17 vieux        b2      3
## 48   s18 vieux        b2      3
## 49   s19 vieux        b2      2
## 50   s20 vieux        b2      2
## 51   s21 vieux        b2      2
## 52   s22 vieux        b2      1
## 53   s23 vieux        b2      1
## 54   s24 vieux        b2      2
## 55   s25 vieux        b2      2
## 56   s26 vieux        b2      3
## 57   s27 vieux        b2      3
## 58   s28 vieux        b2      3
## 59   s29 vieux        b2      4
## 60   s30 vieux        b2      5
## 61    s1 jeune        b3      6
## 62    s2 jeune        b3      6
## 63    s3 jeune        b3      6
## 64    s4 jeune        b3      9
## 65    s5 jeune        b3     10
## 66    s6 jeune        b3      6
## 67    s7 jeune        b3      7
## 68    s8 jeune        b3      5
## 69    s9 jeune        b3      7
## 70   s10 jeune        b3      4
## 71   s11 jeune        b3      8
## 72   s12 jeune        b3      7
## 73   s13 jeune        b3      7
## 74   s14 jeune        b3      6
## 75   s15 jeune        b3      8
## 76   s16 vieux        b3      4
## 77   s17 vieux        b3      3
## 78   s18 vieux        b3      2
## 79   s19 vieux        b3      2
## 80   s20 vieux        b3      3
## 81   s21 vieux        b3      3
## 82   s22 vieux        b3      3
## 83   s23 vieux        b3      4
## 84   s24 vieux        b3      2
## 85   s25 vieux        b3      3
## 86   s26 vieux        b3      4
## 87   s27 vieux        b3      5
## 88   s28 vieux        b3      6
## 89   s29 vieux        b3      4
## 90   s30 vieux        b3      4

description quantitative

ezStats(ex5,wid=.(sujet),dv=.(vd_ex5),between=.(age),within=.(condition))
##     age condition  N     Mean        SD      FLSD
## 1 jeune        b1 15 4.133333 1.5976173 0.8561259
## 2 jeune        b2 15 4.533333 1.8847761 0.8561259
## 3 jeune        b3 15 6.800000 1.5212777 0.8561259
## 4 vieux        b1 15 2.400000 0.9856108 0.8561259
## 5 vieux        b2 15 2.666667 1.1126973 0.8561259
## 6 vieux        b3 15 3.466667 1.1254629 0.8561259

représentation graphique

bxp5<-ggboxplot(ex5,x="condition",y="vd_ex5",color="age")
bxp5

normalité

tapply(ex5$vd_ex5,interaction(ex5$age,ex5$condition),shapiro.test)
## $jeune.b1
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.94246, p-value = 0.4143
## 
## 
## $vieux.b1
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.8959, p-value = 0.0824
## 
## 
## $jeune.b2
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.96539, p-value = 0.7848
## 
## 
## $vieux.b2
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.92564, p-value = 0.2347
## 
## 
## $jeune.b3
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.95216, p-value = 0.5591
## 
## 
## $vieux.b3
## 
##  Shapiro-Wilk normality test
## 
## data:  X[[i]]
## W = 0.90476, p-value = 0.1126

homogénéité des variances

cond_b1<-subset(ex5,condition=="b1")
cond_b2<-subset(ex5,condition=="b2")
cond_b3<-subset(ex5,condition=="b3")
leveneTest(vd_ex5~age,data=cond_b1)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  1.6154 0.2142
##       28
leveneTest(vd_ex5~age,data=cond_b2)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  1.9064 0.1783
##       28
leveneTest(vd_ex5~age,data=cond_b3)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  0.6364 0.4317
##       28

Mauchly et l’anova avec ezANOVA

ezANOVA(ex5,wid=.(sujet),dv=.(vd_ex5),between=.(age),within=.(condition))
## $ANOVA
##          Effect DFn DFd        F            p p<.05        ges
## 2           age   1  28 37.46264 1.323518e-06     * 0.41915982
## 3     condition   2  56 21.70568 1.049680e-07     * 0.26312684
## 4 age:condition   2  56  4.31518 1.807344e-02     * 0.06628458
## 
## $`Mauchly's Test for Sphericity`
##          Effect         W         p p<.05
## 3     condition 0.9563663 0.5475551      
## 4 age:condition 0.9563663 0.5475551      
## 
## $`Sphericity Corrections`
##          Effect       GGe        p[GG] p[GG]<.05      HFe        p[HF]
## 3     condition 0.9581906 1.802645e-07         * 1.026987 1.049680e-07
## 4 age:condition 0.9581906 1.957791e-02         * 1.026987 1.807344e-02
##   p[HF]<.05
## 3         *
## 4         *

visualisation graphique de l’interaction

ezPlot(ex5,wid=.(sujet),dv=.(vd_ex5),between=.(age),within=.(condition),x=.(condition),split=.(age))

anova avec aov

anova_ex5<-aov(vd_ex5~(age*condition)+Error(sujet/condition)+age,data=ex5) summary(anova_ex5)

Régression linéaire simple

Voici un échantillon tiré d’une population sur lequel on a observé deux variables numériques :

  • satis : satisfaction au travail
  • resp : responsabilités

Le but est de savoir dans quelle mesure la satisfaction au travail est expliquée par les responsabilités.

corex1<-data.frame(satis=c(3.95,2.11,2.5,6.05,3.78,6.15,2.1,6.8,5.99,2.29,3.53,4.55,
1.14,4.29,4.86,4.25,4.34,2.77,4.82,3.74),resp=c(2.23,0.57,1.12,3.49,0.6,3.74,1.68,
2.34,2.75,2.8,2.08,1.52,0.73,2.99,2.46,2.62,1.88,1.24,2,1.19))

nuage de points

plot(corex1$resp,corex1$satis)

coefficient de corrélation linéaire

cor(corex1$satis,corex1$resp)
## [1] 0.6699442

test de corrélation

normalité

shapiro.test(corex1$satis)
## 
##  Shapiro-Wilk normality test
## 
## data:  corex1$satis
## W = 0.96947, p-value = 0.7435
shapiro.test(corex1$resp)
## 
##  Shapiro-Wilk normality test
## 
## data:  corex1$resp
## W = 0.97148, p-value = 0.7857

le test

cor.test(corex1$satis,corex1$resp)
## 
##  Pearson's product-moment correlation
## 
## data:  corex1$satis and corex1$resp
## t = 3.8285, df = 18, p-value = 0.001231
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.3232578 0.8580761
## sample estimates:
##       cor 
## 0.6699442

la régression

reg_ex1<-lm(corex1$satis~corex1$resp)
plot(corex1$resp,corex1$satis)
abline(reg_ex1,col='blue')

summary(reg_ex1)
## 
## Call:
## lm(formula = corex1$satis ~ corex1$resp)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.60269 -0.52623 -0.04201  0.68996  2.42128 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   1.7642     0.6404   2.755  0.01304 * 
## corex1$resp   1.1173     0.2918   3.829  0.00123 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.174 on 18 degrees of freedom
## Multiple R-squared:  0.4488, Adjusted R-squared:  0.4182 
## F-statistic: 14.66 on 1 and 18 DF,  p-value: 0.001231

L’information la plus importante est le coefficient de détermination \(R^2=0.4488\) qui est appelé “Multiple R-squared” ici. C’est la proportion de variance expliquée par la variable explicative. Plus il est proche de 1, plus le modèle est bon.

La dernière ligne (F-statistics) est un test pour déterminer si le coefficient a est nul ou pas. Il est équivalent au test de corrélation du paragraphe précédent (noter que l’on retrouve la même p-value). On le retrouve aussi dans le tableau sur les coefficients : la ligne “Intercept” est un test pour décider si le coefficient b est nul ou pas.

normalité des résidus

hist(residuals(reg_ex1),col="grey")

qqnorm(residuals(reg_ex1))
qqline(residuals(reg_ex1))

shapiro.test(residuals(reg_ex1))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(reg_ex1)
## W = 0.98264, p-value = 0.9635

homoscédaticité et indépendance par rapport aux valeurs prédites

Les valeurs prédites sont obtenues avec la commande fitted), le mieux est de tracer un graphique qui montre les résidus en fonction des valeurs prédites. Si l’on obtient un nuage diffus, bien réparti, cela signifie que ces deux conditions sont remplies.

plot(residuals(reg_ex1),fitted(reg_ex1))

indépendance par rapport à la variable explicative,

Un graphique représentant les résidus en fonction de la variable explicative doit donner aussi un nuage diffus.

plot(residuals(reg_ex1)~corex1$resp)

indépendance des résidus

test de Durbin-Watson, nécessite car

durbinWatsonTest(reg_ex1)
##  lag Autocorrelation D-W Statistic p-value
##    1       -0.144216       2.26782    0.51
##  Alternative hypothesis: rho != 0

Régression linéaire multiple

Par rapport à la régression simple, on a rajouté une variable explicative, l’ancienneté dans l’entreprise. On veut donc expliquer la satisfaction au travail en fonction de l’ancienneté et des responsabilités.

corex2<-data.frame(satis=c(3.95,2.11,2.5,6.05,3.78,6.15,2.1,6.8,5.99,2.29,3.53,4.55,
1.14,4.29,4.86,4.25,4.34,2.77,4.82,3.74),anc=c(7.44,1.29,4.85,6,0.68,6.81,4.15,1.77,
5.78,5.75,3.53,5.73,4.8,10.66,5.27,4.17,5.8,2.31,7.68,5.53),resp=c(2.23,0.57,1.12,
3.49,0.6,3.74,1.68,2.34,2.75,2.8,2.08,1.52,0.73,2.99,2.46,2.62,1.88,1.24,2,1.19))

graphiques

pairs(corex2)

matcor<-cor(corex2)
matcor
##           satis       anc      resp
## satis 1.0000000 0.2291975 0.6699442
## anc   0.2291975 1.0000000 0.5693991
## resp  0.6699442 0.5693991 1.0000000
plotcorr(matcor)

corrplot(matcor,type="upper")

régression

reg_ex2<-lm(corex2$satis~corex2$anc+corex2$resp)
summary(reg_ex2)
## 
## Call:
## lm(formula = corex2$satis ~ corex2$anc + corex2$resp)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.66339 -0.63282  0.05227  0.92598  1.87443 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   2.0703     0.7002   2.957  0.00883 **
## corex2$anc   -0.1469     0.1383  -1.062  0.30297   
## corex2$resp   1.3313     0.3538   3.763  0.00155 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.17 on 17 degrees of freedom
## Multiple R-squared:  0.4831, Adjusted R-squared:  0.4223 
## F-statistic: 7.945 on 2 and 17 DF,  p-value: 0.003662
anova(reg_ex2)
## Analysis of Variance Table
## 
## Response: corex2$satis
##             Df  Sum Sq Mean Sq F value   Pr(>F)   
## corex2$anc   1  2.3634  2.3634  1.7278 0.206153   
## corex2$resp  1 19.3728 19.3728 14.1628 0.001549 **
## Residuals   17 23.2537  1.3679                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

non-multicolinéarité des variables explicatives

vif(reg_ex2)
##  corex2$anc corex2$resp 
##    1.479761    1.479761

doit renvoyer des valeurs inférieures à 10.