Skip to content

Commit dbdf8aa

Browse files
edition de la seance d'autoevaluation 06a_kmeans
1 parent 04474bc commit dbdf8aa

File tree

7 files changed

+722
-0
lines changed

7 files changed

+722
-0
lines changed
8.68 KB
Loading
10 KB
Loading
8.23 KB
Loading
11.4 KB
Loading
8.34 KB
Loading
Lines changed: 291 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,291 @@
1+
---
2+
title: "Regroupement par les K-moyennes"
3+
author: "Guyliann Engels & Philippe Grosjean"
4+
output:
5+
learnr::tutorial
6+
tutorial:
7+
id: "sdd2.06a"
8+
version: 1.0.0
9+
runtime: shiny_prerendered
10+
---
11+
12+
```{r setup, include=FALSE}
13+
# Packages ----
14+
library(learnr)
15+
library(knitr)
16+
SciViews::R()
17+
library(BioDataScience)
18+
library(ade4)
19+
20+
# Collect informations ------
21+
options(tutorial.event_recorder = BioDataScience::record_sdd)
22+
tutorial_options(exercise.checker = BioDataScience::checker_sdd)
23+
tutorial_options(exercise.timelimit = 60)
24+
tutorial_options(exercise.cap = "Code R")
25+
knitr::opts_chunk$set(echo = FALSE, comment = NA)
26+
27+
# Preparation dataset ------
28+
29+
data("doubs")
30+
enviro <- doubs$env
31+
is <- read("iris", package = "datasets", lang = "fr")
32+
33+
diamonds_red <- read("diamonds", package = "ggplot2") %>.%
34+
select(., -cut, -color, -clarity) %>.%
35+
rename(., length = x, width = y, depth = z)
36+
slice(., 1:15000)
37+
```
38+
39+
```{r, echo=FALSE}
40+
fixedRow(
41+
column(9, div(
42+
img(src = 'images/BioDataScience-128.png', align = "left"),
43+
h1("Science des données biologiques 2"),
44+
"Réalisé par le service d'Écologie numérique des Milieux aquatiques, Université de Mons (Belgique)"
45+
)),
46+
column(3, div(
47+
textInput("user", "Utilisateur :", ""),
48+
textInput("email", "Email :", "")
49+
))
50+
)
51+
textOutput("user") # This is newer shown, but required to trigger an event!
52+
textOutput("email") # Idem!
53+
```
54+
55+
```{r, context="server"}
56+
output$user <- renderText({BioDataScience::user_name(input$user);""})
57+
output$email <- renderText({BioDataScience::user_email(input$email);""})
58+
updateTextInput(session, "user", value = BioDataScience::user_name())
59+
updateTextInput(session, "email", value = BioDataScience::user_email())
60+
```
61+
62+
## Préambule
63+
64+
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).
65+
66+
![](images/attention.jpg)
67+
68+
**Ne vous trompez pas dans votre adresse mail et votre identifiant Github**
69+
70+
**N'oubliez pas de soumettre votre réponse après chaque exercice**
71+
72+
> 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.
73+
74+
## CHoix du K pour les K-moyennes
75+
76+
Le regroupement par les K-moyennes est une méthode simple d'analyse multivariée considérée comme moins efficace que le CAH. Cette méthode permet néanmoins de réaliser des regroupements sur de gros jeu de données, alors que la CAH neciessite trop de temps de calcul et de mémoire vive.
77+
78+
Le plus grand défaut de cette méthode est de ne pas proposer le nombre de groupe. Vous devez le fixer par vous même. Il existe néanmoins des outils pour vous aidez
79+
Sur base du jeu de données `iris`, réalisez un graphique permettant d'estimer le nombre de groupes à employer dans la méthode des k-moyennes. La package factoextra propose un outil graphique permettant de donner une indication sur le nombre de groupes (k).
80+
81+
```{r, echo=TRUE}
82+
is <- read("iris", package = "datasets", lang = "fr")
83+
summary(is)
84+
```
85+
86+
```{r, echo=TRUE}
87+
is %>.%
88+
select(., -species) %>.%
89+
scale(.) %>.%
90+
as_tibble(.) -> is_scale
91+
92+
# factoextra::fviz_nbclust(x, FUNcluster = kmeans, method = "wss")
93+
```
94+
95+
```{r nbclust, exercise = TRUE}
96+
is <- read("iris", package = "datasets", lang = "fr")
97+
summary(is)
98+
99+
is %>.%
100+
select(., -species) %>.%
101+
scale(.) %>.%
102+
as_tibble(.) -> is_scale
103+
104+
```
105+
106+
```{r nbclust-hint-1}
107+
is %>.%
108+
select(., -species) %>.%
109+
scale(.) %>.%
110+
as_tibble(.) -> is_scale
111+
112+
factoextra::fviz_nbclust(x, FUNcluster = kmeans, method ="wss")
113+
```
114+
115+
```{r nbclust-hint-2}
116+
is %>.%
117+
select(., -species) %>.%
118+
scale(.) %>.%
119+
as_tibble(.) -> is_scale
120+
121+
factoextra::fviz_nbclust(is_scale, FUNcluster = kmeans, method = "wss")
122+
```
123+
124+
```{r nbclust-check}
125+
#TODO
126+
```
127+
128+
129+
```{r qu_nbclust}
130+
question("Sur base du graphique que vous avez réalisé, combien de groupes réaliseriez vous ? (plusieurs réponses sont possibles) ",
131+
answer("1"),
132+
answer("2"),
133+
answer("3", correct = TRUE),
134+
answer("Plus de 3"),
135+
allow_retry = TRUE,
136+
correct = "Bravo, tu as trouvé la bonne réponse. L'objectif de ce graphique est de choisir la valeur de K à la base du coude. Lorsque l'ajout d'un K supplémentaire ne permet plus de faire baisser *total within sum of square* fortement. Comme tu peux t'en rendre compte cet indicie est subjectif",
137+
incorrect = "Retente ta chance. Il y a une part de subjectivité dans l'analyse de ce graphique. L'objectif de ce graphique est de choisir la valeur de K à la base du coude. Lorsque l'ajout d'un K supplémentaire ne permet plus de faire baisser *total within sum of square* (de manière importante)")
138+
```
139+
140+
## Réalisation du regroupement par les K-moyennes
141+
142+
Réalisez à présent un regroupement avec la fonction kmeans() sur le jeu de donnée `enviro`. Utilisez une valeur de K de `3`
143+
144+
Ce tableau comprend 30 sites d'échantillonages avec 11 mesures environnementales.
145+
146+
Voici une courte description des variables étudiées (en anglais). Ces informations proviennent de la page d'aide `?ade4::doubs`
147+
148+
- dfs : distance from the source (km * 10),
149+
- alt : altitude (m),
150+
- slo : (log(x + 1) where x is the slope (per mil * 100),
151+
- flo : minimum average stream flow (m3/s * 100),
152+
- pH : pH,
153+
- har : total hardness of water (mg/l of Calcium),
154+
- pho : phosphates (mg/l * 100),
155+
- nit : nitrates (mg/l * 100),
156+
- amm : ammonia nitrogen (mg/l * 100),
157+
- oxy : dissolved oxygen (mg/l * 10),
158+
- bdo : biological demand for oxygen (mg/l * 10)
159+
160+
```{r, echo=TRUE}
161+
summary(enviro)
162+
```
163+
164+
```{r, eval = FALSE, echo=TRUE}
165+
DF_scale <- as_tibble(scale(DF))
166+
kmeans. <- kmeans(X, centers = VALUES, nstart = VALUES1)
167+
168+
(DF <- broom::glance(kmeans.))
169+
(DF <- broom::tidy(kmeans.))
170+
```
171+
172+
```{r kmeans, exercise = TRUE}
173+
#TODO
174+
```
175+
176+
```{r kmeans-hint-1}
177+
DF_scale <- as_tibble(scale(DF))
178+
kmeans(X, centers = VALUES, nstart = VALUES1)
179+
(DF <- broom::glance(kmeans.))
180+
(DF <- broom::tidy(kmeans.))
181+
```
182+
183+
```{r kmeans-hint-2}
184+
kmeans. <- kmeans(scale(enviro), centers = 3, nstart = 25) # la valeur de nstart est par défaut à 1 mais augmenter cette valeur rend l'analyse plus robuste (le temps de calcul augmente malheureusement)
185+
(glance_kmeans <- broom::glance(kmeans.))
186+
(tidy_kmeans <- broom::tidy(kmeans.))
187+
```
188+
189+
```{r kmeans-check}
190+
#TODO
191+
```
192+
193+
Assurez vous d'avoir bien compris cet objet.
194+
195+
## Réalisation d'un graphique de regroupement
196+
197+
Afin de réaliser un graphique vous devez réaliser plusieurs étapes.
198+
199+
- Créer un objet kmeans
200+
- Extraite l'information intéressante avec augment() et tidy() du package broom. (Souvenez vous, nous avons déjà employé ces fonction dans le modèle linéaire.)
201+
- Réaliser votre graphique
202+
203+
```{r, eval = FALSE, echo=TRUE}
204+
DF <- as_tibble(scale(DF)) # Scale transforme notre dataframe en matrice
205+
206+
OBJECT_KMEANS <- kmeans(DF, centers = VALUES, nstart = VALUES1)
207+
208+
broom::augment(OBJECT_KMEANS, DF) %>.%
209+
rename(., cluster = .cluster) -> DF_kMEANS
210+
211+
DF_centers <- broom::tidy(OBJECT_KMEANS, col.names = names(DF))
212+
213+
chart(data = DF_kMEANS, YVAR ~ XVAR %col=% FACTOR) +
214+
geom_point(alpha = 0.2) +
215+
stat_ellipse() +
216+
geom_point(data = DF_centers,
217+
size = 5, shape = 17)
218+
```
219+
220+
Réalisez à un objet Kmeans sur le jeu de données `diamonds` avec un `k = 4`. Réalisez ensuite un graphique du `price ~ depth` en focntion des 4 groupes calculés.
221+
222+
```{r, echo=TRUE}
223+
diamonds_red <- read("diamonds", package = "ggplot2") %>.%
224+
select(., -cut, -color, -clarity) %>.%
225+
rename(., length = x, width = y, depth = z)
226+
slice(., 1:15000)
227+
228+
skimr::skim(diamonds_red)
229+
```
230+
231+
```{r kmeangraph, exercise = TRUE}
232+
diamonds_red <- read("diamonds", package = "ggplot2") %>.%
233+
select(., -cut, -color, -clarity) %>.%
234+
rename(., length = x, width = y, depth = z)
235+
slice(., 1:15000)
236+
237+
skimr::skim(diamonds_red)
238+
```
239+
240+
```{r kmeangraph-hint-1}
241+
DF <- as_tibble(scale(DF))
242+
243+
OBJECT_KMEANS <- kmeans(DF, centers = VALUES, nstart = VALUES1)
244+
245+
broom::augment(OBJECT_KMEANS, DF) %>.%
246+
rename(., cluster = .cluster) -> DF_kMEANS
247+
248+
DF_centers <- broom::tidy(OBJECT_KMEANS, col.names = names(DF))
249+
250+
chart(data = DF_kMEANS, YVAR ~ XVAR %col=% FACTOR) +
251+
geom_point(alpha = 0.2) +
252+
stat_ellipse() +
253+
geom_point(data = DF_centers,
254+
size = 5, shape = 17)
255+
```
256+
257+
```{r kmeangraph-hint-2}
258+
diamonds_scale <- as_tibble(scale(diamonds_red))
259+
260+
diamonds_kmeans <- kmeans(diamonds_scale, centers = 4, nstart = 1)
261+
262+
broom::augment(diamonds_kmeans, diamonds_scale) %>.%
263+
rename(., cluster = .cluster) -> diam_kmeans
264+
265+
diam_centers <- broom::tidy(diamonds_kmeans, col.names = names(diamonds_scale))
266+
267+
chart(data = diam_kmeans, price ~ depth %col=% cluster) +
268+
geom_point(alpha = 0.2) +
269+
stat_ellipse() +
270+
geom_point(data = diam_centers,
271+
size = 5, shape = 17)
272+
```
273+
274+
```{r kmeangraph-check}
275+
# TODO
276+
```
277+
278+
## Conclusion
279+
280+
Vous venez de terminer votre séance d'exercice.
281+
282+
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.
283+
284+
```{r comm, exercise=TRUE, exercise.lines = 8}
285+
# Ajout de commentaires
286+
# ...
287+
```
288+
289+
```{r comm-check}
290+
# Not yet...
291+
```

0 commit comments

Comments
 (0)