175 lines
No EOL
4.7 KiB
Text
175 lines
No EOL
4.7 KiB
Text
---
|
||
title: Analyse des résultats de CAH
|
||
author: Louis Lacoste
|
||
execute:
|
||
echo: false
|
||
warning: false
|
||
fig-width: 10
|
||
fig-height: 10
|
||
format:
|
||
html:
|
||
embed-resources: true
|
||
---
|
||
|
||
## Description des données
|
||
```{r}
|
||
knitr::opts_chunk$set(echo = FALSE)
|
||
library(ggplot2)
|
||
library(plotly)
|
||
library(ggokabeito)
|
||
library(RColorBrewer)
|
||
library(patchwork)
|
||
|
||
library(here)
|
||
|
||
library(knitr)
|
||
library(kableExtra)
|
||
|
||
library(dplyr)
|
||
library(tidyr)
|
||
library(stringr)
|
||
library(DT)
|
||
|
||
|
||
imp_data <- read.csv(file.path(here(), "data", "03_cah_results.csv"))
|
||
colnames(imp_data)[6:ncol(imp_data) - 1] <- c(
|
||
"1AC-OUVERTURE", "1AC-MI",
|
||
"2A-UEchoix-S1-UC1", "2A-UEchoix-S1-UC2", "2A-UEchoix-S2-UC3",
|
||
"2A-UEchoix-S2-UC4",
|
||
"2A-UEchoix-S2-UC5", "2A-UEchoix-S2-UC6",
|
||
"2A-Projet-S2"
|
||
)
|
||
data <- imp_data %>%
|
||
mutate_if(sapply(imp_data, is.character), as.factor)
|
||
|
||
effectif_cluster <- table(data[["cluster"]])
|
||
```
|
||
```{r}
|
||
|
||
data_details_sequence <- read.csv(file.path(here(), "data", "details-sequence-nettoyes.csv"))
|
||
|
||
for (code_bloc in colnames(data)[6:ncol(data) - 1]) {
|
||
# code_bloc <- "1AC-OUVERTURE"
|
||
matching_code_cours <- data_details_sequence[which(data_details_sequence[["code_bloc"]] == code_bloc), c("code_cours", "cours")]
|
||
row_id_in_matching <- which(matching_code_cours[["code_cours"]] %in% levels(data[[code_bloc]]))
|
||
levels(data[[code_bloc]]) <- matching_code_cours[row_id_in_matching, "cours"]
|
||
}
|
||
```
|
||
|
||
---
|
||
|
||
# CAH pour toutes les dominantes
|
||
|
||
|
||
Voici un extrait des données obtenues après tout le traitement :
|
||
|
||
|
||
```{r}
|
||
#| width: 50%
|
||
#| output: asis
|
||
example_data <- head(data[, -c(1,6:9)], 3)
|
||
kable(example_data, format = "latex", booktabs = TRUE) %>%
|
||
kable_styling(latex_options="scale_down") %>%
|
||
column_spec(1:ncol(example_data),width = "3cm")
|
||
```
|
||
|
||
:::{.callout-caution}
|
||
A cause du format peu pratique pour l'extraction, nous avons un grand nombre de NAs mais malgré tout nous avons pu réaliser une CAH sur les données et obtenir `r max(data[["cluster"]])` clusters différents.
|
||
|
||
Nous avons nous même fixé ce nombre dans le fichier `03_CAH_clust.R`.
|
||
:::
|
||
|
||
---
|
||
|
||
|
||
```{r}
|
||
nb_3A_min <- 10
|
||
data <- data %>%
|
||
group_by(dominante3A) %>%
|
||
mutate(dominante3A = ifelse(n() < nb_3A_min, as.character("Autre"), as.character(dominante3A))) %>% mutate(dominante3A = as.factor(dominante3A))
|
||
```
|
||
|
||
Les dominantes de 3A sont nombreuses, nous allons donc rassembler celles dont
|
||
l'effectif est de moins de `r nb_3A_min` étudiants dans une catégorie "Autre".
|
||
|
||
|
||
```{r}
|
||
getPalette <- colorRampPalette(colors = palette_okabe_ito())
|
||
plot_prop_cluster <- function(orig_data, eff, ...) {
|
||
data <- orig_data
|
||
|
||
colorCount <- length(unique(data[["uc"]]))
|
||
levels(data$cluster) <- paste0(levels(data$cluster), " (N=", eff, ")")
|
||
p <- ggplot(data, ...) +
|
||
aes(x = "", y = nb, fill = uc, label = nb) +
|
||
geom_bar(position = "fill", stat = "identity") +
|
||
theme_bw() +
|
||
xlab("Cluster") +
|
||
ylab("Proportion dans le cluster") +
|
||
labs(fill = "Choix") +
|
||
theme(axis.title.y = element_text(angle = 90, vjust = .5, hjust = 1), aspect.ratio = 1) +
|
||
theme(legend.position = "bottom") +
|
||
guides(fill = guide_legend(nrow = 8, byrow = TRUE)) +
|
||
scale_fill_manual(values = getPalette(colorCount), ) +
|
||
# coord_flip() +
|
||
scale_x_discrete() +
|
||
# coord_polar("y", start=0) +
|
||
facet_wrap(vars(data[["cluster"]]))
|
||
|
||
return(p)
|
||
}
|
||
```
|
||
|
||
### Graphiques
|
||
|
||
```{r}
|
||
#| plotly: true
|
||
#| result: asis
|
||
|
||
ac <- NULL
|
||
vec_sequences <- (colnames(data)[3:ncol(data) - 1])
|
||
htmltools::tagList(lapply(vec_sequences, function(sequence) {
|
||
ac <- as.data.frame(table(data[["cluster"]], data[[sequence]], useNA = "ifany"))
|
||
colnames(ac) <- c("cluster", "uc", "nb")
|
||
ac <- ac %>%
|
||
group_by(cluster) %>%
|
||
mutate(Prop = nb / sum(nb), uc = str_wrap(uc, 32))
|
||
p <- ggplotly(ac %>% plot_prop_cluster(eff = effectif_cluster) + ggtitle(str_wrap(paste("Proportion pour", sequence), 20)))
|
||
p
|
||
}))
|
||
```
|
||
|
||
|
||
# CAH par dominante
|
||
|
||
```{r}
|
||
per_dominante_folder <- file.path(here(), "data", "04_CAH_par_dominante")
|
||
cah_data_list <- list.files(per_dominante_folder)
|
||
|
||
backtick <- "`"
|
||
```
|
||
|
||
Nous avons ensuité réalisé des CAH par dominante pour analyser les profils
|
||
d'étudiants. Pour cela il a fallu définir un seuil, celui ci est de 20 étudiants
|
||
au moins dans la dominante.
|
||
|
||
Voici la liste de fichiers obtenue : `r toString(paste0(backtick, cah_data_list, backtick))`
|
||
|
||
Et ci-dessous des onglets par dominante considérée.
|
||
|
||
:::{.panel-tabset}
|
||
|
||
|
||
```{r write_tabs}
|
||
#| warning: false
|
||
#| output: asis
|
||
|
||
src <- lapply(seq_len(length(cah_data_list)), function(i) {
|
||
knitr::knit_expand(file.path(here(), "tabset.qmd"))
|
||
})
|
||
|
||
res <- knitr::knit_child(text = unlist(src))
|
||
cat(res, sep = "\n")
|
||
```
|
||
|
||
::: |