Skip to content

Commit a26dcd4

Browse files
phgrosjeanphgrosjean
committed
Merge branch 'master' of github.com:BioDataScience-course/BioDataScience2
2 parents edeaed0 + 4373e12 commit a26dcd4

File tree

16 files changed

+307
-301
lines changed

16 files changed

+307
-301
lines changed

‎inst/tutorials/B02La_reg_multi/B02La_reg_multi.Rmd‎

Lines changed: 97 additions & 130 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ author: "Guyliann Engels & Philippe Grosjean"
44
description: "**SDD II Module 2** Aborder la régression linéaire multiple dans R."
55
tutorial:
66
id: "B02La_reg_multi"
7-
version: 2.2.1/7
7+
version: 2.3.0/7
88
output:
99
learnr::tutorial:
1010
progressive: true
@@ -14,7 +14,20 @@ runtime: shiny_prerendered
1414

1515
```{r setup, include=FALSE}
1616
BioDataScience2::learnr_setup()
17-
SciViews::R()
17+
SciViews::R("model",lang = "fr")
18+
19+
# dataset -----
20+
fat <- read("fat", package = "faraway")
21+
22+
# lm
23+
densi_lm1 <- lm(data = fat, density ~ abdom)
24+
lm_lin_result <- tidy(densi_lm1)
25+
lm_lin_param <- glance(densi_lm1)
26+
27+
# lm multi
28+
densi_lm2 <- lm(data = fat, density ~ abdom + hip)
29+
lm_mult_result <- tidy(densi_lm2)
30+
lm_mult_param <- glance(densi_lm2)
1831
```
1932

2033
```{r, echo=FALSE}
@@ -27,221 +40,175 @@ BioDataScience2::learnr_server(input, output, session)
2740

2841
------------------------------------------------------------------------
2942

43+
**Ce tutoriel correspond à la version 2021-2022. Il est en cours de révision pour la version 2022-2023. Vous devez probablement penser à installer une version plus récente du package qui contient les exercices finalisés !**
44+
3045
## Objectifs
3146

47+
Le premier module vous a permis de vous familiariser avec la régression linéaire. Vous avez appris à interpréter une partie des résultats proposés par le résumé du modèle ainsi qu'à interpréter les graphiques d'analyses des résidus. Les objectifs de ce tutoriel sont :
48+
3249
- Être capable de lire la sortie renvoyée par `summary()` lorsqu'il est appliqué à un objet **lm**.
3350
- Maîtriser la régression linéaire multiple dans R avec la fonction `lm()`.
3451

35-
## Régression linéaire
36-
37-
Réalisez une régression linéaire simple sur le jeu de données `df1` de la variable `y` en fonction de la variable `x`.
52+
## Description des données
3853

39-
```{r reglin-init}
40-
set.seed(42)
54+
Le tableau de données `fat` traite du pourcentage de masse grasse sur 252 hommes. Les participants à cette étude ont été immergés afin de déterminer leur densité corporelle. Cette méthode bien que très fiable n'est pas des plus simples à mettre en place. Les scientifiques font donc appel à vous afin d'estimer la densité des participants à l'aide de mesures biométriques plus simples à obtenir.
4155

42-
reg_lin <- function(x, a, b)
43-
a * x + b
44-
45-
v1 <- seq(from = 5, to = 20, by = 0.25)
46-
v2 <- v1 + rnorm(length(v1), sd = 0.5)
47-
48-
df1 <- dtx(
49-
x = v2,
50-
y = reg_lin(v2, 0.5, 0.001) + rnorm(length(v1), sd = 0.5)
51-
)
52-
53-
lm_lin <- lm(data = df1, y ~ x)
54-
lm_lin_param <- glance(lm_lin)
55-
lm_lin_result <- tidy(lm_lin)
56+
```{r, echo = TRUE}
57+
fat <- read("fat", package = "faraway")
58+
skimr::skim(fat)
5659
```
5760

58-
Vous avez à votre disposition le graphique suivant pour visualiser les données :
61+
## Régression linéaire simple
5962

60-
```{r}
61-
chart(data = df1, y ~ x) +
62-
geom_point()
63-
```
64-
65-
```{r reglin-prep}
66-
set.seed(42)
67-
68-
reg_lin <- function(x, a, b)
69-
a * x + b
70-
71-
v1 <- seq(from = 5, to = 20, by = 0.25)
72-
v2 <- v1 + rnorm(length(v1), sd = 0.5)
73-
74-
df1 <- dtx(
75-
x = v2,
76-
y = reg_lin(v2, 0.5, 0.001) + rnorm(length(v1), sd = 0.5)
77-
)
63+
Intéressez-vous à la densité (`density`) des participants. Modélisez la densité en fonction du tour de taille (`abdom`). Le graphique ci-dessous vous présente le nuage de point associé au modèle demandé.
7864

79-
lm_lin <- lm(data = df1, y ~ x)
80-
lm_lin_param <- glance(lm_lin)
81-
lm_lin_result <- tidy(lm_lin)
65+
```{r, echo=TRUE}
66+
chart(data = fat, density ~ abdom) +
67+
geom_point()
8268
```
8369

84-
💬 **Un snippet peut vous aider à réaliser cet exercice.**
70+
Modélisez la densité (`density`) en fonction du tour de taille (`abdom`) sur les données du tableau `fat`.
8571

86-
```{r reglin_h2, exercise = TRUE, exercise.setup = "reglin-prep"}
87-
summary(lm. <- lm(data = ___, ___ ~ ___))
72+
```{r reglin_h2, exercise = TRUE}
73+
summary(densi_lm1 <- lm(data = ___, ___ ~ ___))
8874
```
8975

9076
```{r reglin_h2-hint}
91-
summary(lm. <- lm(data = DF, FORMULA))
77+
summary(densi_lm1 <- lm(data = DF, FORMULA))
9278
9379
#### ATTENTION: Hint suivant = solution !####
9480
```
9581

9682
```{r reglin_h2-solution}
9783
## Solution ##
98-
summary(lm. <- lm(data = df1, y ~ x))
84+
summary(densi_lm1 <- lm(data = fat, density ~ abdom))
9985
```
10086

10187
```{r reglin_h2-check}
10288
grade_code("D'accord, on a maintenant une régression linéaire simple comme point de départ.")
10389
```
10490

105-
Suite à votre analyse répondez aux questions suivantes :
91+
Analysez le tableau des résultats et répondez aux questions suivantes :
10692

10793
```{r qu_reglin}
10894
quiz(
10995
question(text = "Quelle est la valeur de l'ordonnée à l'origine ?",
110-
answer(sprintf("%.2f", lm_lin_result$estimate[1]), correct = TRUE),
111-
answer(sprintf("%.2f", 0)),
112-
answer(sprintf("%.2f", lm_lin_param$sigma[1])),
113-
answer(sprintf("%.2f", lm_lin_result$estimate[2])),
114-
answer(sprintf("%.2f", lm_lin_param$r.squared[1])),
96+
answer(sprintf("%.4f", lm_lin_result$estimate[1]), correct = TRUE),
97+
answer(sprintf("%.4f", 0)),
98+
answer(sprintf("%.4f", lm_lin_param$sigma[1])),
99+
answer(sprintf("%.4f", lm_lin_result$estimate[2])),
100+
answer(sprintf("%.4f", lm_lin_param$r.squared[1])),
115101
allow_retry = TRUE, random_answer_order = TRUE
116102
),
117103
question(text = "Quelle est la valeur de la pente ?",
118-
answer(sprintf("%.2f", 0)),
119-
answer(sprintf("%.2f", lm_lin_result$estimate[2]), correct = TRUE),
120-
answer(sprintf("%.2f", lm_lin_param$BIC[1])),
121-
answer(sprintf("%.2f", lm_lin_result$estimate[1])),
122-
answer(sprintf("%.2f", lm_lin_param$r.squared[1])),
104+
answer(sprintf("%.4f", 0)),
105+
answer(sprintf("%.4f", lm_lin_result$estimate[2]), correct = TRUE),
106+
answer(sprintf("%.4f", lm_lin_param$BIC[1])),
107+
answer(sprintf("%.4f", lm_lin_result$estimate[1])),
108+
answer(sprintf("%.4f", lm_lin_param$r.squared[1])),
123109
allow_retry = TRUE, random_answer_order = TRUE
124110
),
125111
question(text = "Quelle est la fraction de la variance exprimée par la régression linéaire ?",
126-
answer(sprintf("%.3f", lm_lin_param$r.squared), correct = TRUE),
127-
answer(sprintf("%.3f", lm_lin_param$statistic)),
128-
answer(sprintf("%.3f", as.numeric(lm_lin_param$df))),
129-
answer(sprintf("%.3f", lm_lin_result$estimate[1])),
112+
answer(sprintf("%.4f", lm_lin_param$r.squared), correct = TRUE),
113+
answer(sprintf("%.4f", lm_lin_param$statistic)),
114+
answer(sprintf("%.4f", as.numeric(lm_lin_param$df))),
115+
answer(sprintf("%.4f", lm_lin_result$estimate[1])),
130116
allow_retry = TRUE, random_answer_order = TRUE
131117
)
132118
)
133119
```
134120

135-
## Régression linéaire multiple
136-
137-
```{r regmulti-init}
138-
set.seed(381)
139-
140-
v <- seq(from = 1, to = 15, by = .2)
141-
x <- v + rnorm(length(v), sd = 3)
142-
143-
reg_lin_rand <- function(x, a, b, random = 0.5)
144-
a * x + b + rnorm(length(v), sd = random)
145-
146-
reg_mutli3_rand <- function(x1, a1, x2, a2, x3, a3, b, random = 5)
147-
a1 * x1 + a2 * x2 + a3 * x3 + b + rnorm(length(x1), sd = random)
148-
149-
df2 <- dtx(
150-
x = x,
151-
x0 = reg_lin_rand(x = x, a = 1.26, b = 2, random = 3.5),
152-
x1 = reg_lin_rand(x = x, a = 1.5, b = 1, random = 10),
153-
y = reg_mutli3_rand(x1 = x, x2 = x0, x3 = x1,
154-
a1 = 0.2, a2 = 0.3, a3 = 1.1, b = 2))
155-
156-
lm_mult <- lm(data = df2, y ~ x + x1)
157-
lm_mult_coef <- tidy(lm_mult)
158-
lm_mult_param <- glance(lm_mult)
159-
```
121+
L'analyse des résidus n'est pas l'objectif de cette séance d'exercice. Prenez cependant le temps de critiquer chaque graphique.
160122

161123
```{r}
162-
summary(df2)
124+
chart$residuals(densi_lm1)
163125
```
164126

165-
Réalisez une régression linéaire simple sur le jeu de données `df2` de la variable `y` en fonction de la variable `x` et `x1`.
166-
167-
```{r regmulti-prep}
168-
set.seed(381)
169-
170-
v <- seq(from = 1, to = 15, by = .2)
171-
x <- v + rnorm(length(v), sd = 3)
172-
173-
reg_lin_rand <- function(x, a, b, random = 0.5)
174-
a * x + b + rnorm(length(v), sd = random)
175-
176-
reg_mutli3_rand <- function(x1, a1, x2, a2, x3, a3, b, random = 5)
177-
a1 * x1 + a2 * x2 + a3 * x3 + b + rnorm(length(x1), sd = random)
127+
## Régression linéaire multiple
178128

179-
df2 <- dtx(
180-
x = x,
181-
x0 = reg_lin_rand(x = x, a = 1.26, b = 2, random = 3.5),
182-
x1 = reg_lin_rand(x = x, a = 1.5, b = 1, random = 10),
183-
y = reg_mutli3_rand(x1 = x, x2 = x0, x3 = x1,
184-
a1 = 0.2, a2 = 0.3, a3 = 1.1, b = 2))
129+
Tentez de réaliser à présent une régression linéaire multiple afin d'améliorer votre modèle. Réalisez à présent un modèle de la densité (`density`) en fonction du tour de taille (`abdom`) et du tour de hanche (`hip`). Le graphique de la densité en fonction du tour de taille vous a été présenté précédemment. Vous trouverez ci-dessous le graphique de la densité en fonction du tour de hanches.
185130

186-
lm_mult <- lm(data = df2, y ~ x + x1)
187-
lm_mult_coef <- tidy(lm_mult)
188-
lm_mult_param <- glance(lm_mult)
131+
```{r, echo = TRUE}
132+
chart(data = fat, density ~ hip) +
133+
geom_point()
189134
```
190135

191-
💬 **Un snippet peut vous aider à réaliser cet exercice.**
192-
193-
```{r regmulti_h2, exercise = TRUE, exercise.setup = "regmulti-prep"}
136+
```{r regmulti_h2, exercise = TRUE}
194137
# régression multiple
195-
summary(lm. <- lm(data = ___, ___ ~ ___))
138+
summary(densi_lm2 <- lm(data = ___, ___ ~ ___))
196139
```
197140

198141
```{r regmulti_h2-hint}
199-
summary(lm. <- lm(data = DF, Y ~ VAR1 + VAR2))
142+
summary(densi_lm2 <- lm(data = DF, Y ~ VAR1 + VAR2))
200143
201144
#### ATTENTION: Hint suivant = solution !####
202145
```
203146

204147
```{r regmulti_h2-solution}
205148
## Solution ##
206-
summary(lm. <- lm(data = df2, y ~ x + x1))
149+
summary(densi_lm2 <- lm(data = fat, density ~ abdom + hip))
207150
```
208151

209152
```{r regmulti_h2-check}
210153
grade_code("Vous venez de réaliser votre première régression linéaire multiple. Elles n'auront bientôt plus de secrets pour vous !")
211154
```
212155

213-
Suite à votre analyse répondez aux questions suivantes :
156+
Suite à votre analyse, répondez aux questions suivantes :
214157

215158
```{r qu_regmulti}
216159
quiz(
217-
question(text = "Quelle est la valeur de l'ordonnée à l'origine ?",
218-
answer(sprintf("%.2f", lm_mult_coef$estimate[1]), correct = TRUE),
219-
answer(sprintf("%.2f", lm_mult_coef$estimate[2])),
220-
answer(sprintf("%.2f", lm_mult_coef$p.value[1])),
221-
answer(sprintf("%.2f", lm_mult_param$AIC[1])),
222-
answer(sprintf("%.2f", lm_mult_param$r.squared[1])),
160+
question(text = "Quelle est la valeur de l'écart-type résiduel de ce modèle ?",
161+
answer(sprintf("%.4f", lm_mult_param$sigma[1]), correct = TRUE),
162+
answer(sprintf("%.4f", lm_mult_result$estimate[2])),
163+
answer(sprintf("%.4f", lm_mult_result$p.value[1])),
164+
answer(sprintf("%.4f", lm_mult_param$AIC[1])),
165+
answer(sprintf("%.4f", lm_mult_param$r.squared[1])),
223166
allow_retry = TRUE, random_answer_order = TRUE
224167
),
225168
question(text = "Quelle est la fraction de la variance exprimée par la régression linéaire ?",
226-
answer(sprintf("%.3f", lm_mult_param$adj.r.squared), correct = TRUE),
227-
answer(sprintf("%.3f", lm_mult_param$r.squared)),
228-
answer(sprintf("%.3f", lm_mult_param$df)),
229-
answer(sprintf("%.3f", lm_mult_coef$estimate[1])),
169+
answer(sprintf("%.4f", lm_mult_param$adj.r.squared), correct = TRUE),
170+
answer(sprintf("%.4f", lm_mult_param$r.squared)),
171+
answer(sprintf("%.4f", lm_mult_param$df)),
172+
answer(sprintf("%.4f", lm_mult_result$estimate[1])),
230173
allow_retry = TRUE, random_answer_order = TRUE
231174
)
232175
)
233176
```
234177

178+
L'analyse des résidus n'est pas l'objectif de cette séance d'exercice. Prenez cependant le temps de critiquer chaque graphique.
179+
180+
```{r}
181+
chart$residuals(densi_lm2)
182+
```
183+
184+
## Choix du meilleur modèle
185+
186+
Vous venez de réaliser deux modèles. Il s'agit d'un cas particulier. Ces deux modèles sont imbriqués. Le premier modèle de la densité en fonction du tour de taille se nomme `densi_lm1` et le second modèle de la densité en fonction du tour de taille et du tour de hanche se nomme `densi_lm2`. Comment pourriez-vous départager ces deux modèles ? Outre l'analyse du résumé des modèles et des résidus, il existe des outils pour départager ces deux modèles. L'ANOVA ci-dessus vous permet de définir qu'il y a une différence significative entre ces deux modèles.
187+
188+
```{r, echo = TRUE}
189+
anova(densi_lm1, densi_lm2)
190+
```
191+
192+
Le critère d'Akaike est une métrique adaptée à la comparaison de modèles. Le meilleur modèle selon le critère d'Akaike est le modèle ayant obtenu la valeur la plus faible.
193+
194+
```{r}
195+
AIC(densi_lm1, densi_lm2)
196+
```
197+
198+
Suite à l'analyse des résumés des deux modèles, l'interprétation des graphiques des résidus et des valeurs du critère d'Akaike, le second modèle est plus performant afin de modéliser la densité des personnes étudiées.
199+
235200
## Conclusion
236201

237-
Vous venez de terminer votre séance d'exercices relive à la régression multiple.
202+
Vous venez de terminer votre séance d'exercices relative à la régression multiple.
238203

239204
```{r comm_noscore, echo=FALSE}
240205
question_text(
241206
"Laissez-nous vos impressions sur ce learnr",
242207
answer("", TRUE, message = "Pas de commentaires... C'est bien aussi."),
243208
incorrect = "Vos commentaires sont enregistrés.",
244209
placeholder = "Entrez vos commentaires ici...",
245-
allow_retry = TRUE
210+
allow_retry = TRUE,
211+
submit_button = "Soumettre une réponse",
212+
try_again_button = "Resoumettre une réponse"
246213
)
247214
```

0 commit comments

Comments
 (0)