ODD
23622
2025-11-10
library(shiny)
library(dplyr)##
## Attachement du package : 'dplyr'## Les objets suivants sont masqués depuis 'package:stats':
##
## filter, lag## Les objets suivants sont masqués depuis 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)df <- readr::read_csv("enquete_menages_2024.csv", show_col_types = FALSE)
# Afficher les 10 premières lignes
head(df, 10)## # A tibble: 10 × 16
## id_menage region milieu taille_menage sexe_chef age_chef revenu_mensuel
## <dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl>
## 1 1 Nouakchott Urbain 5 Homme 42 520000
## 2 2 Hodh Charghi Rural 8 Homme 55 95000
## 3 3 Trarza Rural 6 Femme 38 145000
## 4 4 Nouakchott Urbain 4 Homme 35 680000
## 5 5 Hodh Gharbi Rural 9 Homme 48 78000
## 6 6 Assaba Rural 7 Homme 52 165000
## 7 7 Nouakchott Urbain 3 Femme 31 380000
## 8 8 Tagant Rural 10 Homme 58 110000
## 9 9 Inchiri Rural 5 Homme 45 152000
## 10 10 Nouakchott Urbain 4 Homme 29 495000
## # ℹ 9 more variables: jours_cereales <dbl>, jours_legumineuses <dbl>,
## # jours_laitiers <dbl>, jours_viande <dbl>, jours_legumes_vitA <dbl>,
## # jours_autres_legumes <dbl>, jours_oeufs <dbl>, jours_sucre_huile <dbl>,
## # nb_groupes_hdds <dbl># Dimensions (lignes, colonnes)
dim(df)## [1] 205 16# Structure : types de variables (numérique, caractère, etc.)
str(df)## spc_tbl_ [205 × 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ id_menage : num [1:205] 1 2 3 4 5 6 7 8 9 10 ...
## $ region : chr [1:205] "Nouakchott" "Hodh Charghi" "Trarza" "Nouakchott" ...
## $ milieu : chr [1:205] "Urbain" "Rural" "Rural" "Urbain" ...
## $ taille_menage : num [1:205] 5 8 6 4 9 7 3 10 5 4 ...
## $ sexe_chef : chr [1:205] "Homme" "Homme" "Femme" "Homme" ...
## $ age_chef : num [1:205] 42 55 38 35 48 52 31 58 45 29 ...
## $ revenu_mensuel : num [1:205] 520000 95000 145000 680000 78000 165000 380000 110000 152000 495000 ...
## $ jours_cereales : num [1:205] 7 6 7 7 5 7 7 6 6 7 ...
## $ jours_legumineuses : num [1:205] 4 2 3 5 1 3 4 2 3 5 ...
## $ jours_laitiers : num [1:205] 5 1 2 6 0 3 4 1 4 5 ...
## $ jours_viande : num [1:205] 3 1 2 5 0 2 3 1 2 4 ...
## $ jours_legumes_vitA : num [1:205] 4 2 3 5 1 3 4 2 2 5 ...
## $ jours_autres_legumes: num [1:205] 6 3 4 7 2 5 5 3 4 6 ...
## $ jours_oeufs : num [1:205] 2 0 1 3 0 1 2 0 1 3 ...
## $ jours_sucre_huile : num [1:205] 6 4 5 7 3 5 6 4 5 7 ...
## $ nb_groupes_hdds : num [1:205] 7 3 5 9 2 6 7 3 5 8 ...
## - attr(*, "spec")=
## .. cols(
## .. id_menage = col_double(),
## .. region = col_character(),
## .. milieu = col_character(),
## .. taille_menage = col_double(),
## .. sexe_chef = col_character(),
## .. age_chef = col_double(),
## .. revenu_mensuel = col_double(),
## .. jours_cereales = col_double(),
## .. jours_legumineuses = col_double(),
## .. jours_laitiers = col_double(),
## .. jours_viande = col_double(),
## .. jours_legumes_vitA = col_double(),
## .. jours_autres_legumes = col_double(),
## .. jours_oeufs = col_double(),
## .. jours_sucre_huile = col_double(),
## .. nb_groupes_hdds = col_double()
## .. )
## - attr(*, "problems")=<externalptr># 2) Valeurs manquantes
sum(is.na(df))## [1] 0colSums(is.na(df))## id_menage region milieu
## 0 0 0
## taille_menage sexe_chef age_chef
## 0 0 0
## revenu_mensuel jours_cereales jours_legumineuses
## 0 0 0
## jours_laitiers jours_viande jours_legumes_vitA
## 0 0 0
## jours_autres_legumes jours_oeufs jours_sucre_huile
## 0 0 0
## nb_groupes_hdds
## 0stats_base <- df %>%
summarise(
n = n(),
# Revenu mensuel
revenu_moy = mean(revenu_mensuel),
revenu_med = median(revenu_mensuel),
revenu_sd = sd(revenu_mensuel),
revenu_min = min(revenu_mensuel),
revenu_q1 = as.numeric(quantile(revenu_mensuel, 0.25)),
revenu_q3 = as.numeric(quantile(revenu_mensuel, 0.75)),
revenu_max = max(revenu_mensuel),
# Taille du ménage
taille_moy = mean(taille_menage),
taille_med = median(taille_menage),
taille_sd = sd(taille_menage),
taille_min = min(taille_menage),
taille_q1 = as.numeric(quantile(taille_menage, 0.25)),
taille_q3 = as.numeric(quantile(taille_menage, 0.75)),
taille_max = max(taille_menage)
)
stats_base## # A tibble: 1 × 15
## n revenu_moy revenu_med revenu_sd revenu_min revenu_q1 revenu_q3
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 205 254156. 155000 184829. 68000 112000 450000
## # ℹ 8 more variables: revenu_max <dbl>, taille_moy <dbl>, taille_med <dbl>,
## # taille_sd <dbl>, taille_min <dbl>, taille_q1 <dbl>, taille_q3 <dbl>,
## # taille_max <dbl>seuil_usd_ppp <- 2.15
ppa_mru_par_usd <- 600
seuil_mru_jour <- seuil_usd_ppp * ppa_mru_par_usd
seuil_mru_jour## [1] 1290df_odd1 <- df %>%
mutate(
# Urbain = Nouakchott uniquement (selon ta consigne)
milieu_def = ifelse(region == "Nouakchott",
"Urbain (Nouakchott)",
"Rural (Autres régions)"),
# Revenu par tête et pauvreté
revenu_par_tete = revenu_mensuel / taille_menage,
revenu_par_tete_jour_mru = revenu_par_tete / 30,
revenu_par_tete_jour_usd_ppp = revenu_par_tete_jour_mru / ppa_mru_par_usd,
menage_pauvre = ifelse(revenu_par_tete_jour_usd_ppp < seuil_usd_ppp, 1, 0)
)
head(df_odd1, 5)## # A tibble: 5 × 21
## id_menage region milieu taille_menage sexe_chef age_chef revenu_mensuel
## <dbl> <chr> <chr> <dbl> <chr> <dbl> <dbl>
## 1 1 Nouakchott Urbain 5 Homme 42 520000
## 2 2 Hodh Charghi Rural 8 Homme 55 95000
## 3 3 Trarza Rural 6 Femme 38 145000
## 4 4 Nouakchott Urbain 4 Homme 35 680000
## 5 5 Hodh Gharbi Rural 9 Homme 48 78000
## # ℹ 14 more variables: jours_cereales <dbl>, jours_legumineuses <dbl>,
## # jours_laitiers <dbl>, jours_viande <dbl>, jours_legumes_vitA <dbl>,
## # jours_autres_legumes <dbl>, jours_oeufs <dbl>, jours_sucre_huile <dbl>,
## # nb_groupes_hdds <dbl>, milieu_def <chr>, revenu_par_tete <dbl>,
## # revenu_par_tete_jour_mru <dbl>, revenu_par_tete_jour_usd_ppp <dbl>,
## # menage_pauvre <dbl>tab_milieu_def <- df_odd1 %>%
group_by(milieu_def) %>%
summarise(
menages_total = n(),
menages_pauvres = sum(menage_pauvre),
taux_pauvrete = menages_pauvres / menages_total,
taux_pauvrete_pct = paste0(round(100 * taux_pauvrete, 2), "%"),
.groups = "drop"
) %>%
arrange(desc(taux_pauvrete))
tab_milieu_def## # A tibble: 2 × 5
## milieu_def menages_total menages_pauvres taux_pauvrete taux_pauvrete_pct
## <chr> <int> <dbl> <dbl> <chr>
## 1 Rural (Autres r… 143 128 0.895 89.51%
## 2 Urbain (Nouakch… 62 0 0 0%tab_milieu_def_pop <- df_odd1 %>%
group_by(milieu_def) %>%
summarise(
pop_total = sum(taille_menage),
pop_pauvre = sum(menage_pauvre * taille_menage),
taux_pauvrete_population = pop_pauvre / pop_total,
taux_pauvrete_population_pct = paste0(round(100 * taux_pauvrete_population, 2), "%"),
.groups = "drop"
) %>%
arrange(desc(taux_pauvrete_population))
tab_milieu_def_pop## # A tibble: 2 × 5
## milieu_def pop_total pop_pauvre taux_pauvrete_popula…¹ taux_pauvrete_popula…²
## <chr> <dbl> <dbl> <dbl> <chr>
## 1 Rural (Aut… 1160 1085 0.935 93.53%
## 2 Urbain (No… 261 0 0 0%
## # ℹ abbreviated names: ¹taux_pauvrete_population, ²taux_pauvrete_population_pcttab_region <- df_odd1 %>%
group_by(region) %>%
summarise(
menages_total = n(),
menages_pauvres = sum(menage_pauvre),
taux_pauvrete = menages_pauvres / menages_total,
taux_pauvrete_pct = paste0(round(100 * taux_pauvrete, 2), "%"),
.groups = "drop"
) %>%
arrange(desc(taux_pauvrete))
tab_region## # A tibble: 7 × 5
## region menages_total menages_pauvres taux_pauvrete taux_pauvrete_pct
## <chr> <int> <dbl> <dbl> <chr>
## 1 Assaba 30 30 1 100%
## 2 Hodh Charghi 21 21 1 100%
## 3 Hodh Gharbi 21 21 1 100%
## 4 Inchiri 20 20 1 100%
## 5 Tagant 21 21 1 100%
## 6 Trarza 30 15 0.5 50%
## 7 Nouakchott 62 0 0 0%ordre_regions <- tab_region %>% arrange(desc(taux_pauvrete)) %>% pull(region)
tab_region_plot <- df_odd1 %>%
group_by(region, milieu_def) %>%
summarise(
taux_pauvrete = mean(menage_pauvre),
.groups = "drop"
) %>%
mutate(region = factor(region, levels = ordre_regions))
ggplot(tab_region_plot, aes(x = region, y = taux_pauvrete, fill = milieu_def)) +
geom_col() +
scale_y_continuous(labels = function(x) paste0(round(100*x, 0), "%")) +
labs(
title = "Disparités géographiques de la pauvreté (ODD 1)",
subtitle = "Taux de pauvreté par région (Urbain = Nouakchott uniquement)",
x = "Région",
y = "Taux de pauvreté",
fill = "Milieu (définition)"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Méthode du cours : FCS = somme(jours_i * poids_i)
# Poids standardisés (PAM) : céréales=2, légumineuses=3, laitiers=4, viande/poisson=4,
# VitA=1, autres légumes=1, oeufs=1, sucre/huile=0.5
calc_fcs <- function(j_cereales, j_legumineuses, j_laitiers, j_viande,
j_vitA, j_autres_legumes, j_oeufs, j_sucre_huile) {
(j_cereales * 2) +
(j_legumineuses * 3) +
(j_laitiers * 4) +
(j_viande * 4) +
(j_vitA * 1) +
(j_autres_legumes * 1) +
(j_oeufs * 1) +
(j_sucre_huile * 0.5)
}# 2) Ajouter FCS + classer FCS
# -----------------------------
df_fcs <- df %>%
mutate(
fcs = calc_fcs(
jours_cereales,
jours_legumineuses,
jours_laitiers,
jours_viande,
jours_legumes_vitA,
jours_autres_legumes,
jours_oeufs,
jours_sucre_huile
),
categorie_fcs = case_when(
fcs <= 21 ~ "Pauvre",
fcs <= 35 ~ "Limite",
TRUE ~ "Acceptable"
)
)
head(df_fcs %>% select(fcs, categorie_fcs), 10)## # A tibble: 10 × 2
## fcs categorie_fcs
## <dbl> <chr>
## 1 73 Acceptable
## 2 33 Limite
## 3 49.5 Acceptable
## 4 91.5 Acceptable
## 5 17.5 Pauvre
## 6 54.5 Acceptable
## 7 68 Acceptable
## 8 33 Limite
## 9 54.5 Acceptable
## 10 82.5 Acceptable# Tableau clair : effectifs + proportions
tab_fcs <- df_fcs %>%
group_by(categorie_fcs) %>%
summarise(n = n(), .groups = "drop") %>%
mutate(
proportion = n / sum(n),
proportion_pct = paste0(round(100 * proportion, 2), "%")
) %>%
arrange(desc(proportion))
tab_fcs## # A tibble: 3 × 4
## categorie_fcs n proportion proportion_pct
## <chr> <int> <dbl> <chr>
## 1 Acceptable 161 0.785 78.54%
## 2 Limite 22 0.107 10.73%
## 3 Pauvre 22 0.107 10.73%# Indicateur 2.1.1 : % ménages avec un FCS acceptable
pct_acceptable <- df_fcs %>%
summarise(
pct_fcs_acceptable = mean(categorie_fcs == "Acceptable") * 100
)
pct_acceptable## # A tibble: 1 × 1
## pct_fcs_acceptable
## <dbl>
## 1 78.5objectif_2030 <- 80
decision <- df_fcs %>%
summarise(
pct_fcs_acceptable = mean(categorie_fcs == "Acceptable") * 100,
objectif_2030 = objectif_2030,
atteint = ifelse(pct_fcs_acceptable >= objectif_2030, "Oui", "Non")
)
decision## # A tibble: 1 × 3
## pct_fcs_acceptable objectif_2030 atteint
## <dbl> <dbl> <chr>
## 1 78.5 80 Nonggplot(df_fcs, aes(x = categorie_fcs)) +
geom_bar() +
labs(
title = "ODD 2 — Répartition des ménages selon le FCS",
x = "Catégorie FCS",
y = "Nombre de ménages"
) +
theme_minimal()
df_hdds <- df %>%
mutate(
hdds = nb_groupes_hdds,
classe_hdds = case_when(
hdds <= 3 ~ "Faible (0-3)",
hdds <= 5 ~ "Modéré (4-5)",
TRUE ~ "Élevé (6+)"
)
)
tab_hdds <- df_hdds %>%
group_by(classe_hdds) %>%
summarise(n = n(), .groups = "drop") %>%
mutate(proportion = n / sum(n))
tab_hdds## # A tibble: 3 × 3
## classe_hdds n proportion
## <chr> <int> <dbl>
## 1 Faible (0-3) 44 0.215
## 2 Modéré (4-5) 52 0.254
## 3 Élevé (6+) 109 0.532ggplot(df_hdds, aes(x = hdds)) +
geom_histogram(binwidth = 1) +
labs(title = "Distribution de l'HDDS (nb_groupes_hdds)",
x = "HDDS (nombre de groupes)", y = "Effectif") +
theme_minimal()
ggplot(tab_hdds, aes(x = classe_hdds, y = proportion)) +
geom_col() +
scale_y_continuous(labels = function(x) paste0(round(100*x, 0), "%")) +
labs(title = "Répartition des ménages par niveau de diversité alimentaire (HDDS)",
x = "Classe HDDS", y = "Proportion") +
theme_minimal()
df_all <- df %>%
mutate(
milieu_def = ifelse(region == "Nouakchott",
"Urbain (Nouakchott)",
"Rural (Autres régions)"),
# ODD1 : pauvreté
revenu_par_tete = revenu_mensuel / taille_menage,
revenu_par_tete_jour_mru = revenu_par_tete / 30,
revenu_par_tete_jour_usd_ppp = revenu_par_tete_jour_mru / ppa_mru_par_usd,
menage_pauvre = ifelse(revenu_par_tete_jour_usd_ppp < seuil_usd_ppp, 1, 0),
# ODD2 : FCS
fcs = calc_fcs(
jours_cereales,
jours_legumineuses,
jours_laitiers,
jours_viande,
jours_legumes_vitA,
jours_autres_legumes,
jours_oeufs,
jours_sucre_huile
)
)
head(df_all %>% select(region, milieu_def, menage_pauvre, fcs), 10)## # A tibble: 10 × 4
## region milieu_def menage_pauvre fcs
## <chr> <chr> <dbl> <dbl>
## 1 Nouakchott Urbain (Nouakchott) 0 73
## 2 Hodh Charghi Rural (Autres régions) 1 33
## 3 Trarza Rural (Autres régions) 1 49.5
## 4 Nouakchott Urbain (Nouakchott) 0 91.5
## 5 Hodh Gharbi Rural (Autres régions) 1 17.5
## 6 Assaba Rural (Autres régions) 1 54.5
## 7 Nouakchott Urbain (Nouakchott) 0 68
## 8 Tagant Rural (Autres régions) 1 33
## 9 Inchiri Rural (Autres régions) 1 54.5
## 10 Nouakchott Urbain (Nouakchott) 0 82.5# Corrélation globale (pauvre = 0/1) et FCS
cor_global <- cor(df_all$menage_pauvre, df_all$fcs)
cor_global## [1] -0.8674232# Corrélation par milieu
cor_par_milieu <- df_all %>%
group_by(milieu_def) %>%
summarise(correlation = cor(menage_pauvre, fcs), n = n(), .groups = "drop")## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `correlation = cor(menage_pauvre, fcs)`.
## ℹ In group 2: `milieu_def = "Urbain (Nouakchott)"`.
## Caused by warning in `cor()`:
## ! l'écart type est nulcor_par_milieu## # A tibble: 2 × 3
## milieu_def correlation n
## <chr> <dbl> <int>
## 1 Rural (Autres régions) -0.573 143
## 2 Urbain (Nouakchott) NA 62# Boxplot du FCS selon pauvreté et milieu
ggplot(df_all, aes(x = as.factor(menage_pauvre), y = fcs, fill = milieu_def)) +
geom_boxplot(position = "dodge") +
labs(
title = "Relation entre pauvreté monétaire (ODD1) et sécurité alimentaire (FCS)",
subtitle = "Comparaison Urbain (Nouakchott) vs Rural (autres régions)",
x = "Ménage pauvre (0=Non, 1=Oui)",
y = "FCS",
fill = "Milieu"
) +
theme_minimal()
tab_fcs_pauvre_milieu <- df_all %>%
group_by(milieu_def, menage_pauvre) %>%
summarise(
n = n(),
fcs_moy = mean(fcs),
fcs_med = median(fcs),
fcs_min = min(fcs),
fcs_max = max(fcs),
.groups = "drop"
) %>%
arrange(milieu_def, menage_pauvre)
tab_fcs_pauvre_milieu## # A tibble: 3 × 7
## milieu_def menage_pauvre n fcs_moy fcs_med fcs_min fcs_max
## <chr> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Rural (Autres régions) 0 15 68 68 68 68
## 2 Rural (Autres régions) 1 128 40.0 37 17.5 54.5
## 3 Urbain (Nouakchott) 0 62 84.7 82.5 68 91.5# Séparer FCS par milieu
fcs_urbain <- df_all %>% filter(milieu_def == "Urbain (Nouakchott)") %>% pull(fcs)
fcs_rural <- df_all %>% filter(milieu_def == "Rural (Autres régions)") %>% pull(fcs)
# t-test (indicatif)
t.test(fcs_urbain, fcs_rural)##
## Welch Two Sample t-test
##
## data: fcs_urbain and fcs_rural
## t = 28.319, df = 202.32, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 38.84038 44.65375
## sample estimates:
## mean of x mean of y
## 84.70161 42.95455# Wilcoxon (robuste)
wilcox.test(fcs_urbain, fcs_rural)##
## Wilcoxon rank sum test with continuity correction
##
## data: fcs_urbain and fcs_rural
## W = 8858.5, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0fcs_pauvres <- df_all %>% filter(menage_pauvre == 1) %>% pull(fcs)
fcs_nonpauves <- df_all %>% filter(menage_pauvre == 0) %>% pull(fcs)
t.test(fcs_pauvres, fcs_nonpauves)##
## Welch Two Sample t-test
##
## data: fcs_pauvres and fcs_nonpauves
## t = -27.408, df = 201.19, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -44.40908 -38.44796
## sample estimates:
## mean of x mean of y
## 40.01953 81.44805wilcox.test(fcs_pauvres, fcs_nonpauves)##
## Wilcoxon rank sum test with continuity correction
##
## data: fcs_pauvres and fcs_nonpauves
## W = 0, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0taux_pauvrete_population <- function(data) {
sum(data$menage_pauvre * data$taille_menage) / sum(data$taille_menage)
}ui <- fluidPage(
titlePanel("ODD 17 — Dashboard : Pauvreté (ODD 1) & Sécurité alimentaire (ODD 2)"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "grp",
label = "Choisir le sous-groupe :",
choices = c(
"Global" = "global",
"Milieu (Nouakchott vs reste)" = "milieu_def",
"Région" = "region",
"Sexe du chef" = "sexe_chef"
)
),
hr(),
h4("Indicateurs clés"),
verbatimTextOutput("kpi")
),
mainPanel(
tabsetPanel(
tabPanel("Pauvreté",
tableOutput("tab_pov"),
plotOutput("plot_pov")),
tabPanel("FCS",
tableOutput("tab_fcs"),
plotOutput("plot_fcs")),
tabPanel("Relation pauvreté – FCS",
tableOutput("tab_rel"),
plotOutput("plot_rel"))
)
)
)
)library(dplyr)
library(ggplot2)
library(shiny)
# Paramètres ODD1 (seuil international)
seuil_usd_ppp <- 2.15
ppa_mru_par_usd <- 600
# Fonction FCS (poids WFP/PAM)
calc_fcs <- function(j_cereales, j_legumineuses, j_laitiers, j_viande,
j_vitA, j_autres_legumes, j_oeufs, j_sucre_huile) {
(j_cereales * 2) +
(j_legumineuses * 3) +
(j_laitiers * 4) +
(j_viande * 4) +
(j_vitA * 1) +
(j_autres_legumes * 1) +
(j_oeufs * 1) +
(j_sucre_huile * 0.5)
}
# Table intégrée : pauvreté + FCS + sous-groupes
df_all <- df %>%
mutate(
# Ta règle : Urbain = Nouakchott uniquement
milieu_def = ifelse(region == "Nouakchott", "Urbain (Nouakchott)", "Rural (Autres régions)"),
# Pauvreté monétaire (ODD1)
revenu_par_tete = revenu_mensuel / taille_menage,
revenu_par_tete_jour_usd_ppp = (revenu_par_tete / 30) / ppa_mru_par_usd,
menage_pauvre = ifelse(revenu_par_tete_jour_usd_ppp < seuil_usd_ppp, 1, 0),
# Sécurité alimentaire (ODD2)
fcs = calc_fcs(
jours_cereales,
jours_legumineuses,
jours_laitiers,
jours_viande,
jours_legumes_vitA,
jours_autres_legumes,
jours_oeufs,
jours_sucre_huile
),
categorie_fcs = case_when(
fcs <= 21 ~ "Pauvre",
fcs <= 35 ~ "Limite",
TRUE ~ "Acceptable"
),
# Variables catégorielles utiles
sexe_chef = as.factor(sexe_chef)
)
# Indicateur pauvreté "population" : pop pauvre / pop totale
taux_pauvrete_population <- function(data) {
sum(data$menage_pauvre * data$taille_menage) / sum(data$taille_menage)
}library(dplyr)
library(ggplot2)
library(shiny)
ui <- fluidPage(
titlePanel("ODD 17 — Dashboard : Pauvreté (ODD1) & Sécurité alimentaire (ODD2)"),
sidebarLayout(
sidebarPanel(
selectInput(
"grp", "Sous-groupe :",
choices = c(
"Global" = "global",
"Milieu (Nouakchott vs reste)" = "milieu_def",
"Région" = "region",
"Sexe du chef" = "sexe_chef"
)
),
hr(),
h4("Indicateurs clés"),
verbatimTextOutput("kpi")
),
mainPanel(
tabsetPanel(
tabPanel("Pauvreté",
tableOutput("tab_pov"),
plotOutput("plot_pov")),
tabPanel("FCS",
tableOutput("tab_fcs"),
plotOutput("plot_fcs")),
tabPanel("Relation pauvreté–FCS",
tableOutput("tab_rel"),
plotOutput("plot_rel"))
)
)
)
)
server <- function(input, output, session) {
output$kpi <- renderText({
tp <- taux_pauvrete_population(df_all)
pct_acc <- mean(df_all$categorie_fcs == "Acceptable") * 100
paste0(
"Taux de pauvreté (population) = ", round(100 * tp, 2), "%\n",
"% FCS acceptable = ", round(pct_acc, 2), "%\n",
"N ménages = ", nrow(df_all), " | Population = ", sum(df_all$taille_menage)
)
})
# ---- Pauvreté : tableau
output$tab_pov <- renderTable({
if (input$grp == "global") {
data.frame(
pop_total = sum(df_all$taille_menage),
pop_pauvre = sum(df_all$menage_pauvre * df_all$taille_menage),
taux_pauvrete_population = round(taux_pauvrete_population(df_all), 4)
)
} else {
df_all %>%
group_by(.data[[input$grp]]) %>%
summarise(
pop_total = sum(taille_menage),
pop_pauvre = sum(menage_pauvre * taille_menage),
taux = pop_pauvre / pop_total,
.groups = "drop"
) %>%
arrange(desc(taux))
}
})
# ---- Pauvreté : graphique
output$plot_pov <- renderPlot({
if (input$grp == "global") {
tmp <- data.frame(
statut = c("Non pauvre", "Pauvre"),
population = c(
sum((1 - df_all$menage_pauvre) * df_all$taille_menage),
sum(df_all$menage_pauvre * df_all$taille_menage)
)
)
ggplot(tmp, aes(x = statut, y = population)) +
geom_col() +
labs(title = "Population pauvre vs non pauvre (global)", x = "", y = "Population") +
theme_minimal()
} else {
tmp <- df_all %>%
group_by(.data[[input$grp]]) %>%
summarise(taux = taux_pauvrete_population(cur_data()), .groups = "drop")
ggplot(tmp, aes(x = .data[[input$grp]], y = taux)) +
geom_col() +
scale_y_continuous(labels = function(x) paste0(round(100 * x, 0), "%")) +
labs(title = "Taux de pauvreté (population) par sous-groupe", x = "", y = "Taux") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
}
})
# ---- FCS : tableau
output$tab_fcs <- renderTable({
df_all %>%
count(categorie_fcs) %>%
mutate(pct = round(100 * n / sum(n), 2)) %>%
arrange(desc(n))
})
# ---- FCS : graphique
output$plot_fcs <- renderPlot({
tmp <- df_all %>%
count(categorie_fcs) %>%
mutate(pct = n / sum(n))
ggplot(tmp, aes(x = categorie_fcs, y = pct)) +
geom_col() +
scale_y_continuous(labels = function(x) paste0(round(100 * x, 0), "%")) +
labs(title = "Distribution des catégories FCS", x = "Catégorie", y = "Proportion") +
theme_minimal()
})
# ---- Relation pauvreté–FCS : tableau
output$tab_rel <- renderTable({
df_all %>%
group_by(milieu_def, menage_pauvre) %>%
summarise(
n = n(),
fcs_moy = round(mean(fcs), 2),
fcs_med = round(median(fcs), 2),
.groups = "drop"
) %>%
arrange(milieu_def, menage_pauvre)
})
# ---- Relation pauvreté–FCS : graphique
output$plot_rel <- renderPlot({
ggplot(df_all, aes(x = as.factor(menage_pauvre), y = fcs, fill = milieu_def)) +
geom_boxplot(position = "dodge") +
labs(
title = "FCS selon la pauvreté (0/1) et le milieu",
x = "Ménage pauvre (0=Non, 1=Oui)",
y = "FCS",
fill = "Milieu"
) +
theme_minimal()
})
}
shinyApp(ui, server)Shiny applications not supported in static R Markdown documents
library(dplyr)
# Modèle : expliquer FCS par facteurs socio-économiques
modele_fcs <- lm(
fcs ~ revenu_par_tete + taille_menage + milieu_def + age_chef + sexe_chef,
data = df_all
)
summary(modele_fcs)##
## Call:
## lm(formula = fcs ~ revenu_par_tete + taille_menage + milieu_def +
## age_chef + sexe_chef, data = df_all)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.9241 -5.2857 -0.9032 5.7569 22.0934
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.125e+01 9.835e+00 9.279 < 2e-16 ***
## revenu_par_tete -1.776e-06 4.847e-05 -0.037 0.970805
## taille_menage -5.301e+00 1.352e+00 -3.921 0.000121 ***
## milieu_defUrbain (Nouakchott) 1.862e+01 4.249e+00 4.381 1.91e-05 ***
## age_chef -1.894e-01 3.796e-01 -0.499 0.618410
## sexe_chefHomme 4.984e+00 1.685e+00 2.958 0.003473 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.61 on 199 degrees of freedom
## Multiple R-squared: 0.8949, Adjusted R-squared: 0.8923
## F-statistic: 338.9 on 5 and 199 DF, p-value: < 2.2e-16# Qualité du modèle : R², R² ajusté, RMSE
rmse <- sqrt(mean(residuals(modele_fcs)^2))
data.frame(
R2 = summary(modele_fcs)$r.squared,
R2_adj = summary(modele_fcs)$adj.r.squared,
RMSE = rmse
)## R2 R2_adj RMSE
## 1 0.8949027 0.8922621 7.498262