Skip to content

Commit 4776ea7

Browse files
edition du learnr 02a_reg
1 parent 7c01b2b commit 4776ea7

File tree

11 files changed

+518
-0
lines changed

11 files changed

+518
-0
lines changed
8.68 KB
Loading
10 KB
Loading
8.23 KB
Loading
11.4 KB
Loading
8.34 KB
Loading
Lines changed: 227 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,227 @@
1+
---
2+
title: "Régression linéaire multiple"
3+
author: "Guyliann Engels & Philippe Grosjean"
4+
output:
5+
learnr::tutorial
6+
tutorial:
7+
id: "sdd2.02a"
8+
version: 0.1.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
61+
62+
Réalisez une régression linéaire simple sur le jeu de données df1 de la variable y en fonction de la vairable x
63+
64+
```{r reglin-init}
65+
# edition de l'exercice
66+
set.seed(42)
67+
68+
reg_lin <- function(x, a, b){
69+
y <- a*x + b
70+
y
71+
}
72+
73+
vec1 <- seq(from = 5, to = 20, by = 0.25)
74+
vec2 <- vec1 + rnorm(sd=0.5, n = length(vec1))
75+
76+
df1 <- tibble(
77+
x = vec2,
78+
y = reg_lin(vec2, 0.5, 0) + rnorm(sd=0.5, n = length(vec1)))
79+
80+
lm_lin <- lm(df1, formula = y ~ x -1)
81+
lm_lin_param <- broom::glance(lm_lin)
82+
lm_lin_result <- broom::tidy(lm_lin)
83+
```
84+
85+
Vous avez à votre disposition le graphique suivant pour visualiser les données
86+
87+
```{r}
88+
chart(df1, formula= y ~ x) +
89+
geom_point()
90+
```
91+
92+
93+
```{r reglin-prep}
94+
# edition de l'exercice
95+
set.seed(42)
96+
97+
reg_lin <- function(x, a, b){
98+
y <- a*x + b
99+
y
100+
}
101+
102+
vec1 <- seq(from = 5, to = 20, by = 0.25)
103+
vec2 <- vec1 + rnorm(sd=0.5, n = length(vec1))
104+
105+
df1 <- tibble(
106+
x = vec2,
107+
y = reg_lin(vec2, 0.5, 0) + rnorm(sd=0.5, n = length(vec1)))
108+
```
109+
110+
```{r reglin, exercise = TRUE, exercise.setup = "reglin-prep"}
111+
#
112+
summary(df1)
113+
```
114+
115+
```{r reglin-hint-1}
116+
#snippet
117+
summary(lm. <- lm(data = DF, YNUM ~ XNUM))
118+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
119+
chart(model, aes_string(x = vars[2], y = vars[1])) +
120+
geom_point() +
121+
stat_smooth(method = "lm", formula = y ~ x))(.)
122+
#snippet 2
123+
summary(lm. <- lm(data = DF, YNUM ~ XNUM + 0))
124+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
125+
chart(model, aes_string(x = vars[2], y = vars[1])) +
126+
geom_point() +
127+
stat_smooth(method = "lm", formula = y ~ x + 0))(.)
128+
```
129+
130+
```{r reglin-solution}
131+
summary(lm. <- lm(data = df1, y~ x+ 0))
132+
lm. %>.% (function (lm, model = lm[["model"]], vars = names(model))
133+
chart(model, aes_string(x = vars[2], y = vars[1])) +
134+
geom_point() +
135+
stat_smooth(method = "lm", formula = y ~ x + 0))(.)
136+
```
137+
138+
```{r reglin-check}
139+
# TODO
140+
```
141+
142+
Suite à votre analyse répondez aux questions suivantes
143+
144+
```{r qu_reglin1}
145+
quiz(
146+
question(text = "Quelle est la valeur de l'ordonnée à l'origine ?",
147+
answer(sprintf("%.2f", 0), correct = TRUE),
148+
answer(sprintf("%.2f", lm_lin_result$estimate[1])),
149+
answer(sprintf("%.2f", lm_lin_param$sigma[1])),
150+
answer(sprintf("%.2f", lm_lin_param$AIC[1])),
151+
answer(sprintf("%.2f", lm_lin_param$r.squared[1])),
152+
allow_retry = TRUE, random_answer_order = TRUE
153+
),
154+
question(text = "Quelle est la valeur de la pente ?",
155+
answer(sprintf("%.2f", 0), correct = TRUE),
156+
answer(sprintf("%.2f", lm_lin_result$estimate[1])),
157+
answer(sprintf("%.2f", lm_lin_param$BIC[1])),
158+
answer(sprintf("%.2f", lm_lin_param$AIC[1])),
159+
answer(sprintf("%.2f", lm_lin_param$r.squared[1])),
160+
allow_retry = TRUE, random_answer_order = TRUE
161+
),
162+
question(text = "Quelle est la fraction de la variance exprimée par la régression linéaire ?",
163+
answer(sprintf("%.3f", lm_lin_param$r.squared), correct = TRUE),
164+
answer(sprintf("%.3f", lm_lin_param$statistic)),
165+
answer(sprintf("%.3f", lm_lin_param$df)),
166+
answer(sprintf("%.3f", lm_lin_result$estimate[1])),
167+
allow_retry = TRUE, random_answer_order = TRUE
168+
)
169+
)
170+
```
171+
172+
173+
## Régression linéaire multiple
174+
175+
```{r regmulti-init}
176+
# edition de l'exercice
177+
set.seed(42)
178+
179+
180+
a <- seq(from = 100, to = 500)
181+
random <- rnorm(n = length(a), sd = 50)
182+
x <- a + random
183+
x0 <- x + rnorm(n = length(x))
184+
x1 <- 1/x
185+
x2 <- log(x)
186+
x3 <- exp(x)
187+
x4 <- sin(x)
188+
x5 <- cos(x)
189+
190+
df <- tibble::tibble(x, x0, x1, x2, x3, x4, x5)
191+
192+
plot(df)
193+
corrplot::corrplot(cor(df,
194+
use = "pairwise.complete.obs"), method = "ellipse")
195+
196+
corrplot::corrplot(cor(df,
197+
use = "pairwise.complete.obs", method = "spearman"), method = "ellipse")
198+
199+
mod_poly2 <- function(x1, alpha1, alpha2, intercept, random_effect){
200+
y <- intercept + (alpha1 * x1) + (alpha2 * (x1^2))
201+
y + rnorm(n = length(x1), sd = random_effect)
202+
}
203+
204+
df <- tibble(
205+
x = x1,
206+
y = mod_poly2(x1 = x1, alpha1 = 2, alpha2 = 2.5, intercept = 55, random_effect = 10)
207+
)
208+
209+
lm_poly <- lm(df, formula = y ~ x + I(x^2))
210+
lm_poly_coef <- broom::tidy(lm_poly)
211+
lm_poly_param <- broom::glance(lm_poly)
212+
```
213+
214+
## Conclusion
215+
216+
Vous venez de terminer votre séance d'exercice.
217+
218+
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.
219+
220+
```{r comm, exercise=TRUE, exercise.lines = 8}
221+
# Ajout de commentaires
222+
# ...
223+
```
224+
225+
```{r comm-check}
226+
# Not yet...
227+
```

0 commit comments

Comments
 (0)