From a0e91826cdef38082308328d09329c7ce91f8b3c Mon Sep 17 00:00:00 2001 From: Louis Lacoste Date: Wed, 8 May 2024 19:59:26 +0200 Subject: [PATCH] Fini d'ajouter les CAH par dominante 3A --- cah-analyse.qmd | 195 ++++++++++++++++++++++++++++++++++++++++++++++++ tabset.qmd | 60 +++++++++++++++ 2 files changed, 255 insertions(+) create mode 100644 cah-analyse.qmd create mode 100644 tabset.qmd diff --git a/cah-analyse.qmd b/cah-analyse.qmd new file mode 100644 index 0000000..cea3d62 --- /dev/null +++ b/cah-analyse.qmd @@ -0,0 +1,195 @@ +--- +title: Analyse des résultats de CAH +author: Louis Lacoste +execute: + echo: false + warning: false + fig-width: 10 + fig-height: 10 +format: html +--- + +## 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(dplyr) +library(tidyr) +library(stringr) +library(DT) + + +data <- read.csv(file.path(here(), "data", "03_cah_results.csv")) +colnames(data)[6:ncol(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 <- data %>% + mutate_if(sapply(data, is.character), as.factor) +``` + +```{r} +# TODO Croiser les données pour extraire le nom des UCs et remplacer les facteurs + +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% +kable(head(data[, -1], 3)) +effectif_cluster <- table(data[["cluster"]]) +``` + +:::{.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 <- 0 +data <- data %>% + group_by(dominante3A) %>% + mutate(dominante3A = ifelse(n() < nb_3A_min, "Autre", 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) +} +``` + +:::{.panel-tabset} + +### 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 +})) +``` + +### Tableaux + +```{r} +#| tbl-cap: !expr 'paste("Table des proportions de choix par cluster pour ",(colnames(data)[3:ncol(data)-1]))' +#| result: asis +ac <- NULL +vec_sequences <- (colnames(data)[3:ncol(data) - 1]) +for (sequence in vec_sequences) { + 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, 30)) + ac_table <- ac %>% + select(-nb) %>% + pivot_wider(names_from = uc, values_from = Prop) + print(ac_table %>% datatable(filter = "top")) +} +``` + + + +::: + + +#  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") +``` + +::: \ No newline at end of file diff --git a/tabset.qmd b/tabset.qmd new file mode 100644 index 0000000..01df454 --- /dev/null +++ b/tabset.qmd @@ -0,0 +1,60 @@ + +```{r} +data_domi <- read.csv(file.path(per_dominante_folder, cah_data_list[{{i}}]), check.names = FALSE) + +nom_dominante <- as.character(unique(data_domi[["dominante3A"]])) + +colnames(data_domi[6:ncol(data_domi)-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_domi <- data_domi %>% + mutate_if(sapply(data_domi, is.character), as.factor) + +for (code_bloc in colnames(data_domi)[6:ncol(data_domi) - 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_domi[[code_bloc]])) + levels(data_domi[[code_bloc]]) <- matching_code_cours[row_id_in_matching, "cours"] +} + +effectif_cluster_domi <- table(data_domi[["cluster"]]) +``` + +### Dominante : `r nom_dominante` + +#### Graphiques + +```{r} +#| plotly: true +#| result: asis + +ac <- NULL +vec_sequences <- (colnames(data_domi)[4:ncol(data_domi)-1]) +htmltools::tagList(lapply(vec_sequences, function (sequence) { + ac <- as.data.frame(table(data_domi[["cluster"]], data_domi[[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_domi) + ggtitle(paste("Proportion pour", sequence, "- domaine :", nom_dominante))) + p +})) +``` + +#### Tables +```{r} +#| tbl-cap: !expr 'paste("Table des proportions de choix par cluster pour ",(colnames(data)[3:ncol(data)-1]))' +#| result: asis +ac <- NULL +vec_sequences <- (colnames(data_domi)[4:ncol(data_domi)-1]) +for(sequence in vec_sequences) { + ac <- as.data.frame(table(data_domi[["cluster"]], data_domi[[sequence]], useNA = "ifany")) + colnames(ac) <- c("cluster", "uc", "nb") + ac <- ac %>% group_by(cluster) %>% mutate(Prop = nb/sum(nb), uc = str_wrap(uc,30)) + ac_table <- ac %>% select(-nb) %>% pivot_wider(names_from = uc, values_from = Prop) + print(ac_table %>% datatable(filter = "top") %>% formatRound(columns = - 1, digits = 3)) +} +``` \ No newline at end of file