knitr::opts_chunk$set(
echo = TRUE,
fig.width = 8,
fig.height = 5,
fig.retina = 2,
out.width = '100%',
dpi = 96,
fig.align = 'center',
dev = 'png',
warning = FALSE,
message = FALSE
)
if (requireNamespace('ggplot2', quietly = TRUE)) {
ggplot2::theme_set(ggplot2::theme_minimal(base_size = 14))
}
options(scipen = 999)
par(cex = 1.1)
Chemin d’accès et importation des données
# Astuce : pour plus de portabilité, vous pouvez remplacer setwd() par le package {here}.
setwd("C:\\Users\\Guerschom\\Desktop\\GITHUB\\MES POSTS\\INFIDELITE")
library(haven)
MEN2007 <- read_dta("MEN2007.DTA")
MEN2013 <- read_dta("MEN2013.DTA")
MEN2023 <- read_dta("MEN2023.DTA")
WOMEN2007 <- read_dta("WOMEN2007.DTA")
WOMEN2013 <- read_dta("WOMEN2013.DTA")
WOMEN2023 <- read_dta("WOMEN2023.DTA")
Sélection des variables pertinentes
MEN2007 <- dplyr::select(MEN2007, mcaseid, mv001, mv005, mv008, mv024, mv130, mv501, mv509, mv766a, mv766b, mv767a, mv767b, mv836)
MEN2013 <- dplyr::select(MEN2013, mcaseid, mv001, mv005, mv008, mv024, mv130, mv501, mv509, mv766a, mv766b, mv767a, mv767b, mv836)
MEN2023 <- dplyr::select(MEN2023, mcaseid, mv001, mv005, mv008, mv024, mv130, mv501, mv509, mv766a, mv766b, mv767a, mv767b, mv836)
WOMEN2007 <- dplyr::select(WOMEN2007, caseid, v001, v005, v008, v024, v130, v501, v509, v766a, v766b, v767a, v767b, v836)
WOMEN2013 <- dplyr::select(WOMEN2013, caseid, v001, v005, v008, v024, v130, v501, v509, v766a, v766b, v767a, v767b, v836)
WOMEN2023 <- dplyr::select(WOMEN2023, caseid, v001, v005, v008, v024, v130, v501, v509, v766a, v766b, v767a, v767b, v836)
Exclure les mariages < 12 mois
library(dplyr)
MEN2007 <- MEN2007 %>% filter(!is.na(mv509) & (mv008 - mv509) >= 12)
MEN2013 <- MEN2013 %>% filter(!is.na(mv509) & (mv008 - mv509) >= 12)
MEN2023 <- MEN2023 %>% filter(!is.na(mv509) & (mv008 - mv509) >= 12)
WOMEN2007 <- WOMEN2007 %>% filter(!is.na(v509) & (v008 - v509) >= 12)
WOMEN2013 <- WOMEN2013 %>% filter(!is.na(v509) & (v008 - v509) >= 12)
WOMEN2023 <- WOMEN2023 %>% filter(!is.na(v509) & (v008 - v509) >= 12)
Recodage Religion — Hommes
library(forcats)
MEN2007$Religion <- MEN2007$mv130 |>
as.character() |>
fct_recode(
"Catholique" = "1", "Protestante" = "2", "Autre" = "3", "Autre" = "4",
"Autre" = "5", "Musulmane" = "6", "Autre" = "7", "Autre" = "8", "Autre" = "96"
) |>
fct_na_value_to_level("Autre")
MEN2013$Religion <- MEN2013$mv130 |>
as.character() |>
fct_recode(
"Catholique" = "11", "Protestante" = "12", "Autre" = "13", "Autre" = "14",
"Autre" = "15", "Musulmane" = "16", "Autre" = "17", "Autre" = "18",
"Autre" = "19","Autre" = "20","Autre" = "96"
) |>
fct_na_value_to_level("Autre")
MEN2023$Religion <- MEN2023$mv130 |>
as.character() |>
fct_recode(
"Catholique" = "1", "Protestante" = "2", "Autre" = "3", "Autre" = "4",
"Musulmane" = "5", "Autre" = "6", "Autre" = "7", "Autre" = "8",
"Autre" = "9", "Autre" = "96"
)
Recodage Religion — Femmes
WOMEN2007$Religion <- WOMEN2007$v130 |>
as.character() |>
fct_recode(
"Catholique" = "1", "Protestante" = "2", "Autre" = "3", "Autre" = "4",
"Autre" = "5", "Musulmane" = "6", "Autre" = "7", "Autre" = "8", "Autre" = "96"
) |>
fct_na_value_to_level("Autre")
WOMEN2013$Religion <- WOMEN2013$v130 |>
as.character() |>
fct_recode(
"Catholique" = "11", "Protestante" = "12", "Autre" = "13", "Autre" = "14",
"Autre" = "15", "Musulmane" = "16", "Autre" = "17", "Autre" = "18",
"Autre" = "19","Autre" = "20","Autre" = "96"
) |>
fct_na_value_to_level("Autre")
WOMEN2023$Religion <- WOMEN2023$v130 |>
as.character() |>
fct_recode(
"Catholique" = "1", "Protestante" = "2", "Autre" = "3", "Autre" = "4",
"Musulmane" = "5", "Autre" = "6", "Autre" = "7", "Autre" = "8",
"Autre" = "9", "Autre" = "96"
)
Recodage Région — Hommes
library(questionr); library(forcats)
MEN2007$Region <- as.character(MEN2007$mv024) |>
fct_recode(
"Kinshasa" = "10","Bas-Congo" = "20","Bandundu" = "30","Equateur" = "40","Province Or." = "50",
"Nord-Kivu" = "61","Maniema" = "62","Sud-Kivu" = "63","Katanga" = "70","Kasai Or." = "80","Kasai Oc." = "90"
) |>
fct_relevel("Kinshasa","Bas-Congo","Bandundu","Equateur","Province Or.","Nord-Kivu","Maniema","Sud-Kivu","Katanga","Kasai Or.","Kasai Oc.")
MEN2013$Region <- MEN2013$mv024 |> as.character() |>
fct_recode("Kinshasa" = "1","Bandundu" = "2","Bas-Congo" = "3","Equateur" = "4",
"Kasai Oc." = "5","Kasai Or." = "6","Katanga" = "7","Maniema" = "8",
"Nord-Kivu" = "9","Province Or." = "10","Sud-Kivu" = "11") |>
fct_relevel("Kinshasa","Province Or.","Sud-Kivu","Bandundu","Bas-Congo","Equateur","Kasai Oc.","Kasai Or.","Katanga","Maniema","Nord-Kivu")
MEN2023$Region <- MEN2023$mv024 |> as.character() |>
fct_recode(
"Kinshasa" = "1","Bas-Congo" = "2","Bandundu" = "3","Bandundu" = "4","Bandundu" = "5",
"Equateur" = "6","Equateur" = "7","Equateur" = "8","Equateur" = "9","Equateur" = "10",
"Kasai Oc." = "25","Kasai Oc." = "26","Kasai Or." = "22","Kasai Or." = "23","Kasai Or." = "24",
"Katanga" = "18","Katanga" = "19","Katanga" = "20","Katanga" = "21",
"Maniema" = "17","Nord-Kivu" = "15","Province Or." = "11","Province Or." = "12","Province Or." = "13","Province Or." = "14","Sud-Kivu" = "16"
) |>
fct_relevel("Kinshasa","Province Or.","Sud-Kivu","Bandundu","Bas-Congo","Equateur","Kasai Oc.","Kasai Or.","Katanga","Maniema","Nord-Kivu")
Recodage Région — Femmes
WOMEN2007$Region <- WOMEN2007$v024 |> as.character() |>
fct_recode(
"Kinshasa" = "10","Bas-Congo" = "20","Bandundu" = "30","Equateur" = "40","Province Or." = "50",
"Nord-Kivu" = "61","Maniema" = "62","Sud-Kivu" = "63","Katanga" = "70","Kasai Or." = "80","Kasai Oc." = "90"
) |>
fct_relevel("Kinshasa","Bas-Congo","Bandundu","Equateur","Province Or.","Nord-Kivu","Maniema","Sud-Kivu","Katanga","Kasai Or.","Kasai Oc.")
WOMEN2013$Region <- WOMEN2013$v024 |> as.character() |>
fct_recode("Kinshasa" = "1","Bandundu" = "2","Bas-Congo" = "3","Equateur" = "4",
"Kasai Oc." = "5","Kasai Or." = "6","Katanga" = "7","Maniema" = "8",
"Nord-Kivu" = "9","Province Or." = "10","Sud-Kivu" = "11") |>
fct_relevel("Kinshasa","Province Or.","Sud-Kivu","Bandundu","Bas-Congo","Equateur","Kasai Oc.","Kasai Or.","Katanga","Maniema","Nord-Kivu")
WOMEN2023$Region <- WOMEN2023$v024 |> as.character() |>
fct_recode(
"Kinshasa" = "1","Bas-Congo" = "2","Bandundu" = "3","Bandundu" = "4","Bandundu" = "5",
"Equateur" = "6","Equateur" = "7","Equateur" = "8","Equateur" = "9","Equateur" = "10",
"Kasai Oc." = "25","Kasai Oc." = "26","Kasai Or." = "22","Kasai Or." = "23","Kasai Or." = "24",
"Katanga" = "18","Katanga" = "19","Katanga" = "20","Katanga" = "21",
"Maniema" = "17","Nord-Kivu" = "15","Province Or." = "11","Province Or." = "12","Province Or." = "13","Province Or." = "14","Sud-Kivu" = "16"
) |>
fct_relevel("Kinshasa","Province Or.","Sud-Kivu","Bandundu","Bas-Congo","Equateur","Kasai Oc.","Kasai Or.","Katanga","Maniema","Nord-Kivu")
Statut matrimonial
MEN2007$Statut_matrimonial <- ifelse(MEN2007$mv501 == 0, "Célibataire",
ifelse(MEN2007$mv501 %in% c(3,4), "Veuves ou divorcées",
ifelse(MEN2007$mv501 %in% c(1,2), "Marié", "Autre")))
MEN2013$Statut_matrimonial <- ifelse(MEN2013$mv501 == 0, "Célibataire",
ifelse(MEN2013$mv501 %in% c(3,4), "Veuves ou divorcées",
ifelse(MEN2013$mv501 %in% c(1,2), "Marié", "Autre")))
MEN2023$Statut_matrimonial <- ifelse(MEN2023$mv501 == 0, "Célibataire",
ifelse(MEN2023$mv501 %in% c(3,4), "Veuves ou divorcées",
ifelse(MEN2023$mv501 %in% c(1,2), "Marié", "Autre")))
WOMEN2007$Statut_matrimonial <- ifelse(WOMEN2007$v501 == 0, "Célibataire",
ifelse(WOMEN2007$v501 %in% c(3,4), "Veuves ou divorcées",
ifelse(WOMEN2007$v501 %in% c(1,2), "Marié", "Autre")))
WOMEN2013$Statut_matrimonial <- ifelse(WOMEN2013$v501 == 0, "Célibataire",
ifelse(WOMEN2013$v501 %in% c(3,4), "Veuves ou divorcées",
ifelse(WOMEN2013$v501 %in% c(1,2), "Marié", "Autre")))
WOMEN2023$Statut_matrimonial <- ifelse(WOMEN2023$v501 == 0, "Célibataire",
ifelse(WOMEN2023$v501 %in% c(3,4), "Veuves ou divorcées",
ifelse(WOMEN2023$v501 %in% c(1,2), "Marié", "Autre")))
Nettoyage des valeurs aberrantes
clean_men <- function(df) {
for (var in c("mv766a", "mv766b", "mv767a", "mv767b")) {
df[[var]][ df[[var]] > 40 ] <- NA
}
df$mv836[ df$mv836 > 64 ] <- NA
df
}
clean_women <- function(df) {
for (var in c("v766a", "v766b", "v767a", "v767b")) {
df[[var]][ df[[var]] > 40 ] <- NA
}
df$v836[ df$v836 > 64 ] <- NA
df
}
MEN2007 <- clean_men(MEN2007)
MEN2013 <- clean_men(MEN2013)
MEN2023 <- clean_men(MEN2023)
WOMEN2007 <- clean_women(WOMEN2007)
WOMEN2013 <- clean_women(WOMEN2013)
WOMEN2023 <- clean_women(WOMEN2023)
Ne sélectionner que les marié·e·s + variable Année
MAR_MEN2007 <- subset(MEN2007, Statut_matrimonial == "Marié")
MAR_MEN2013 <- subset(MEN2013, Statut_matrimonial == "Marié")
MAR_MEN2023 <- subset(MEN2023, Statut_matrimonial == "Marié")
MAR_WOMEN2007 <- subset(WOMEN2007, Statut_matrimonial == "Marié")
MAR_WOMEN2013 <- subset(WOMEN2013, Statut_matrimonial == "Marié")
MAR_WOMEN2023 <- subset(WOMEN2023, Statut_matrimonial == "Marié")
# IMPORTANT : Année en texte (évite 2013/2014 qui deviendrait une division)
MAR_MEN2007$Année <- "2007"
MAR_MEN2013$Année <- "2013/2014"
MAR_MEN2023$Année <- "2023/2024"
MAR_WOMEN2007$Année <- "2007"
MAR_WOMEN2013$Année <- "2013/2014"
MAR_WOMEN2023$Année <- "2023/2024"
Dataframes unifiés + sauvegardes
library(labelled)
MAR_MEN <- dplyr::bind_rows(MAR_MEN2007, MAR_MEN2013, MAR_MEN2023) %>%
dplyr::mutate(across(where(haven::is.labelled),
~ labelled::to_factor(.x, levels = "labels", nolabel_to_na = FALSE)))
MAR_WOMEN <- dplyr::bind_rows(MAR_WOMEN2007, MAR_WOMEN2013, MAR_WOMEN2023) %>%
dplyr::mutate(across(where(haven::is.labelled),
~ labelled::to_factor(.x, levels = "labels", nolabel_to_na = FALSE)))
# Export optionnel
# library(openxlsx)
# openxlsx::write.xlsx(MAR_MEN, "MAR_MEN.xlsx")
# openxlsx::write.xlsx(MAR_WOMEN, "MAR_WOMEN.xlsx")
# save.image()
Création de la variable “Fidélité”
MAR_WOMEN$Fidélité <- ifelse(MAR_WOMEN$v766a == 0, "Fidèle", "Infidèle")
MAR_MEN$Fidélité <- ifelse(MAR_MEN$mv766a == 0, "Fidèle", "Infidèle")
Analyses & Graphiques (affichés dans le HTML)
library(survey)
library(ggplot2)
library(magick) # pour créer un GIF en plus du PNG (optionnel)
options(survey.lonely.psu = "adjust")
MAR_WOMEN <- as.data.frame(MAR_WOMEN, stringsAsFactors = FALSE)
MAR_MEN <- as.data.frame(MAR_MEN, stringsAsFactors = FALSE)
# Fonction d'estimation de proportions pondérées + IC95
prop_ic95 <- function(df, status_var = "Fidélité", level = "Infidèle",
weight_var = "Poids", group_vars = c("Année","Region")) {
keep_cols <- c(status_var, weight_var, group_vars)
df2 <- df[complete.cases(df[, keep_cols, drop = FALSE]), keep_cols]
y <- as.numeric(df2[[status_var]] == level)
w <- as.numeric(df2[[weight_var]])
ok <- is.finite(w) & w > 0 & !is.na(y)
df2 <- df2[ok, , drop = FALSE]; y <- y[ok]; w <- w[ok]
for (gv in group_vars) {
df2[[gv]] <- factor(as.character(df2[[gv]]), exclude = NULL)
df2[[gv]] <- droplevels(df2[[gv]])
}
des_all <- svydesign(ids = ~1, weights = ~w, data = data.frame(df2, y = y))
combos <- unique(df2[, group_vars, drop = FALSE]); rownames(combos) <- NULL
res_list <- vector("list", nrow(combos))
for (i in seq_len(nrow(combos))) {
mask <- rep(TRUE, nrow(df2))
for (gv in group_vars) mask <- mask & (as.character(df2[[gv]]) == as.character(combos[i, gv]))
des_i <- subset(des_all, mask)
if (sum(weights(des_i)) <= 0) next
est <- try(svymean(~y, design = des_i, na.rm = TRUE), silent = TRUE)
if (inherits(est, "try-error") || any(is.na(coef(est)))) next
prop <- as.numeric(coef(est)); se <- as.numeric(SE(est))
row <- as.list(combos[i, , drop = FALSE])
row$prop <- prop; row$se <- se
res_list[[i]] <- as.data.frame(row, stringsAsFactors = FALSE)
}
RES <- do.call(rbind, res_list)
if (is.null(RES) || nrow(RES) == 0) stop("Aucun groupe valide après nettoyage.")
RES$ci_l <- pmax(0, RES$prop - 1.96*RES$se)
RES$ci_u <- pmin(1, RES$prop + 1.96*RES$se)
RES$prop_pct <- 100*RES$prop; RES$ci_l_pct <- 100*RES$ci_l; RES$ci_u_pct <- 100*RES$ci_u
RES$prop_pct_r <- round(RES$prop_pct, 1)
RES$ci_l_pct_r <- round(RES$ci_l_pct, 1)
RES$ci_u_pct_r <- round(RES$ci_u_pct, 1)
RES <- RES[, c(group_vars,
"prop","se","ci_l","ci_u",
"prop_pct","ci_l_pct","ci_u_pct",
"prop_pct_r","ci_l_pct_r","ci_u_pct_r"), drop = FALSE]
rownames(RES) <- NULL
RES
}
# Ajouter "Ensemble des années"
add_overall_year <- function(df, est, status_var, weight_var, fill_var,
overall_label = "Ensemble des années",
x_var = "Année") {
overall <- prop_ic95(df, status_var = status_var,
weight_var = weight_var, group_vars = c(fill_var))
overall[[x_var]] <- overall_label
keep_order <- c(x_var, fill_var,
"prop","se","ci_l","ci_u",
"prop_pct","ci_l_pct","ci_u_pct",
"prop_pct_r","ci_l_pct_r","ci_u_pct_r")
est2 <- est[, keep_order]
overall2 <- overall[, keep_order]
out <- rbind(est2, overall2)
out <- out[!duplicated(out[, c(x_var, fill_var)]), , drop = FALSE]
year_levels <- c("2007","2013/2014","2023/2024", overall_label)
out[[x_var]] <- factor(as.character(out[[x_var]]),
levels = year_levels[year_levels %in% unique(as.character(out[[x_var]]))])
out
}
# Poids
MAR_WOMEN$Poids <- as.numeric(MAR_WOMEN$v005) / 1e6
MAR_MEN$Poids <- as.numeric(MAR_MEN$mv005) / 1e6
# ---- FEMMES : Région ----
res_w_region <- prop_ic95(MAR_WOMEN, status_var = "Fidélité",
weight_var = "Poids", group_vars = c("Année","Region"))
res_w_region <- add_overall_year(MAR_WOMEN, res_w_region,
status_var = "Fidélité", weight_var = "Poids",
fill_var = "Region")
# Fonction d'affichage (imprime le graphique dans le HTML et sauvegarde un PNG)
plot_and_save <- function(est, x_var, fill_var, title_str, y_lab, file_stub) {
pd <- position_dodge(width = 0.8)
p <- ggplot(est, aes_string(x = x_var, y = "prop_pct", fill = fill_var, group = fill_var)) +
geom_col(position = pd) +
geom_errorbar(aes(ymin = ci_l_pct, ymax = ci_u_pct),
width = 0.2, position = pd, colour = "black", linewidth = 0.6) +
labs(x = "Année", y = y_lab, title = title_str, fill = NULL) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 14),
legend.position = "bottom",
legend.margin = margin(t = 6, r = 6, b = 6, l = 6),
legend.box.margin = margin(t = 4, r = 4, b = 8, l = 4)
)
print(p) # <- AFFICHAGE dans le HTML
try(ggsave(paste0(file_stub, ".png"), plot = p, width = 10, height = 6, dpi = 300), silent = TRUE)
}
plot_and_save(
res_w_region,
x_var = "Année", fill_var = "Region",
title_str = "Évolution de la proportion des femmes infidèles selon la province",
y_lab = "Proportion (en %) des femmes infidèles",
file_stub = "women_infideles_par_region"
)
# ---- FEMMES : Religion ----
res_w_relig <- prop_ic95(MAR_WOMEN, status_var = "Fidélité",
weight_var = "Poids", group_vars = c("Année","Religion"))
res_w_relig <- add_overall_year(MAR_WOMEN, res_w_relig,
status_var = "Fidélité", weight_var = "Poids",
fill_var = "Religion")
plot_and_save(
res_w_relig,
x_var = "Année", fill_var = "Religion",
title_str = "Évolution de la proportion des femmes infidèles selon la religion",
y_lab = "Proportion (en %) des femmes infidèles",
file_stub = "women_infideles_par_religion"
)
# ---- HOMMES : Région ----
res_m_region <- prop_ic95(MAR_MEN, status_var = "Fidélité",
weight_var = "Poids", group_vars = c("Année","Region"))
res_m_region <- add_overall_year(MAR_MEN, res_m_region,
status_var = "Fidélité", weight_var = "Poids",
fill_var = "Region")
plot_and_save(
res_m_region,
x_var = "Année", fill_var = "Region",
title_str = "Évolution de la proportion des hommes infidèles selon la province",
y_lab = "Proportion (en %) des hommes infidèles",
file_stub = "men_infideles_par_region"
)
# ---- HOMMES : Religion ----
res_m_relig <- prop_ic95(MAR_MEN, status_var = "Fidélité",
weight_var = "Poids", group_vars = c("Année","Religion"))
res_m_relig <- add_overall_year(MAR_MEN, res_m_relig,
status_var = "Fidélité", weight_var = "Poids",
fill_var = "Religion")
plot_and_save(
res_m_relig,
x_var = "Année", fill_var = "Religion",
title_str = "Évolution de la proportion des hommes infidèles selon la religion",
y_lab = "Proportion (en %) des hommes infidèles",
file_stub = "men_infideles_par_religion"
)
Vérifications rapides
table(MAR_MEN$Année)
##
## 2007 2013/2014 2023/2024
## 2640 5040 7287
table(MAR_WOMEN$Année)
##
## 2007 2013/2014 2023/2024
## 6256 11991 16261
Session
sessionInfo()
## R version 4.4.2 (2024-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26100)
##
## Matrix products: default
##
##
## locale:
## [1] LC_COLLATE=English_United Kingdom.utf8
## [2] LC_CTYPE=English_United Kingdom.utf8
## [3] LC_MONETARY=English_United Kingdom.utf8
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United Kingdom.utf8
##
## time zone: Europe/Paris
## tzcode source: internal
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] magick_2.9.0 ggplot2_3.5.2 survey_4.4-8 survival_3.7-0
## [5] Matrix_1.7-1 labelled_2.14.1 questionr_0.8.1 forcats_1.0.0
## [9] dplyr_1.1.4 haven_2.5.5
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.10 generics_0.1.4 lattice_0.22-6 hms_1.1.3
## [5] digest_0.6.37 magrittr_2.0.3 evaluate_1.0.5 RColorBrewer_1.1-3
## [9] fastmap_1.2.0 jsonlite_2.0.0 DBI_1.2.3 promises_1.3.3
## [13] scales_1.4.0 textshaping_1.0.3 jquerylib_0.1.4 cli_3.6.5
## [17] shiny_1.11.1 mitools_2.4 rlang_1.1.6 splines_4.4.2
## [21] withr_3.0.2 cachem_1.1.0 yaml_2.3.10 tools_4.4.2
## [25] tzdb_0.5.0 httpuv_1.6.16 vctrs_0.6.5 R6_2.6.1
## [29] mime_0.13 lifecycle_1.0.4 miniUI_0.1.2 ragg_1.5.0
## [33] pkgconfig_2.0.3 pillar_1.11.0 bslib_0.9.0 later_1.4.4
## [37] gtable_0.3.6 glue_1.8.0 Rcpp_1.1.0 systemfonts_1.2.3
## [41] xfun_0.53 tibble_3.3.0 tidyselect_1.2.1 highr_0.11
## [45] rstudioapi_0.17.1 knitr_1.50 farver_2.1.2 xtable_1.8-4
## [49] htmltools_0.5.8.1 labeling_0.4.3 rmarkdown_2.29 readr_2.1.5
## [53] compiler_4.4.2