Statistiques descriptives des macronutriments | ||||||||
|---|---|---|---|---|---|---|---|---|
Statistique | proteines_ing | lipides_ing | glucides_ing | fibres_ing | choles_ing | proteines_autres_ing | proteines_vegetales_ing | proteines_animales_ing |
Minimum | 1.587 | 0.819 | 14.595 | 0.881 | 0.000 | 0.000 | 1.398 | 0.000 |
1er Quantile | 24.159 | 17.839 | 157.668 | 16.577 | 0.028 | 0.118 | 21.246 | 0.000 |
Moyenne | 38.380 | 32.360 | 240.210 | 25.990 | 23.370 | 0.390 | 33.690 | 4.300 |
Médiane | 34.122 | 27.254 | 220.906 | 23.458 | 2.189 | 0.230 | 30.052 | 0.620 |
3e Quantile | 48.181 | 41.847 | 298.815 | 32.472 | 14.310 | 0.485 | 43.129 | 4.875 |
Variance | 432.950 | 452.780 | 13,278.990 | 187.650 | 4,380.280 | 0.230 | 310.870 | 87.820 |
Ecart-type | 20.810 | 21.280 | 115.230 | 13.700 | 66.180 | 0.480 | 17.630 | 9.370 |
Maximum | 148.998 | 165.213 | 790.833 | 114.325 | 923.067 | 6.390 | 135.940 | 105.804 |
Statistiques descriptives des micronutriments | |||||||||
|---|---|---|---|---|---|---|---|---|---|
Statistique | calcium_ing | fer_ing | zinc_ing | vit_a_rae_ing | vit_d_ing | vit_e_ing | folate_vb9_ing | vit_b12_ing | vit_c_ing |
Minimum | 8.96 | 1.04 | 0.49 | 0.00 | 0.00 | 0.12 | 9.06 | 0.00 | 0.00 |
1er Quantile | 188.65 | 14.32 | 5.21 | 27.73 | 0.00 | 2.51 | 151.41 | 0.01 | 4.28 |
Moyenne | 366.85 | 22.85 | 8.29 | 162.28 | 0.26 | 4.74 | 273.35 | 0.52 | 22.84 |
Médiane | 288.99 | 20.43 | 7.41 | 59.98 | 0.02 | 3.82 | 230.98 | 0.06 | 9.56 |
3e Quantile | 474.01 | 29.69 | 10.44 | 139.05 | 0.11 | 6.01 | 356.11 | 0.34 | 23.64 |
Variance | 77,224.09 | 154.06 | 18.49 | 208,913.13 | 3.39 | 11.18 | 31,485.40 | 3.30 | 1,842.87 |
Ecart-type | 277.89 | 12.41 | 4.30 | 457.07 | 1.84 | 3.34 | 177.44 | 1.82 | 42.93 |
Maximum | 2,536.71 | 136.73 | 29.92 | 6,242.86 | 50.42 | 27.77 | 1,401.92 | 33.17 | 664.09 |
Nutriment | Chi.squared | Degrés.de.liberté | p.value | Significatif |
|---|---|---|---|---|
proteines_ing | 154,104.80 | 4 | 0 | Oui |
lipides_ing | 47,616.95 | 4 | 0 | Oui |
glucides_ing | 171,812.16 | 4 | 0 | Oui |
fibres_ing | 87,567.30 | 4 | 0 | Oui |
choles_ing | 109,592.17 | 4 | 0 | Oui |
proteines_autres_ing | 90,246.94 | 4 | 0 | Oui |
proteines_vegetales_ing | 129,965.22 | 4 | 0 | Oui |
proteines_animales_ing | 93,130.85 | 4 | 0 | Oui |
Nutriment | Chi.squared | Degrés.de.liberté | p.value | Significatif |
|---|---|---|---|---|
calcium_ing | 90,702.96 | 4 | 0 | Oui |
fer_ing | 95,141.00 | 4 | 0 | Oui |
zinc_ing | 188,500.04 | 4 | 0 | Oui |
vit_a_rae_ing | 74,783.73 | 4 | 0 | Oui |
vit_d_ing | 127,118.52 | 4 | 0 | Oui |
vit_e_ing | 27,250.02 | 4 | 0 | Oui |
folate_vb9_ing | 93,126.73 | 4 | 0 | Oui |
vit_b12_ing | 111,140.79 | 4 | 0 | Oui |
vit_c_ing | 44,490.23 | 4 | 0 | Oui |
Ce tableau de bord présente une analyse nutritionnelle des enfants au Niger, réalisée dans le cadre du Programme National d’Information Nutritionnelle (PNIN).
Objectifs de l’étude:
L’objectif principal est d’analyser les apports en macro et micronutriments chez les enfants dans différentes régions du Niger. Cette analyse vise à:
Méthodologie:
Interprétation des résultats:
Recommandations:
Des recommandations nutritionnelles adaptées à chaque région peuvent être formulées en fonction des déficits identifiés par cette analyse.---
title: "Analyse Nutritionnelle des Enfants"
author: "SALIFOU GADO Youssouf"
date: "`r Sys.Date()`"
output:
flexdashboard::flex_dashboard:
df_print: paged
theme: cosmo
orientation: rows
vertical_layout: scroll
logo: LOGO_PNIN_NIGER1.jpg
favicon: LOGO_PNIN_NIGER1.jpeg
social: menu
source_code: embed
---
<style>
/* CSS personnalisé */
:root {
--primary-color: #5D5CDE;
--secondary-color: #6c757d;
--success-color: #28a745;
--warning-color: #ffc107;
--danger-color: #dc3545;
--light-bg: #ffffff;
--dark-bg: #181818;
--card-border: #e9ecef;
}
.dark {
--text-color: #f8f9fa;
--bg-color: var(--dark-bg);
--card-bg: #2a2a2a;
}
body {
overflow-y: scroll !important;
height: auto !important;
font-family: 'Roboto', sans-serif;
transition: background-color 0.3s ease;
}
.chart-title {
font-weight: 600;
margin-bottom: 10px;
color: var(--primary-color);
}
.value-box {
border-radius: 5px;
box-shadow: 0 4px 6px rgba(0,0,0,0.1);
transition: transform 0.3s ease;
}
.value-box:hover {
transform: translateY(-5px);
}
.nutrition-table {
width: 100%;
border-collapse: collapse;
margin-bottom: 20px;
}
.nutrition-table th {
background-color: var(--primary-color);
color: white;
padding: 12px;
text-align: left;
}
.nutrition-table td {
padding: 8px 12px;
border-bottom: 1px solid var(--card-border);
}
.nutrition-table tr:hover {
background-color: rgba(93, 92, 222, 0.1);
}
/* Style pour les tabs dans le tableau de bord */
.nav-tabs .nav-link.active {
color: white;
background-color: var(--primary-color);
border-color: var(--primary-color);
}
.nav-tabs .nav-link:hover {
border-color: #e9ecef #e9ecef #dee2e6;
}
/* Support du mode sombre */
@media (prefers-color-scheme: dark) {
body {
background-color: var(--dark-bg);
color: var(--text-color);
}
.chart-container {
background-color: var(--card-bg);
}
.value-box {
background-color: var(--card-bg);
color: var(--text-color);
}
}
</style>
<script>
// Détecter le mode sombre
if (window.matchMedia && window.matchMedia('(prefers-color-scheme: dark)').matches) {
document.documentElement.classList.add('dark');
}
window.matchMedia('(prefers-color-scheme: dark)').addEventListener('change', event => {
if (event.matches) {
document.documentElement.classList.add('dark');
} else {
document.documentElement.classList.remove('dark');
}
});
// Animation pour une expérience utilisateur améliorée
$(document).ready(function() {
$('.value-box').addClass('animate__animated animate__fadeIn');
$('.chart-container').addClass('animate__animated animate__fadeIn');
// Activer les tooltips pour toutes les visualisations
$('[data-toggle="tooltip"]').tooltip();
});
</script>
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
rm(list=ls()) # supprimer, sans exception, tous les objets crées par l'utilisateur
```
```{r}
# Chargement des packages
library(plotly)
library(pracma)
library(car)
library(stats)
library(tseries)
library(nortest)
library(lmtest)
library(multcomp)
library(texreg)
library(stargazer)
library(cluster)
library(readxl)
library(survey)
library(purrr)
library(officer)
library(dplyr)
library(flextable)
library(ggplot2)
library(questionr)
library(factoextra)
library(FactoMineR)
library(psych)
library(corrplot)
library(psy)
library(highcharter)
library(DT)
library(viridis)
library(formattable)
library(forcats)
library(tidyr)
library(scales)
library(hrbrthemes)
library(magrittr)
library(flexdashboard)
library(kableExtra)
library(lubridate)
library(Hmisc)
```
```{r}
# Configuration de highcharter
options(highcharter.theme = hc_theme_google())
# Fonctions utilitaires
format_million <- function(x) {
paste0(format(round(x/1000000, 2), nsmall = 2), " M")
}
format_percent <- function(x) {
paste0(format(round(x*100, 1), nsmall = 1), "%")
}
```
```{r load_data, include=FALSE}
# Chargement des données
enfglob <- read_excel("enfants.xlsx")
# Attacher les données pour faciliter l'accès aux variables
attach(enfglob)
# Préparation des données pour l'analyse
enfmacro <- enfglob %>%
dplyr::select(proteines_ing, lipides_ing, glucides_ing, fibres_ing, choles_ing,
proteines_autres_ing, proteines_vegetales_ing, proteines_animales_ing,
Pond_Ind)
enfmicro <- enfglob %>%
dplyr::select(calcium_ing, fer_ing, zinc_ing, vit_a_rae_ing, vit_d_ing, vit_e_ing,
folate_vb9_ing, vit_b12_ing, vit_c_ing, Pond_Ind)
enfenergie <- enfglob %>%
dplyr::select(energiekcal_ing, Pond_Ind)
# Données régionales
enfmacrore <- enfglob %>%
dplyr::select(proteines_ing, lipides_ing, glucides_ing, fibres_ing, choles_ing,
proteines_autres_ing, proteines_vegetales_ing, proteines_animales_ing,
coderegion, Pond_Ind)
enfmicrore <- enfglob %>%
dplyr::select(calcium_ing, fer_ing, zinc_ing, vit_a_rae_ing, vit_d_ing, vit_e_ing,
folate_vb9_ing, vit_b12_ing, vit_c_ing, coderegion, Pond_Ind)
enfenre <- enfglob %>%
dplyr::select(energiekcal_ing, coderegion, Pond_Ind)
# Création des designs d'enquête pour les analyses pondérées
dema <- svydesign(ids = ~1, data = enfmacro, weights = ~Pond_Ind)
demi <- svydesign(ids = ~1, data = enfmicro, weights = ~Pond_Ind)
enerenf <- svydesign(ids = ~1, data = enfenergie, weights = ~Pond_Ind)
demare <- svydesign(ids = ~1, data = enfmacrore, weights = ~Pond_Ind)
demire <- svydesign(ids = ~1, data = enfmicrore, weights = ~Pond_Ind)
enerenfre <- svydesign(ids = ~1, data = enfenre, weights = ~Pond_Ind)
# Listes des variables à analyser
macronutriment <- names(enfmacro)[1:8]
micronutriment <- names(enfmicro)[1:9]
macrore <- names(enfmacrore)[1:8]
microre <- names(enfmicrore)[1:9]
# Chargement des données de médiane pour les graphiques de recommandation
mediane <- read_excel("enfants.xlsx", sheet = 7)
# Fonction pour créer une table de statistiques avec flextable
create_stats_table <- function(design, variables, title) {
# Initialiser un data frame pour stocker les résultats
stats_df <- data.frame(
Statistique = c("Minimum", "1er Quantile", "Moyenne", "Médiane",
"3e Quantile", "Variance", "Ecart-type", "Maximum")
)
# Calculer les statistiques pour chaque variable
for (var in variables) {
data_var <- design$variables[[var]]
# Calcul des statistiques
moyenne <- round(svymean(as.formula(paste0("~", var)), design)[1], 2)
variance <- round(svyvar(as.formula(paste0("~", var)), design, na.rm = TRUE)[1], 2)
ecart_type <- round(sqrt(variance), 2)
quantiles <- svyquantile(as.formula(paste0("~", var)), design, c(0.25, 0.5, 0.75), ci = FALSE)[1]
quantil <- as.data.frame(quantiles)
minimum <- round(min(data_var, na.rm = TRUE), 3)
maximum <- round(max(data_var, na.rm = TRUE), 3)
# Ajouter les statistiques au tableau
stats_df[[var]] <- round(c(minimum, quantil[1,1], moyenne, quantil[1,2],
quantil[1,3], variance, ecart_type, maximum), 3)
}
# Créer un flextable attrayant
ft <- flextable(stats_df) %>%
theme_vanilla() %>%
bg(bg = "#f5f5f5", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer(part = "all") %>%
set_caption(caption = title) %>%
autofit()%>%
add_header_row(values = title , colwidths = length(variables)) %>%
align(align = "center", part = "header") %>%
align(j = 1, align = "left", part = "body")
return(ft)
}
# Fonction pour créer des graphiques highcharter
create_boxplot_hc <- function(data, y_var, title, color = "#5D5CDE") {
hcboxplot(x = data[[y_var]], name = y_var, color = color) %>%
hc_title(text = title) %>%
hc_xAxis(title = list(text = "")) %>%
hc_yAxis(title = list(text = y_var)) %>%
hc_tooltip(valueDecimals = 2) %>%
hc_exporting(enabled = TRUE) %>%
hc_add_theme(hc_theme_google())
}
```
Résumé {#resume data-icon="fa-chart-pie"}
=====================================================================
Row
-----------------------------------------------------------------------
### Vue d'ensemble
```{r}
# Créer un résumé des statistiques clés
total_enfants <- nrow(enfglob)
regions_count <- length(unique(enfglob$coderegion))
avg_energy <- round(svymean(~energiekcal_ing, enerenf)[1], 2)
avg_protein <- round(svymean(~proteines_ing, dema)[1], 2)
# Créer des valueBoxes pour les statistiques clés
valueBox(value = formatC(total_enfants, format = "d", big.mark = " "),
caption = "Nombre total d'enfants",
icon = "fas fa-child",
color = "#5D5CDE")
```
### Énergie moyenne
```{r}
valueBox(value = paste0(formatC(avg_energy, format = "f", digits = 1), " kcal"),
caption = "Apport énergétique moyen",
icon = "fas fa-bolt",
color = "#28a745")
```
### Protéines moyennes
```{r}
valueBox(value = paste0(formatC(avg_protein, format = "f", digits = 1), " g"),
caption = "Protéines moyennes ingérées",
icon = "fas fa-drumstick-bite",
color = "#17a2b8")
```
### Régions
```{r}
valueBox(value = regions_count,
caption = "Nombre de régions étudiées",
icon = "fas fa-map-marked-alt",
color = "#ffc107")
```
Row
-----------------------------------------------------------------------
### Répartition des apports énergétiques par région
```{r}
# Calculer les moyennes d'énergie par région pour le graphique
energie_region <- svyby(~energiekcal_ing, ~coderegion, enerenfre, svymean)[, c("coderegion", "energiekcal_ing")]
energie_region$coderegion <- factor(energie_region$coderegion, levels = c("Dosso", "Maradi", "Tahoua", "Tillabery", "Zinder"))
# Graphique highcharter
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Apport énergétique moyen par région") %>%
hc_xAxis(categories = energie_region$coderegion) %>%
hc_yAxis(
title = list(text = "Énergie (kcal)"),
min = 0
) %>%
hc_add_series(
name = "Énergie (kcal)",
data = energie_region$energiekcal_ing,
colorByPoint = TRUE,
dataLabels = list(enabled = TRUE, format = "{point.y:.1f}")
) %>%
hc_tooltip(
pointFormat = '<span style="color:{point.color}">\u25CF</span> {series.name}: <b>{point.y:.1f} kcal</b><br/>'
) %>%
hc_plotOptions(
column = list(
borderRadius = 4,
colorByPoint = TRUE,
colors = c("#5D5CDE", "#28a745", "#17a2b8", "#ffc107", "#dc3545")
)
) %>%
hc_exporting(enabled = TRUE)
```
### Distribution des protéines par type et région
```{r}
# Préparer les données pour le graphique des protéines
proteines_data <- svyby(~proteines_vegetales_ing + proteines_animales_ing + proteines_autres_ing,
~coderegion, demare, svymean)
# Transformer pour highcharter
hc_data <- list(
list(name = "Protéines végétales", data = proteines_data$proteines_vegetales_ing),
list(name = "Protéines animales", data = proteines_data$proteines_animales_ing),
list(name = "Autres protéines", data = proteines_data$proteines_autres_ing)
)
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Composition des protéines par région") %>%
hc_xAxis(categories = proteines_data$coderegion) %>%
hc_yAxis(
title = list(text = "Grammes"),
stackLabels = list(enabled = TRUE, style = list(fontWeight = "bold"))
) %>%
hc_plotOptions(
column = list(
stacking = "normal",
dataLabels = list(
enabled = TRUE,
format = "{point.y:.1f}"
)
)
) %>%
hc_add_series(name = "Protéines végétales", data = proteines_data$proteines_vegetales_ing, color = "#28a745") %>%
hc_add_series(name = "Protéines animales", data = proteines_data$proteines_animales_ing, color = "#5D5CDE") %>%
hc_add_series(name = "Autres protéines", data = proteines_data$proteines_autres_ing, color = "#ffc107") %>%
hc_tooltip(
headerFormat = '<span style="font-size:10px">{point.key}</span><table>',
pointFormat = '<tr><td style="color:{series.color};padding:0">{series.name}: </td><td style="padding:0"><b>{point.y:.1f} g</b></td></tr>',
footerFormat = '</table>',
shared = TRUE,
useHTML = TRUE
) %>%
hc_exporting(enabled = TRUE)
```
Analyse globale {#analyse-globale data-icon="fa-microscope"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Macronutriments
```{r}
# Initialiser un data frame pour stocker les résultats
statistiquesma <- data.frame(
Statistique = c("Minimum", "1er Quantile", "Moyenne", "Médiane", "3e Quantile",
"Variance", "Ecart-type", "Maximum")
)
# Calcul des statistiques pondérées pour chaque variable
for (var in macronutriment) {
i = which(macronutriment == var)
# Calcul des différentes statistiques
moyenne <- round(svymean(as.formula(paste0("~", var)), dema)[1], 2)
variance <- round(svyvar(as.formula(paste0("~", var)), dema, na.rm = TRUE)[1], 2)
ecart_type <- round(sqrt(variance), 2)
quantiles <- svyquantile(as.formula(paste0("~", var)), dema, c(0.25, 0.5, 0.75), ci=FALSE)[1]
quantil <- as.data.frame(quantiles)
minimum <- min(enfmacro[[var]])
maximum <- max(enfmacro[[var]])
# Ajouter les statistiques au tableau
statistiquesma[[var]] <- round(c(minimum, quantil[1,1], moyenne, quantil[1,2], quantil[1,3],
variance, ecart_type, maximum), 3)
}
# Création d'un flextable attrayant
ft_macro <- flextable(statistiquesma) %>%
theme_booktabs() %>%
color(part = "header", color = "white") %>%
bg(part = "header", bg = "#2c3e50") %>%
bold(part = "header") %>%
fontsize(size = 11, part = "all") %>%
autofit() %>%
add_header_row(values = "Statistiques descriptives des macronutriments", colwidths = ncol(statistiquesma)) %>%
align(align = "center", part = "header") %>%
align(j = 1, align = "left", part = "body")
ft_macro
```
### Micronutriments
```{r}
# Initialiser un data frame pour stocker les résultats
statistiquesmi <- data.frame(
Statistique = c("Minimum", "1er Quantile", "Moyenne", "Médiane", "3e Quantile",
"Variance", "Ecart-type", "Maximum")
)
# Calcul des statistiques pondérées pour chaque variable
for (var in micronutriment) {
i = which(micronutriment == var)
# Calcul des différentes statistiques
moyenne <- round(svymean(as.formula(paste0("~", var)), demi)[1], 2)
variance <- round(svyvar(as.formula(paste0("~", var)), demi, na.rm = TRUE)[1], 2)
ecart_type <- round(sqrt(variance), 2)
quantiles <- svyquantile(as.formula(paste0("~", var)), demi, c(0.25, 0.5, 0.75), ci=FALSE)[1]
quantil <- as.data.frame(quantiles)
minimum <- min(enfmicro[[var]])
maximum <- max(enfmicro[[var]])
# Ajouter les statistiques au tableau
statistiquesmi[[var]] <- round(c(minimum, quantil[1,1], moyenne, quantil[1,2], quantil[1,3],
variance, ecart_type, maximum), 2)
}
# Création d'un flextable attrayant
ft_micro <- flextable(statistiquesmi) %>%
theme_booktabs() %>%
color(part = "header", color = "white") %>%
bg(part = "header", bg = "#27ae60") %>%
bold(part = "header") %>%
fontsize(size = 11, part = "all") %>%
autofit() %>%
add_header_row(values = "Statistiques descriptives des micronutriments", colwidths = ncol(statistiquesmi)) %>%
align(align = "center", part = "header") %>%
align(j = 1, align = "left", part = "body")
ft_micro
```
### Énergie
```{r}
# Créer une distribution de l'énergie avec highcharter
hc_energie_dist <- hchart(
density(enfenergie$energiekcal_ing),
type = "area",
name = "Densité",
color = "#5D5CDE"
) %>%
hc_title(text = "Distribution de l'apport énergétique (kcal)") %>%
hc_xAxis(title = list(text = "Énergie (kcal)")) %>%
hc_yAxis(title = list(text = "Densité")) %>%
hc_tooltip(valueDecimals = 5) %>%
hc_plotOptions(
area = list(
fillOpacity = 0.5
)
) %>%
hc_add_theme(hc_theme_google())
# Ajouter des lignes verticales pour les quantiles
hc_energie_dist <- hc_energie_dist %>%
hc_xAxis(
plotLines = list(
list(
value = svyquantile(~energiekcal_ing, enerenf, c(0.25))[1][1],
color = "#28a745",
width = 2,
label = list(text = "Q1", style = list(color = "#28a745"))
),
list(
value = svyquantile(~energiekcal_ing, enerenf, c(0.5))[1][1],
color = "#ffc107",
width = 2,
label = list(text = "Médiane", style = list(color = "#ffc107"))
),
list(
value = svyquantile(~energiekcal_ing, enerenf, c(0.75))[1][1],
color = "#dc3545",
width = 2,
label = list(text = "Q3", style = list(color = "#dc3545"))
),
list(
value = svymean(~energiekcal_ing, enerenf)[1],
color = "#17a2b8",
width = 2,
dashStyle = "shortdash",
label = list(text = "Moyenne", style = list(color = "#17a2b8"))
)
)
)
hc_energie_dist
```
Analyse régionale {#analyse-regionale data-icon="fa-map-marked-alt"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Macronutriments (1) {data-height=800}
```{r}
# Définition des couleurs pour chaque nutriment
couleurs <- list(
# Macronutriments
proteines_ing = "#FF0000", # Rouge
lipides_ing = "#FFA500", # Orange
glucides_ing = "#FFFF00", # Jaune
fibres_ing = "#008000", # Vert
choles_ing = "#800080", # Violet
proteines_autres_ing = "#FF4500", # Rouge-orangé
proteines_vegetales_ing = "#32CD32", # Vert lime
proteines_animales_ing = "#8B0000", # Rouge foncé
# Micronutriments
calcium_ing = "#00BFFF", # Bleu ciel
fer_ing = "#B22222", # Rouge brique
zinc_ing = "#708090", # Gris ardoise
vit_a_rae_ing = "#FF8C00", # Orange foncé
vit_d_ing = "#FFD700", # Or
vit_e_ing = "#9ACD32", # Jaune-vert
folate_vb9_ing = "#4B0082", # Indigo
vit_b12_ing = "#0000FF", # Bleu
vit_c_ing = "#7CFC00" # Vert citron
)
# Unités pour chaque nutriment
unites <- list(
proteines_ing = "g",
lipides_ing = "g",
glucides_ing = "g",
fibres_ing = "g",
choles_ing = "mg",
proteines_autres_ing = "g",
proteines_vegetales_ing = "g",
proteines_animales_ing = "g",
calcium_ing = "mg",
fer_ing = "mg",
zinc_ing = "mg",
vit_a_rae_ing = "μg RAE",
vit_d_ing = "μg",
vit_e_ing = "mg",
folate_vb9_ing = "μg",
vit_b12_ing = "μg",
vit_c_ing = "mg"
)
# Fonction pour identifier les outliers selon la méthode des boxplots
get_outliers <- function(x, weights, lower_fence, upper_fence) {
outliers <- x[x < lower_fence | x > upper_fence]
outliers_weights <- weights[x < lower_fence | x > upper_fence]
return(list(values = outliers, weights = outliers_weights))
}
# Noms lisibles pour chaque nutriment
noms_lisibles <- list(
proteines_ing = "Protéines",
lipides_ing = "Lipides",
glucides_ing = "Glucides",
fibres_ing = "Fibres",
choles_ing = "Cholestérol",
proteines_autres_ing = "Autres protéines",
proteines_vegetales_ing = "Protéines végétales",
proteines_animales_ing = "Protéines animales",
calcium_ing = "Calcium",
fer_ing = "Fer",
zinc_ing = "Zinc",
vit_a_rae_ing = "Vitamine A",
vit_d_ing = "Vitamine D",
vit_e_ing = "Vitamine E",
folate_vb9_ing = "Folate (B9)",
vit_b12_ing = "Vitamine B12",
vit_c_ing = "Vitamine C"
)
# Liste des macronutriments (dans enfmacrore)
macronutriments <- c(
"proteines_ing", "lipides_ing", "glucides_ing", "fibres_ing", "choles_ing",
"proteines_autres_ing", "proteines_vegetales_ing", "proteines_animales_ing"
)
# Liste des micronutriments (dans enfmicrore)
micronutriments <- c(
"calcium_ing", "fer_ing", "zinc_ing", "vit_a_rae_ing", "vit_d_ing",
"vit_e_ing", "folate_vb9_ing", "vit_b12_ing", "vit_c_ing"
)
# Liste de tous les nutriments
tous_nutriments <- c(macronutriments, micronutriments)
# Fonction pour créer un boxplot pour un nutriment donné
creer_boxplot <- function(nutriment) {
# Déterminer quel dataframe utiliser en fonction du nutriment
if (nutriment %in% macronutriments) {
dataframe <- enfmacrore
} else {
dataframe <- enfmicrore
}
# Préparation des données pondérées avec outliers
donnees_completes <- dataframe %>%
group_by(coderegion) %>%
summarise(
q1 = wtd.quantile(.data[[nutriment]], weights = dataframe$Pond_Ind, probs = 0.25),
median = wtd.quantile(.data[[nutriment]], weights = dataframe$Pond_Ind, probs = 0.5),
q3 = wtd.quantile(.data[[nutriment]], weights = dataframe$Pond_Ind, probs = 0.75),
iqr = q3 - q1,
lower_fence = q1 - 1.5 * iqr,
upper_fence = q3 + 1.5 * iqr,
min = pmax(min(.data[[nutriment]], na.rm = TRUE), lower_fence), # Pour le whisker inférieur
max = pmin(max(.data[[nutriment]], na.rm = TRUE), upper_fence) # Pour le whisker supérieur
)
# Création des listes pour les outliers
outliers_data <- list()
for (region in unique(dataframe$coderegion)) {
subset_data <- dataframe %>% filter(coderegion == region)
region_stats <- donnees_completes %>% filter(coderegion == region)
outliers <- get_outliers(
subset_data[[nutriment]],
subset_data$Pond_Ind,
region_stats$lower_fence,
region_stats$upper_fence
)
if (length(outliers$values) > 0) {
for (i in 1:length(outliers$values)) {
outliers_data[[length(outliers_data) + 1]] <- list(
x = which(unique(dataframe$coderegion) == region) - 1, # Ajustement pour l'index
y = outliers$values[i]
)
}
}
}
# Titre et unité
titre <- paste("Distribution de", noms_lisibles[[nutriment]], "par région")
unite <- unites[[nutriment]]
y_axis_title <- paste(noms_lisibles[[nutriment]], "(", unite, ")")
# Création du boxplot avec highcharter incluant les outliers
hchart(donnees_completes, "boxplot",
hcaes(x = coderegion, low = min, q1 = q1, median = median, q3 = q3, high = max),
color = couleurs[[nutriment]],
name = noms_lisibles[[nutriment]]) %>%
hc_add_series(
data = outliers_data,
type = "scatter",
name = "Outliers",
marker = list(fillColor = couleurs[[nutriment]], radius = 3, symbol = "circle"),
color = couleurs[[nutriment]]
) %>%
hc_chart(type = "column") %>% # Assure que les boxplots sont verticaux
hc_title(text = titre) %>%
hc_xAxis(title = list(text = "Code Région")) %>%
hc_yAxis(min= -5, title = list(text = y_axis_title)) %>%
hc_tooltip(
formatter = JS(paste0(
"function() {",
" if (this.series.name === 'Outliers') {",
" return '<b>Région:</b> ' + this.series.chart.xAxis[0].categories[this.x] + '<br>' +",
" '<b>", noms_lisibles[[nutriment]], ":</b> ' + this.y.toFixed(2) + ' ", unite, "';",
" } else {",
" var s = '<b>Région:</b> ' + this.x + '<br>';",
" s += '<b>Maximum:</b> ' + this.point.high.toFixed(2) + ' ", unite, "<br>';",
" s += '<b>3ème quartile:</b> ' + this.point.q3.toFixed(2) + ' ", unite, "<br>';",
" s += '<b>Médiane:</b> ' + this.point.median.toFixed(2) + ' ", unite, "<br>';",
" s += '<b>1er quartile:</b> ' + this.point.q1.toFixed(2) + ' ", unite, "<br>';",
" s += '<b>Minimum:</b> ' + this.point.low.toFixed(2) + ' ", unite, "';",
" return s;",
" }",
"}"
))
)
}
# Création d'une fonction pour générer tous les boxplots
generer_tous_les_boxplots <- function() {
# Liste pour stocker tous les graphiques
tous_les_boxplots <- list()
# Génération d'un boxplot pour chaque nutriment
for (nutriment in tous_nutriments) {
message(paste("Création du boxplot pour", noms_lisibles[[nutriment]]))
tous_les_boxplots[[nutriment]] <- tryCatch({
creer_boxplot(nutriment)
}, error = function(e) {
message(paste("Erreur lors de la création du boxplot pour", nutriment, ":", e$message))
NULL
})
# Option pour sauvegarder le graphique si nécessaire
if (!is.null(tous_les_boxplots[[nutriment]])) {
# saveWidget(tous_les_boxplots[[nutriment]], paste0("boxplot_", nutriment, ".html"))
}
}
return(tous_les_boxplots)
}
# Exécution de la fonction pour générer tous les boxplots
tous_les_boxplots <- generer_tous_les_boxplots()
```
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 30%;">
#### protéines
```{r}
tous_les_boxplots$proteines_ing
```
</div> <div style="width: 30%;">
#### glucides
```{r}
tous_les_boxplots$glucides_ing
```
</div> <div style="width: 30%;">
#### lipides
```{r}
tous_les_boxplots$lipides_ing
```
</div> </div>
### Types de Protéines {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 30%;">
#### protéines végétales
```{r}
tous_les_boxplots$proteines_vegetales_ing
```
</div> <div style="width: 30%;">
#### protéines animales
```{r}
tous_les_boxplots$proteines_animales_ing
```
</div> <div style="width: 30%;">
#### protéines autres
```{r}
tous_les_boxplots$proteines_autres_ing
```
</div> </div>
### Autres macro
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 40%;">
#### fibres
```{r}
tous_les_boxplots$fibres_ing
```
</div> <div style="width: 40%;">
#### cholesterol
```{r}
tous_les_boxplots$choles_ing
```
</div> </div>
### Micronutriments (1) {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 30%;">
#### Calcium
```{r}
tous_les_boxplots$calcium_ing
```
</div> <div style="width: 30%;">
#### Fer
```{r}
tous_les_boxplots$fer_ing
```
</div> <div style="width: 30%;">
#### Zinc
```{r}
tous_les_boxplots$zinc_ing
```
</div> </div>
### Micronutriments (2)
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 30%;">
#### Vitamine A
```{r}
tous_les_boxplots$vit_a_rae_ing
```
</div> <div style="width: 30%;">
#### Vitamine D
```{r}
tous_les_boxplots$vit_d_ing
```
</div> <div style="width: 30%;">
#### Vitamine E
```{r}
tous_les_boxplots$vit_e_ing
```
</div> </div>
### Micronutriments (3)
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 30%;">
#### Folate (B9)
```{r}
tous_les_boxplots$folate_vb9_ing
```
</div> <div style="width: 30%;">
#### Vitamine B12
```{r}
tous_les_boxplots$vit_b12_ing
```
</div> <div style="width: 30%;">
#### Vitamine C
```{r}
tous_les_boxplots$vit_c_ing
```
</div> </div>
### Énergie par région {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 48%;">
```{r}
# Fonction pour identifier les outliers selon la méthode des boxplots
get_outliers <- function(x, weights, lower_fence, upper_fence) {
outliers <- x[x < lower_fence | x > upper_fence]
outliers_weights <- weights[x < lower_fence | x > upper_fence]
return(list(values = outliers, weights = outliers_weights))
}
# Préparation des données pondérées avec outliers pour l'énergie
donnees_completes <- enfenre %>%
group_by(coderegion) %>%
summarise(
q1 = wtd.quantile(energiekcal_ing, weights = enfenre$Pond_Ind, probs = 0.25),
median = wtd.quantile(energiekcal_ing, weights = enfenre$Pond_Ind, probs = 0.5),
q3 = wtd.quantile(energiekcal_ing, weights = enfenre$Pond_Ind, probs = 0.75),
iqr = q3 - q1,
lower_fence = q1 - 1.5 * iqr,
upper_fence = q3 + 1.5 * iqr,
min = pmax(min(energiekcal_ing, na.rm = TRUE), lower_fence), # Pour le whisker inférieur
max = pmin(max(energiekcal_ing, na.rm = TRUE), upper_fence) # Pour le whisker supérieur
)
# Création des listes pour les outliers
outliers_data <- list()
for (region in unique(enfenre$coderegion)) {
subset_data <- enfenre %>% filter(coderegion == region)
region_stats <- donnees_completes %>% filter(coderegion == region)
outliers <- get_outliers(
subset_data$energiekcal_ing,
subset_data$Pond_Ind,
region_stats$lower_fence,
region_stats$upper_fence
)
if (length(outliers$values) > 0) {
for (i in 1:length(outliers$values)) {
outliers_data[[length(outliers_data) + 1]] <- list(
x = which(unique(enfenre$coderegion) == region) - 1, # Ajustement pour l'index
y = outliers$values[i]
)
}
}
}
# Création du boxplot avec highcharter incluant les outliers
energie_boxplot <- hchart(donnees_completes, "boxplot",
hcaes(x = coderegion, low = min, q1 = q1, median = median, q3 = q3, high = max),
color = "#FF9900",
name = "Énergie") %>%
hc_add_series(
data = outliers_data,
type = "scatter",
name = "Outliers",
marker = list(fillColor = "#FF9900", radius = 3, symbol = "circle"),
color = "#FF9900"
) %>%
hc_chart(type = "column") %>% # Assure que les boxplots sont verticaux
hc_title(text = "Distribution de l'énergie (kcal) par région") %>%
hc_xAxis(title = list(text = "Code Région")) %>%
hc_yAxis(title = list(text = "Énergie (kcal)")) %>%
hc_tooltip(
formatter = JS(
"function() {
if (this.series.name === 'Outliers') {
return '<b>Région:</b> ' + this.series.chart.xAxis[0].categories[this.x] + '<br>' +
'<b>Énergie:</b> ' + this.y.toFixed(2) + ' kcal';
} else {
var s = '<b>Région:</b> ' + this.x + '<br>';
s += '<b>Maximum:</b> ' + this.point.high.toFixed(2) + ' kcal<br>';
s += '<b>3ème quartile:</b> ' + this.point.q3.toFixed(2) + ' kcal<br>';
s += '<b>Médiane:</b> ' + this.point.median.toFixed(2) + ' kcal<br>';
s += '<b>1er quartile:</b> ' + this.point.q1.toFixed(2) + ' kcal<br>';
s += '<b>Minimum:</b> ' + this.point.low.toFixed(2) + ' kcal';
return s;
}
}"
)
)
energie_boxplot
```
</div> </div>
Analyse multidimensionnelle {#analyse-multidimensionnelle data-icon="fa-chart-network"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
```{r include=FALSE}
# Préparation des données pour l'ACP
# Création du tableau des moyennes agrégées de chaque nutriment selon la région
moyenfma <- data.frame(
Région = c("Dosso", "Maradi", "Tahoua", "Tillabery", "Zinder")
)
for(var in macrore) {
moyenne <- svyby(as.formula(paste0("~", var)), ~coderegion, demare, svymean, na.rm = TRUE)[2]
moyenfma[[var]] <- moyenne[, 1] * 1000000
}
moyenfma$choles_ing <- moyenfma$choles_ing / 1000
moyenfmi <- data.frame(
Région = c("Dosso", "Maradi", "Tahoua", "Tillabery", "Zinder")
)
for(var in microre) {
moyenne <- svyby(as.formula(paste0("~", var)), ~coderegion, demire, svymean, na.rm = TRUE)[2]
moyenfmi[[var]] <- moyenne[, 1]
}
moyenfmi$calcium_ing <- moyenfmi$calcium_ing * 1000
moyenfmi$fer_ing <- moyenfmi$fer_ing * 1000
moyenfmi$zinc_ing <- moyenfmi$zinc_ing * 1000
moyenfmi$vit_e_ing <- moyenfmi$vit_e_ing * 1000
moyenfmi$vit_c_ing <- moyenfmi$vit_c_ing * 1000
# Tableau final pour l'ACP
moyenf <- cbind(moyenfma, moyenfmi[2:10])
moyenfr <- moyenf[2:18]
# Afficher le tableau des données pour l'ACP
ft_acp_data <- flextable(moyenf) %>%
theme_zebra() %>%
bg(bg = "#F8F9FA", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer() %>%
set_caption("Données utilisées pour l'ACP") %>%
autofit()
```
```{r include=FALSE}
# Exécution de l'ACP
acpenf <- PCA(moyenf, scale.unit = TRUE, quali.sup = 1, graph = FALSE)
# KMO pour vérifier l'adéquation des données
kmo_result <- KMO(scale(moyenfr))
kmo_table <- data.frame(
Mesure = names(kmo_result$MSAi),
KMO = kmo_result$MSAi
)
# Obtenir les valeurs propres
vpenf <- get_eigenvalue(acpenf)
vpenf <- data.frame(vpenf)
vp_table <- data.frame(
Dimension = rownames(vpenf),
`Valeur propre` = vpenf$eigenvalue,
`% de variance` = vpenf$variance.percent,
`% cumulé` = vpenf$cumulative.variance.percent
)
# Afficher les tableaux
ft_kmo <- flextable(kmo_table) %>%
theme_vanilla() %>%
bg(bg = "#F8F9FA", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer() %>%
set_caption("Mesure KMO d'adéquation de l'échantillon") %>%
autofit()
ft_vp <- flextable(vp_table) %>%
theme_vanilla() %>%
bg(bg = "#F8F9FA", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer() %>%
set_caption("Valeurs propres et variance expliquée") %>%
autofit()
```
```{r include=FALSE}
# Visualisation de l'éboulis des valeurs propres avec Highcharter
hc_scree <- highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Éboulis des valeurs propres") %>%
hc_xAxis(categories = rownames(vpenf), title = list(text = "Dimensions")) %>%
hc_yAxis(
title = list(text = "Valeur propre"),
min = 0,
plotLines = list(list(
value = 1,
color = "red",
width = 2,
label = list(text = "Critère de Kaiser (VP = 1)", style = list(color = "red"))
))
) %>%
hc_add_series(
name = "Valeur propre",
data = vpenf$eigenvalue,
color = "#5D5CDE"
) %>%
hc_add_series(
name = "% cumulé",
data = vpenf$cumulative,
type = "line",
yAxis = 1,
color = "#FF7F0E"
) %>%
hc_yAxis_multiples(
list(
title = list(text = "Valeur propre"),
lineWidth = 2,
lineColor = "#5D5CDE",
min = 0
),
list(
title = list(text = "% cumulé"),
lineWidth = 2,
lineColor = "#FF7F0E",
opposite = TRUE,
labels = list(format = "{value}%"),
max = 100,
min = 0
)
) %>%
hc_tooltip(
shared = TRUE,
formatter = JS("function() {
return '<b>Dimension ' + this.x + '</b><br/>' +
'Valeur propre: ' + Highcharts.numberFormat(this.points[0].y, 2) + '<br/>' +
'% cumulé: ' + Highcharts.numberFormat(this.points[1].y, 2) + '%';
}")
) %>%
hc_plotOptions(
column = list(
pointPadding = 0.2,
borderWidth = 0
)
) %>%
hc_exporting(enabled = TRUE)
```
### Cercle des corrélations {data-height=800}
```{r}
# Création du cercle de corrélation avec ggplot2
p <- fviz_pca_var(acpenf,
col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
# Afficher avec plotly pour l'interactivité
p
```
```{r}
# Matrice de corrélation avec corrplot
mcenf <- round(cor(moyenfr, use = "pairwise.complete.obs"), 3)
corrplot(mcenf,
method = "circle",
type = "upper",
tl.col = "black",
tl.srt = 45,
addCoef.col = "black",
col = colorRampPalette(c("#5D5CDE", "white", "#FC4E07"))(200),
diag = FALSE)
```
### Biplot {data-height=800}
```{r}
# Biplot des individus et variables avec ggplot2
p_biplot <- fviz_pca_biplot(acpenf,
label = "all",
habillage = 1, # colorer par la variable qualitative supplémentaire
repel = TRUE, # éviter le chevauchement de texte
ggtheme = theme_minimal(),
title = "Biplot des individus et variables")
# Afficher avec plotly pour l'interactivité
p_biplot
```
Classification {#classification data-icon="fa-object-group"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Dendrogramme {data-height=800}
```{r}
# Préparer les données pour la classification hiérarchique
rownames(moyenfr) = moyenf$Région
scaled_data <- scale(moyenfr)
classifenf <- agnes(scaled_data, method = "ward")
classifenf2 <- as.hclust(classifenf)
fviz_dend(classifenf2,
rect = TRUE,
k = 3,
main = "Dendrogramme des régions")
```
Tests statistiques {#tests-statistiques data-icon="fa-flask"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Tests globaux {data-height=800}
#### Macro
```{r}
# Test de Kruskal-Wallis pour les macronutriments
test_results_macro <- data.frame(
Nutriment = character(),
`Chi-squared` = numeric(),
`Degrés de liberté` = numeric(),
`p-value` = numeric(),
Significatif = character(),
stringsAsFactors = FALSE
)
# Pondération des données pour les tests
enfmacrore_pondere <- enfmacrore[rep(1:nrow(enfmacrore), enfmacrore$Pond_Ind), ]
macro_a_tester <- colnames(enfmacrore_pondere)[1:8]
# Effectuer les tests de Kruskal-Wallis
for(col in macro_a_tester) {
test_kruskal = kruskal.test(as.formula(paste(col, "~ coderegion")), data = enfmacrore_pondere)
test_results_macro <- rbind(test_results_macro, data.frame(
Nutriment = col,
`Chi-squared` = round(test_kruskal$statistic, 2),
`Degrés de liberté` = test_kruskal$parameter,
`p-value` = test_kruskal$p.value,
Significatif = ifelse(test_kruskal$p.value < 0.05, "Oui", "Non"),
stringsAsFactors = FALSE
))
}
# Créer une table avec flextable
ft_kruskal_macro <- flextable(test_results_macro) %>%
theme_zebra() %>%
bg(bg = "#F8F9FA", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer() %>%
color(j = "Significatif", color = function(x) ifelse(x == "Oui", "green", "red")) %>%
set_caption("Tests de Kruskal-Wallis pour les macronutriments") %>%
autofit()
ft_kruskal_macro
```
#### Micro
```{r}
# Test de Kruskal-Wallis pour les micronutriments
test_results_micro <- data.frame(
Nutriment = character(),
`Chi-squared` = numeric(),
`Degrés de liberté` = numeric(),
`p-value` = numeric(),
Significatif = character(),
stringsAsFactors = FALSE
)
# Pondération des données pour les tests
enfmicrore_pondere <- enfmicrore[rep(1:nrow(enfmicrore), enfmicrore$Pond_Ind), ]
micro_a_tester <- colnames(enfmicrore_pondere)[1:9]
# Effectuer les tests de Kruskal-Wallis
for(col in micro_a_tester) {
test_kruskal = kruskal.test(as.formula(paste(col, "~ coderegion")), data = enfmicrore_pondere)
test_results_micro <- rbind(test_results_micro, data.frame(
Nutriment = col,
`Chi-squared` = round(test_kruskal$statistic, 2),
`Degrés de liberté` = test_kruskal$parameter,
`p-value` = test_kruskal$p.value,
Significatif = ifelse(test_kruskal$p.value < 0.05, "Oui", "Non"),
stringsAsFactors = FALSE
))
}
# Créer une table avec flextable
ft_kruskal_micro <- flextable(test_results_micro) %>%
theme_zebra() %>%
bg(bg = "#F8F9FA", part = "header") %>%
bold(part = "header") %>%
fontsize(size = 10, part = "all") %>%
align(align = "center", part = "all") %>%
border_outer() %>%
color(j = "Significatif", color = function(x) ifelse(x == "Oui", "green", "red")) %>%
set_caption("Tests de Kruskal-Wallis pour les micronutriments") %>%
autofit()
ft_kruskal_micro
```
### Comparaisons par paires {data-height=800}
```{r}
# Visualisation des p-values pour les tests Mann-Whitney sur les protéines
# Préparer les résultats pour un exemple (proteines_ing)
region_pairs <- c("Dosso_Maradi", "Dosso_Tahoua", "Dosso_Tillaberi", "Dosso_Zinder",
"Maradi_Tahoua", "Maradi_Tillaberi", "Maradi_Zinder",
"Tahoua_Tillaberi", "Tahoua_Zinder", "Tillaberi_Zinder")
# Calculer les p-values pour proteines_ing
p_values_proteines <- numeric(length(region_pairs))
names(p_values_proteines) <- region_pairs
for(i in 1:length(region_pairs)) {
pair <- unlist(strsplit(region_pairs[i], "_"))
# Test de Mann-Whitney
test_result <- wilcox.test(proteines_ing ~ coderegion,
data = enfmacrore, weights = Pond_Ind,
subset = coderegion %in% pair)
p_values_proteines[i] <- test_result$p.value
}
# Créer un tableau des p-values
p_value_matrix <- matrix(NA, nrow = 5, ncol = 5)
rownames(p_value_matrix) <- c("Dosso", "Maradi", "Tahoua", "Tillaberi", "Zinder")
colnames(p_value_matrix) <- c("Dosso", "Maradi", "Tahoua", "Tillaberi", "Zinder")
# Remplir la matrice
for(i in 1:length(region_pairs)) {
pair <- unlist(strsplit(region_pairs[i], "_"))
p_value_matrix[pair[1], pair[2]] <- p_values_proteines[i]
p_value_matrix[pair[2], pair[1]] <- p_values_proteines[i] # symétrique
}
# Nettoyer les noms des régions pour la visualisation
regions <- c("Dosso", "Maradi", "Tahoua", "Tillabery", "Zinder")
# Convertir la matrice en dataframe pour highcharter
p_value_df <- data.frame(
x = rep(regions, each = 5),
y = rep(regions, times = 5),
p_value = as.vector(p_value_matrix),
significance = as.vector(ifelse(is.na(p_value_matrix), NA,
ifelse(p_value_matrix < 0.05, "Significatif", "Non significatif")))
)
p_value_df <- p_value_df[!is.na(p_value_df$p_value),]
# Créer un heatmap des p-values avec highcharter
highchart() %>%
hc_chart(type = "heatmap") %>%
hc_title(text = "P-values des tests Mann-Whitney pour les protéines") %>%
hc_xAxis(categories = regions) %>%
hc_yAxis(categories = regions) %>%
hc_add_series(
data = lapply(1:nrow(p_value_df), function(i) {
list(
x = which(regions == p_value_df$x[i]) - 1,
y = which(regions == p_value_df$y[i]) - 1,
value = p_value_df$p_value[i],
significance = p_value_df$significance[i]
)
}),
colsize = 1,
rowsize = 1,
dataLabels = list(enabled = TRUE, format = "{point.value:.3f}")
) %>%
hc_colorAxis(
stops = list(
list(0, "#5D5CDE"), # Significatif
list(0.05, "#f7f7f7"), # Seuil de significativité
list(1, "#FC4E07") # Non significatif
),
min = 0,
max = 0.1
) %>%
hc_tooltip(
formatter = JS("function() {
return '<b>Comparaison:</b> ' + this.series.xAxis.categories[this.point.x] + ' vs ' +
this.series.yAxis.categories[this.point.y] + '<br>' +
'<b>p-value:</b> ' + Highcharts.numberFormat(this.point.value, 4) + '<br>' +
'<b>Significatif:</b> ' + (this.point.value < 0.05 ? 'Oui' : 'Non');
}")
) %>%
hc_legend(enabled = TRUE) %>%
hc_exporting(enabled = TRUE)
```
```{r}
# Faire de même pour le calcium
p_values_calcium <- numeric(length(region_pairs))
names(p_values_calcium) <- region_pairs
for(i in 1:length(region_pairs)) {
pair <- unlist(strsplit(region_pairs[i], "_"))
# Test de Mann-Whitney
test_result <- wilcox.test(calcium_ing ~ coderegion,
data = enfmicrore, weights = Pond_Ind,
subset = coderegion %in% pair)
p_values_calcium[i] <- test_result$p.value
}
regions <- c("Dosso","Maradi","Tahoua","Tillaberi","Zinder")
# Remplir la matrice
p_value_matrix_ca <- matrix(NA, nrow = 5, ncol = 5)
rownames(p_value_matrix_ca) <- regions
colnames(p_value_matrix_ca) <- regions
for(i in 1:length(region_pairs)) {
pair <- unlist(strsplit(region_pairs[i], "_"))
p_value_matrix_ca[pair[1], pair[2]] <- p_values_calcium[i]
p_value_matrix_ca[pair[2], pair[1]] <- p_values_calcium[i] # symétrique
}
# Convertir en dataframe
p_value_df_ca <- data.frame(
x = rep(regions, each = 5),
y = rep(regions, times = 5),
p_value = as.vector(p_value_matrix_ca),
significance = as.vector(ifelse(is.na(p_value_matrix_ca), NA,
ifelse(p_value_matrix_ca < 0.05, "Significatif", "Non significatif")))
)
p_value_df_ca <- p_value_df_ca[!is.na(p_value_df_ca$p_value),]
# Heatmap pour le calcium
highchart() %>%
hc_chart(type = "heatmap") %>%
hc_title(text = "P-values des tests Mann-Whitney pour le calcium") %>%
hc_xAxis(categories = regions) %>%
hc_yAxis(categories = regions) %>%
hc_add_series(
data = lapply(1:nrow(p_value_df_ca), function(i) {
list(
x = which(regions == p_value_df_ca$x[i]) - 1,
y = which(regions == p_value_df_ca$y[i]) - 1,
value = p_value_df_ca$p_value[i],
significance = p_value_df_ca$significance[i]
)
}),
colsize = 1,
rowsize = 1,
dataLabels = list(enabled = TRUE, format = "{point.value:.3f}")
) %>%
hc_colorAxis(
stops = list(
list(0, "#5D5CDE"), # Significatif
list(0.05, "#f7f7f7"), # Seuil de significativité
list(1, "#FC4E07") # Non significatif
),
min = 0,
max = 0.1
) %>%
hc_tooltip(
formatter = JS("function() {
return '<b>Comparaison:</b> ' + this.series.xAxis.categories[this.point.x] + ' vs ' +
this.series.yAxis.categories[this.point.y] + '<br>' +
'<b>p-value:</b> ' + Highcharts.numberFormat(this.point.value, 4) + '<br>' +
'<b>Significatif:</b> ' + (this.point.value < 0.05 ? 'Oui' : 'Non');
}")
) %>%
hc_legend(enabled = TRUE) %>%
hc_exporting(enabled = TRUE)
```
Recommandations {#recommandations data-icon="fa-lightbulb"}
=====================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Calcium {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 48%;">
```{r}
# Visualisation du calcium par région avec highcharter
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Apport en calcium par région") %>%
hc_xAxis(categories = mediane$Région) %>%
hc_yAxis(
title = list(text = "Calcium (mg)"),
min = 0
) %>%
hc_add_series(
name = "Calcium",
data = mediane$calcium_ing,
color = "#5D5CDE",
dataLabels = list(
enabled = TRUE,
format = "{point.y:.1f}"
)
) %>%
hc_tooltip(
headerFormat = '<span style="font-size:10px">{point.key}</span><table>',
pointFormat = '<tr><td style="color:{series.color};padding:0">{series.name}: </td><td style="padding:0"><b>{point.y:.1f} mg</b></td></tr>',
footerFormat = '</table>',
shared = TRUE,
useHTML = TRUE
) %>%
hc_plotOptions(
column = list(
colorByPoint = TRUE,
colors = viridis(5)
)
) %>%
hc_exporting(enabled = TRUE)
```
</div> </div>
### Vitamines {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 48%;">
#### A
```{r}
# Visualisation de la vitamine A par région
highchart() %>%
hc_chart(type = "spline") %>%
hc_title(text = "Apport en vitamine A par région") %>%
hc_xAxis(categories = mediane$Région) %>%
hc_yAxis(
title = list(text = "Vitamine A (µg RAE)"),
min = 0
) %>%
hc_add_series(
name = "Vitamine A",
data = mediane$vit_a_rae_ing,
color = "#FF7F0E",
marker = list(
enabled = TRUE,
radius = 6
),
dataLabels = list(
enabled = TRUE,
format = "{point.y:.1f}"
)
) %>%
hc_tooltip(
headerFormat = '<span style="font-size:10px">{point.key}</span><table>',
pointFormat = '<tr><td style="color:{series.color};padding:0">{series.name}: </td><td style="padding:0"><b>{point.y:.1f} µg RAE</b></td></tr>',
footerFormat = '</table>',
shared = TRUE,
useHTML = TRUE
) %>%
hc_exporting(enabled = TRUE)
```
</div> <div style="width: 48%;">
#### D ET B12
```{r}
# Création d'un graphique combiné barres + ligne pour vit D et B12
hc_vit_db12 <- highchart() %>%
hc_chart(zoomType = "xy") %>%
hc_title(text = "Apport en vitamines D et B12 par région") %>%
hc_xAxis(categories = mediane$Région) %>%
hc_yAxis_multiples(
list(
title = list(text = "Vitamine D"),
opposite = FALSE
),
list(
title = list(text = "Vitamine B12"),
opposite = TRUE
)
) %>%
hc_add_series(
name = "Vitamine D",
data = mediane$vit_d_ing,
type = "column",
color = "#3498db",
yAxis = 0,
dataLabels = list(enabled = TRUE, format = "{point.y}")
) %>%
hc_add_series(
name = "Vitamine B12",
data = mediane$vit_b12_ing,
type = "spline",
color = "#e74c3c",
yAxis = 1,
marker = list(enabled = TRUE),
dataLabels = list(enabled = TRUE, format = "{point.y}")
) %>%
hc_tooltip(shared = TRUE) %>%
hc_exporting(enabled = TRUE)
hc_vit_db12
```
</div> </div>
### Fer et Zinc {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 48%;">
#### FER
```{r}
# Visualisation du fer par région avec highcharter (graphique en secteurs)
highchart() %>%
hc_chart(type = "pie") %>%
hc_title(text = "Répartition du fer par région") %>%
hc_add_series(
name = "Fer",
data = lapply(1:nrow(mediane), function(i) {
list(
name = mediane$Région[i],
y = mediane$fer_ing[i],
dataLabels = list(
format = "{point.name}: {point.y:.1f} mg ({point.percentage:.1f}%)"
)
)
}),
showInLegend = TRUE
) %>%
hc_plotOptions(
pie = list(
allowPointSelect = TRUE,
cursor = "pointer",
depth = 35,
dataLabels = list(
enabled = TRUE,
format = "<b>{point.name}</b>: {point.y:.1f} mg"
)
)
) %>%
hc_tooltip(
pointFormat = '<span style="color:{point.color}">\u25CF</span> {series.name}: <b>{point.y:.1f} mg</b><br/>Pourcentage: <b>{point.percentage:.1f}%</b>'
) %>%
hc_exporting(enabled = TRUE)
```
</div> <div style="width: 48%;">
#### ZINC
```{r}
# Visualisation du zinc par région avec highcharter
highchart() %>%
hc_chart(type = "pie") %>%
hc_title(text = "Répartition du zinc par région") %>%
hc_add_series(
name = "Zinc",
data = lapply(1:nrow(mediane), function(i) {
list(
name = mediane$Région[i],
y = mediane$zinc_ing[i],
dataLabels = list(
format = "{point.name}: {point.y:.1f} mg ({point.percentage:.1f}%)"
)
)
}),
showInLegend = TRUE
) %>%
hc_plotOptions(
pie = list(
allowPointSelect = TRUE,
cursor = "pointer",
depth = 35,
dataLabels = list(
enabled = TRUE,
format = "<b>{point.name}</b>: {point.y:.1f} mg"
)
)
) %>%
hc_tooltip(
pointFormat = '<span style="color:{point.color}">\u25CF</span> {series.name}: <b>{point.y:.1f} mg</b><br/>Pourcentage: <b>{point.percentage:.1f}%</b>'
) %>%
hc_exporting(enabled = TRUE)
```
</div> </div>
### Vitamine C et E {data-height=800}
<div style="display: flex; flex-wrap: wrap; justify-content: space-around;">
<div style="width: 48%;">
#### Vitamine C
```{r}
# Visualisation de la vitamine C par région avec highcharter
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Apport en vitamine C par région") %>%
hc_xAxis(categories = mediane$Région) %>%
hc_yAxis(
title = list(text = "Vitamine C (mg)"),
min = 0
) %>%
hc_add_series(
name = "Vitamine C",
data = mediane$vit_c_ing,
colorByPoint = TRUE,
colors = colorRampPalette(c("#08519C", "#3182BD", "#6BAED6", "#9ECAE1", "#C6DBEF"))(5),
dataLabels = list(
enabled = TRUE,
format = "{point.y:.1f}"
)
) %>%
hc_tooltip(
headerFormat = '<span style="font-size:10px">{point.key}</span><table>',
pointFormat = '<tr><td style="color:{point.color};padding:0">{series.name}: </td><td style="padding:0"><b>{point.y:.1f} mg</b></td></tr>',
footerFormat = '</table>',
shared = TRUE,
useHTML = TRUE
) %>%
hc_plotOptions(
column = list(
borderRadius = 5,
borderWidth = 0
)
) %>%
hc_exporting(enabled = TRUE)
```
</div> <div style="width: 48%;">
#### Vitamine E
```{r}
# Visualisation de la vitamine E par région
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "Apport en vitamine E par région") %>%
hc_xAxis(categories = mediane$Région) %>%
hc_yAxis(
title = list(text = "Vitamine E (mg)"),
min = 0
) %>%
hc_add_series(
name = "Vitamine E",
data = mediane$vit_e_ing,
colorByPoint = TRUE,
colors = colorRampPalette(c("#00441B", "#006D2C", "#238B45", "#41AB5D", "#74C476"))(5),
dataLabels = list(
enabled = TRUE,
format = "{point.y:.1f}"
)
) %>%
hc_tooltip(
headerFormat = '<span style="font-size:10px">{point.key}</span><table>',
pointFormat = '<tr><td style="color:{point.color};padding:0">{series.name}: </td><td style="padding:0"><b>{point.y:.1f} mg</b></td></tr>',
footerFormat = '</table>',
shared = TRUE,
useHTML = TRUE
) %>%
hc_plotOptions(
bar = list(
borderRadius = 5,
borderWidth = 0
)
) %>%
hc_exporting(enabled = TRUE)
```
</div> </div>
À propos {#a-propos data-icon="fa-info-circle"}
=====================================================================
Row
-----------------------------------------------------------------------
### À propos de cette étude
<div style="text-align: justify; padding: 20px; background-color: #f8f9fa; border-radius: 10px; border-left: 5px solid #3498db;color: black;" class="text-dark">
Ce tableau de bord présente une analyse nutritionnelle des enfants au Niger, réalisée dans le cadre du Programme National d'Information Nutritionnelle (PNIN).
**Objectifs de l'étude:**
L'objectif principal est d'analyser les apports en macro et micronutriments chez les enfants dans différentes régions du Niger. Cette analyse vise à:
1. Évaluer les niveaux d'apport en nutriments essentiels
2. Identifier les disparités régionales
3. Déterminer si ces différences sont statistiquement significatives
4. Produire des recommandations basées sur les résultats
**Méthodologie:**
- Collecte de données sur les apports nutritionnels des enfants dans 5 régions du Niger
- Analyse statistique descriptive et inférentielle
- Utilisation de méthodes d'analyse multidimensionnelle (ACP)
- Classification hiérarchique pour identifier des profils nutritionnels
- Tests non paramétriques pour évaluer les différences inter-régionales
**Interprétation des résultats:**
- Les tableaux descriptifs présentent les statistiques de base pour chaque nutriment
- Les graphiques illustrent les disparités entre régions
- L'ACP permet d'identifier les corrélations entre nutriments et les profils régionaux
- Les tests statistiques confirment si les différences observées sont significatives
**Recommandations:**
Des recommandations nutritionnelles adaptées à chaque région peuvent être formulées en fonction des déficits identifiés par cette analyse.</div>
</div>
</div>