|
| 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 | + |
| 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