Skip to content

Commit 135dc45

Browse files
learnr sdd02.02b
1 parent 8bd4af8 commit 135dc45

File tree

9 files changed

+709
-0
lines changed

9 files changed

+709
-0
lines changed
Loading
Loading
8.23 KB
Loading
11.4 KB
Loading
Loading
Lines changed: 319 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,319 @@
1+
---
2+
title: "Régression linéaire polynomiale"
3+
author: "Guyliann Engels & Philippe Grosjean"
4+
output:
5+
learnr::tutorial
6+
tutorial:
7+
id: "sdd2.02b"
8+
version: 1.0.0
9+
runtime: shiny_prerendered
10+
---
11+
12+
```{r setup, include=FALSE}
13+
library(learnr)
14+
library(knitr)
15+
SciViews::R()
16+
library(BioDataScience)
17+
18+
options(tutorial.event_recorder = BioDataScience::record_sdd)
19+
tutorial_options(exercise.checker = BioDataScience::checker_sdd)
20+
tutorial_options(exercise.timelimit = 60)
21+
tutorial_options(exercise.cap = "Code R")
22+
knitr::opts_chunk$set(echo = FALSE, comment = NA)
23+
```
24+
25+
```{r, echo=FALSE}
26+
fixedRow(
27+
column(9, div(
28+
img(src = 'images/BioDataScience-128.png', align = "left"),
29+
h1("Science des données biologiques 2"),
30+
"Réalisé par le service d'Écologie numérique des Milieux aquatiques, Université de Mons (Belgique)"
31+
)),
32+
column(3, div(
33+
textInput("user", "Utilisateur :", ""),
34+
textInput("email", "Email :", "")
35+
))
36+
)
37+
textOutput("user") # This is newer shown, but required to trigger an event!
38+
textOutput("email") # Idem!
39+
```
40+
41+
```{r, context="server"}
42+
output$user <- renderText({BioDataScience::user_name(input$user);""})
43+
output$email <- renderText({BioDataScience::user_email(input$email);""})
44+
updateTextInput(session, "user", value = BioDataScience::user_name())
45+
updateTextInput(session, "email", value = BioDataScience::user_email())
46+
```
47+
48+
## Préambule
49+
50+
Si vous n'avez jamais utilisé de tutoriel "learnr", familiarisez-vous d'abord avec son interface [ici](http://biodatascience-course.sciviews.org/sdd-umons/learnr.html).
51+
52+
![](images/attention.jpg)
53+
54+
**Ne vous trompez pas dans votre adresse mail et votre identifiant Github**
55+
56+
**N'oubliez pas de soumettre votre réponse après chaque exercice**
57+
58+
> Conformément au RGPD ([Règlement Général sur la Protection des Données](https://ec.europa.eu/info/law/law-topic/data-protection/reform/rules-business-and-organisations/principles-gdpr_fr)), nous sommes tenus de vous informer de ce que vos résultats seront collecté afin de suivre votre progression. **Les données seront enregistrées au nom de l'utilisateur apparaissant en haut de cette page. Corrigez si nécessaire !** En utilisant ce tutoriel, vous marquez expressément votre accord pour que ces données puissent être collectées par vos enseignants et utilisées pour vous aider et vous évaluer. Après avoir été anonymisées, ces données pourront également servir à des études globales dans un cadre scientifique et/ou éducatif uniquement.
59+
60+
## Régression linéaire polynomiale
61+
62+
```{r regpoly-init}
63+
# edition de l'exercice
64+
set.seed(42)
65+
66+
x <- seq(from = 1, to = 10, by = 0.25)
67+
x1 <- x + rnorm(n = length(x))
68+
69+
70+
mod_poly2 <- function(x1, alpha1, alpha2, intercept, random_effect){
71+
y <- intercept + (alpha1 * x1) + (alpha2 * (x1^2))
72+
y + rnorm(n = length(x1), sd = random_effect)
73+
}
74+
75+
df <- tibble(
76+
x = x1,
77+
y = mod_poly2(x1 = x1, alpha1 = 2, alpha2 = 2.5, intercept = 55, random_effect = 10)
78+
)
79+
80+
lm_poly <- lm(df, formula = y ~ x + I(x^2))
81+
lm_poly_coef <- broom::tidy(lm_poly)
82+
lm_poly_param <- broom::glance(lm_poly)
83+
```
84+
85+
Réalisez la régression linéaire polynomiale d'ordre 2 de la variable `y` en fonction de la variable `x` sur le jeu de données `df`. Vous avez à votre dispositon un nuage de points et un résumé des données pour avoir une première connaissance de données.
86+
87+
```{r}
88+
chart(df, y ~ x) +
89+
geom_point()
90+
```
91+
92+
```{r regpoly-prep}
93+
# copie du chunk regpoly-init
94+
# edition de l'exercice
95+
set.seed(42)
96+
97+
x <- seq(from = 1, to = 10, by = 0.25)
98+
x1 <- x + rnorm(n = length(x))
99+
100+
101+
mod_poly2 <- function(x1, alpha1, alpha2, intercept, random_effect){
102+
y <- intercept + (alpha1 * x1) + (alpha2 * (x1^2))
103+
y + rnorm(n = length(x1), sd = random_effect)
104+
}
105+
106+
df <- tibble(
107+
x = x1,
108+
y = mod_poly2(x1 = x1, alpha1 = 2, alpha2 = 2.5, intercept = 55, random_effect = 10)
109+
)
110+
```
111+
112+
113+
```{r regpoly, exercise = TRUE, exercise.setup = "regpoly-prep"}
114+
# Résumé des données
115+
summary(df)
116+
#
117+
118+
119+
```
120+
121+
```{r regpoly-hint-1}
122+
#snippet
123+
summary(lm. <- lm(data = DF,
124+
YNUM ~ XNUM + I(XNUM^2)))
125+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
126+
chart(model, aes_string(x = vars[2], y = vars[1])) +
127+
geom_point() +
128+
stat_smooth(method = "lm", formula = y ~ x + I(x^2)))(.)
129+
```
130+
131+
```{r regpoly-solution}
132+
summary(lm. <- lm(data = df,
133+
y ~ x + I(x^2)))
134+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
135+
chart(model, aes_string(x = vars[2], y = vars[1])) +
136+
geom_point() +
137+
stat_smooth(method = "lm", formula = y ~ x + I(x^2)))(.)
138+
```
139+
140+
```{r regpoly-check}
141+
# TODO
142+
```
143+
144+
Suite à votre analyse répondez aux questions suivantes
145+
146+
```{r qu_regpoly}
147+
quiz(
148+
question(text = "Quelle est la valeur de l'ordonnée à l'origine ?",
149+
answer(sprintf("%.2f", lm_poly_coef$estimate[1]), correct = TRUE),
150+
answer(sprintf("%.2f", lm_poly_coef$estimate[2])),
151+
answer(sprintf("%.2f", lm_poly_coef$std.error[1])),
152+
answer(sprintf("%.2f", lm_poly_coef$std.error[2])),
153+
answer(sprintf("%.2f", lm_poly_coef$statistic[1])),
154+
answer(sprintf("%.2f", lm_poly_coef$statistic[2])),
155+
answer(sprintf("%.2f", lm_poly_param$r.squared[1])),
156+
allow_retry = TRUE, random_answer_order = TRUE
157+
),
158+
question(text = "Quelle est la valeur de **x** ?",
159+
answer(sprintf("%.2f", lm_poly_coef$estimate[1])),
160+
answer(sprintf("%.2f", lm_poly_coef$estimate[2]), correct = TRUE),
161+
answer(sprintf("%.2f", lm_poly_coef$std.error[1])),
162+
answer(sprintf("%.2f", lm_poly_coef$std.error[2])),
163+
answer(sprintf("%.2f", lm_poly_coef$statistic[1])),
164+
answer(sprintf("%.2f", lm_poly_coef$statistic[2])),
165+
answer(sprintf("%.2f", lm_poly_param$r.squared[1])),
166+
allow_retry = TRUE, random_answer_order = TRUE
167+
)
168+
)
169+
```
170+
171+
## Régression linéaire simple ou polynomiale
172+
173+
```{r regpoly_simp-init}
174+
# edition de l'exercice
175+
set.seed(42)
176+
177+
x <- seq(from = 1, to = 10, by = 0.25)
178+
x1 <- x + rnorm(n = length(x))
179+
180+
181+
mod_poly2 <- function(x1, alpha1, alpha2, intercept, random_effect){
182+
y <- intercept + (alpha1 * x1) + (alpha2 * (x1^2))
183+
y + rnorm(n = length(x1), sd = random_effect)
184+
}
185+
186+
df <- tibble(
187+
x = x1,
188+
y = mod_poly2(x1 = x1, alpha1 = 2, alpha2 = 2.5, intercept = 55, random_effect = 10)
189+
)
190+
191+
lm_lin_simp <- lm(df, formula = y ~ x )
192+
lm_ls_coef <- broom::tidy(lm_lin_simp)
193+
lm_ls_param <- broom::glance(lm_lin_simp)
194+
195+
lm_lin_poly <- lm(df, formula = y ~ x + I(x^2))
196+
lm_lp_coef <- broom::tidy(lm_poly)
197+
lm_lp_param <- broom::glance(lm_poly)
198+
```
199+
200+
Réalisez une régression linéaire simple et une régression linéaire polynomiale d'ordre 2 de la variable `y` en fonction de la variable `x` sur le jeu de données `df`. Utilsez le critère d'Akaike afin de déterminer le meilleur modèle. Vous avez à votre dispositon un nuage de points et un résumé des données pour avoir une première connaissance de données.
201+
202+
```{r}
203+
chart(df, y ~ x) +
204+
geom_point()
205+
```
206+
207+
208+
```{r regpoly_simp-prep}
209+
210+
# edition de l'exercice
211+
set.seed(42)
212+
213+
x <- seq(from = 1, to = 10, by = 0.25)
214+
x1 <- x + rnorm(n = length(x))
215+
216+
217+
mod_poly2 <- function(x1, alpha1, alpha2, intercept, random_effect){
218+
y <- intercept + (alpha1 * x1) + (alpha2 * (x1^2))
219+
y + rnorm(n = length(x1), sd = random_effect)
220+
}
221+
222+
df <- tibble(
223+
x = x1,
224+
y = mod_poly2(x1 = x1, alpha1 = 2, alpha2 = 2.5, intercept = 55, random_effect = 10)
225+
)
226+
227+
lm_lin_simp <- lm(df, formula = y ~ x )
228+
lm_ls_coef <- broom::tidy(lm_lin_simp)
229+
lm_ls_param <- broom::glance(lm_lin_simp)
230+
231+
lm_lin_poly <- lm(df, formula = y ~ x + I(x^2))
232+
lm_lp_coef <- broom::tidy(lm_lin_poly)
233+
lm_lp_param <- broom::glance(lm_lin_poly)
234+
```
235+
236+
```{r regpoly_simp, exercise = TRUE, exercise.setup = "regpoly_simp-prep"}
237+
# résumé
238+
summary(df)
239+
#
240+
#
241+
```
242+
243+
244+
```{r regpoly_simp-hint-1}
245+
# snippet
246+
summary(lm. <- lm(data = DF,
247+
YNUM ~ XNUM + I(XNUM^2)))
248+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
249+
chart(model, aes_string(x = vars[2], y = vars[1])) +
250+
geom_point() +
251+
stat_smooth(method = "lm", formula = y ~ x + I(x^2)))(.)
252+
```
253+
254+
```{r regpoly_simp-hint-2}
255+
# snippet (suite)
256+
summary(lm. <- lm(data = DF, YNUM ~ XNUM))
257+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
258+
chart(model, aes_string(x = vars[2], y = vars[1])) +
259+
geom_point() +
260+
stat_smooth(method = "lm", formula = y ~ x))(.)
261+
```
262+
263+
```{r regpoly_simp-hint-3}
264+
# snippet (suite)
265+
AIC(lm.)
266+
```
267+
268+
```{r regpoly_simp-solution}
269+
summary(lm_lin_poly <- lm(data = df,
270+
y ~ x + I(x^2)))
271+
summary(lm_lin_simp <- lm(data = df,
272+
y ~ x ))
273+
AIC(lm_lin_poly, lm_lin_simp)
274+
```
275+
276+
```{r reglin_simp-check}
277+
# TODO
278+
```
279+
280+
Suite à votre analyse répondez aux questions suivantes
281+
282+
```{r qu_regpoly_simp}
283+
quiz(
284+
question(text = "Quelle est la valeur du critère d'Akaike de la régression polynomiale ?",
285+
answer(sprintf("%.2f", lm_lp_param$AIC), correct = TRUE),
286+
answer(sprintf("%.2f", lm_lp_param$BIC)),
287+
answer(sprintf("%.2f", lm_lp_param$sigma)),
288+
answer(sprintf("%.2f", lm_lp_param$deviance)),
289+
allow_retry = TRUE, random_answer_order = TRUE
290+
),
291+
question(text = "Quelle est la valeur du critère d'Akaike de la régression linéaire simple ?",
292+
answer(sprintf("%.2f", lm_ls_param$AIC), correct = TRUE),
293+
answer(sprintf("%.2f", lm_ls_param$BIC)),
294+
answer(sprintf("%.2f", lm_ls_param$sigma)),
295+
answer(sprintf("%.2f", lm_ls_param$deviance)),
296+
allow_retry = TRUE, random_answer_order = TRUE
297+
),
298+
question(text = "Quel est le meilleur modèle selon le critère d'Akaike",
299+
answer("modèle linéaire polynomiale", correct = TRUE),
300+
answer("modèle linéaire simple")
301+
)
302+
)
303+
```
304+
305+
306+
## Conclusion
307+
308+
Vous venez de terminer votre séance d'exercice.
309+
310+
Laissez nous vos impressions sur cet outil pédagogique ou expérimentez encore dans la zone ci-dessous. Rappelez-vous que pour placer un commentaire dans une zone de code R, vous devez utilisez un dièse (`#`) devant vos phrases.
311+
312+
```{r comm, exercise=TRUE, exercise.lines = 8}
313+
# Ajout de commentaires
314+
# ...
315+
```
316+
317+
```{r comm-check}
318+
# Not yet...
319+
```

0 commit comments

Comments
 (0)