--- 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") ``` :::