### Bergström, M., Maillochon, F., et l’équipe Envie, (2024). 
### Couples, histoires d’un soir, « sexfriends » : diversité des relations intimes des moins de 30 ans. 
### Population & Sociétés, 623(6), 1-4. https://doi.org/10.3917/popsoc.623.0001.

## Réplication accompagnée 

## Figure 2 « Avoir été en couple dans l'année selon l'âge et l'origine sociale »

# Charger les packages nécessaires
library(readr)
library(questionr)
library(tidyverse)
library(ggplot2)
library(esquisse)

# Importer les données
ENVIE <- read_csv("materiel/Envie_FPA.csv")

# Sélectionner les variables utiles pour reproduire la figure
ENVIE2 <- ENVIE |>
  select(genre_id, age_rec, par_men_5, couple12M, poidscal)

# Examiner la distribution des variables sélectionnées
table(ENVIE2$genre_id, useNA = "always")
table(ENVIE2$age_rec, useNA = "always")
table(ENVIE2$par_men_5, useNA = "always")
table(ENVIE2$couple12M, useNA = "always")

# Conserver uniquement les hommes et les femmes
ENVIE3 <- ENVIE2 |>
  filter(genre_id == 1 | genre_id == 2)

# Vérifier les valeurs manquantes après restriction de la population
table(ENVIE3$par_men_5, useNA = "always")
table(ENVIE3$couple12M, useNA = "always")

# Supprimer les observations avec une valeur manquante sur les variables utiles
ENVIE3 <- ENVIE3 |> filter(complete.cases(couple12M, par_men_5))

# Recoder l'âge en classes avec l'addin questionr

icut()

ENVIE3$age_tranche <- cut(
  ENVIE3$age_rec,
  include.lowest = TRUE,
  right = TRUE,
  breaks = c(18, 21, 25, 29),
  labels = c("18-21 ans", "22-25 ans", "26-29 ans")
)

# Vérifier le recodage de l'âge
table(ENVIE3$age_tranche, useNA = "always")

# Recoder l'origine sociale avec l'addin questionr

irec()

ENVIE3$origine <- ENVIE3$par_men_5 |>
  as.character() |>
  fct_recode(
    "cadre" = "1",
    "intermédiaire" = "2",
    "employée" = "3",
    "petit indépendant" = "4",
    "populaire" = "5"
  ) |>
  as.character()

# Recoder le genre avec l'addin questionr

irec()

ENVIE3$genre_id_rec <- ENVIE3$genre_id |>
  as.character() |>
  fct_recode(
    "Homme" = "1",
    "Femme" = "2"
  ) |>
  as.character()

# Recoder le fait d'avoir été en couple dans l'année avec l'addin questionr

irec()

ENVIE3$couple12M_rec <- ENVIE3$couple12M |>
  as.character() |>
  fct_recode(
    "couple" = "1",
    "couple" = "2",
    "pas_couple" = "3"
  ) |>
  as.character()

# Créer une base pour les hommes et une base pour les femmes
homme <- ENVIE3 |>
  filter(genre_id_rec == "Homme")

femme <- ENVIE3 |>
  filter(genre_id_rec == "Femme")

# Calculer les proportions pondérées pour les femmes

# Être en couple selon l'âge
tab_f_age <- wtd.table(femme$age_tranche, femme$couple12M_rec, weights = femme$poidscal) |>
  lprop()

# Être en couple selon l'origine sociale
tab_f_origine <- wtd.table(femme$origine, femme$couple12M_rec, weights = femme$poidscal) |>
  lprop()

# Calculer les proportions pondérées pour les hommes

# Être en couple selon l'âge
tab_h_age <- wtd.table(
  homme$age_tranche,
  homme$couple12M_rec,
  weights = homme$poidscal
) |>
  lprop()

# Être en couple selon l'origine sociale
tab_h_origine <- wtd.table(
  homme$origine,
  homme$couple12M_rec,
  weights = homme$poidscal
) |>
  lprop()

# Transformer les quatre tableaux de résultats en data.frames
bdd_f_age <- as.data.frame(tab_f_age) |>
  rename(modalite = Var1, couple = Var2) |>
  filter(modalite != "Ensemble", couple == "couple")

bdd_f_origine <- as.data.frame(tab_f_origine) |>
  rename(modalite = Var1, couple = Var2) |>
  filter(modalite != "Ensemble", couple == "couple")

bdd_h_age <- as.data.frame(tab_h_age) |>
  rename(modalite = Var1, couple = Var2) |>
  filter(modalite != "Ensemble", couple == "couple")

bdd_h_origine <- as.data.frame(tab_h_origine) |>
  rename(modalite = Var1, couple = Var2) |>
  filter(modalite != "Ensemble", couple == "couple")

# Ajouter une variable indiquant le genre
bdd_f_age$genre <- "Femme"
bdd_h_age$genre <- "Homme"
bdd_f_origine$genre <- "Femme"
bdd_h_origine$genre <- "Homme"

# Réunir les résultats selon l'âge et identifier le bloc correspondant
bdd_age <- bind_rows(bdd_f_age, bdd_h_age)
bdd_age$bloc <- "Âge"

# Réunir les résultats selon l'origine sociale et identifier le bloc correspondant
bdd_origine <- bind_rows(bdd_f_origine, bdd_h_origine)
bdd_origine$bloc <- "Origine sociale"

# Fusionner les résultats dans une seule base pour le graphique
bdd_graphique <- bind_rows(bdd_age, bdd_origine)

# Ouvrir Esquisse pour construire le graphique de manière interactive
esquisser()

# Produire le graphique final avec ggplot2
ggplot(bdd_graphique) +
  aes(x = modalite, y = Freq, fill = genre) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = c(Femme = "#E88A00", 
                               Homme = "#077F11")) +
  labs(x = "Variable", y = "%", title = "Avoir été en couple dans l'année selon l'âge et l'origine sociale", 
       caption = "M. Bergström, F. Maillochon, l’équipe Envie, Population & Sociétés, n° 623, mai 2024, Ined. Source : Enquête Envie, Ined, 2023. Données pondérées.", 
       fill = "Genre") +
  coord_flip() +
  theme_minimal() +
  theme(legend.justification = "right", plot.title = element_text(size = 18L, 
                                                                  face = "bold", hjust = 0.5), plot.caption = element_text(face = "italic", hjust = 0), axis.title.y = element_text(size = 15L, 
                                                                                                                                                                                    hjust = 1), legend.title = element_text(size = 12L)) +
  facet_wrap(vars(bloc), scales = "free", ncol = 1L) +
  ylim(0, 90)


## -------------------------------------------------------------------------
## Exercice complémentaire de réplication
## Figure 1 « Cadres de rencontre selon le type relationnel (%) »
## -------------------------------------------------------------------------

# Charger les packages nécessaires
library(readr)
library(questionr)
library(tidyverse)
library(ggplot2)
library(esquisse)

# Importer les données
ENVIE <- read_csv("materiel/Envie_FPA.csv")

# Sélectionner les variables utiles pour reproduire la figure
ENVIE2 <- ENVIE |>
  select(r1_cadre, r2_cadre, r3_cadre, couple12M, r2, r3, poidscal)

# Examiner les variables de cadre de rencontre
table(ENVIE2$r1_cadre, useNA = "always")
table(ENVIE2$r2_cadre, useNA = "always")
table(ENVIE2$r3_cadre, useNA = "always")

# Examiner les variables permettant d'identifier les types relationnels
table(ENVIE2$couple12M, useNA = "always")
table(ENVIE2$r2, useNA = "always")
table(ENVIE2$r3, useNA = "always")

# Créer une base de travail
ENVIE3 <- ENVIE2  

# Recoder le cadre de rencontre du couple avec l'addin questionr

irec()

ENVIE3$r1_cadre_rec <- ENVIE3$r1_cadre |>
  as.character() |>
  fct_recode(
    "Lieux d'étude ou de travail" = "1",
    "Lieux d'étude ou de travail" = "2",
    "Fête ou soirée entre ami·es" = "3",
    "Chez un particulier ou par la famille" = "4",
    "Applications de rencontres" = "5",
    "Réseaux sociaux ou jeux en ligne" = "6",
    "Lieux publics" = "9",
    "Autre cadre" = "10"
  ) |>
  as.character()

# Recoder le cadre de rencontre de l'histoire d'un soir avec l'addin questionr

irec()

ENVIE3$r2_cadre_rec <- ENVIE3$r2_cadre |>
  as.character() |>
  fct_recode(
    "Lieux d'étude ou de travail" = "1",
    "Lieux d'étude ou de travail" = "2",
    "Fête ou soirée entre ami·es" = "3",
    "Chez un particulier ou par la famille" = "4",
    "Applications de rencontres" = "5",
    "Réseaux sociaux ou jeux en ligne" = "6",
    "Lieux publics" = "9",
    "Autre cadre" = "10"
  ) |>
  as.character()

# Recoder le cadre de rencontre de la relation suivie avec l'addin questionr

irec()

ENVIE3$r3_cadre_rec <- ENVIE3$r3_cadre |>
  as.character() |>
  fct_recode(
    "Lieux d'étude ou de travail" = "1",
    "Lieux d'étude ou de travail" = "2",
    "Fête ou soirée entre ami·es" = "3",
    "Chez un particulier ou par la famille" = "4",
    "Applications de rencontres" = "5",
    "Réseaux sociaux ou jeux en ligne" = "6",
    "Lieux publics" = "9",
    "Autre cadre" = "10"
  ) |>
  as.character()

# Construire une base pour les personnes ayant été en couple dans l'année
couple <- ENVIE3 |>
  filter(couple12M == 1 | couple12M == 2)

# Construire une base pour les personnes ayant eu une histoire d'un soir
histoire <- ENVIE3 |>
  filter(r2 == 1)

# Construire une base pour les personnes ayant eu une relation suivie
relation_suivie <- ENVIE3 |>
  filter(r3 == 1)

# Vérifier les valeurs manquantes sur les cadres de rencontre
table(couple$r1_cadre_rec, useNA = "always")
table(histoire$r2_cadre_rec, useNA = "always")
table(relation_suivie$r3_cadre_rec, useNA = "always")

# Supprimer les observations avec un cadre de rencontre manquant
couple <- couple |>
  filter(complete.cases(r1_cadre_rec))  

histoire <- histoire |>
  filter(complete.cases(r2_cadre_rec)) 

relation_suivie <- relation_suivie |>
  filter(complete.cases(r3_cadre_rec)) 

# Calculer les proportions pondérées pour le couple
tab_couple <- wtd.table(couple$r1_cadre_rec, weights = couple$poidscal) |>
  proportions() * 100

# Calculer les proportions pondérées pour l'histoire d'un soir
tab_histoire <- wtd.table(histoire$r2_cadre_rec, weights = histoire$poidscal) |>
  proportions() * 100

# Calculer les proportions pondérées pour la relation suivie
tab_relation_suivie <- wtd.table(relation_suivie$r3_cadre_rec, weights = relation_suivie$poidscal) |>
  proportions() * 100

# Transformer les tableaux de résultats en data.frames
bdd_couple <- as.data.frame(tab_couple)
bdd_histoire <- as.data.frame(tab_histoire)
bdd_relation_suivie <- as.data.frame(tab_relation_suivie)

# Renommer les variables
bdd_couple <- bdd_couple |> rename(cadre = Var1, proportion = Freq)
bdd_histoire <- bdd_histoire |> rename(cadre = Var1, proportion = Freq)
bdd_relation_suivie <- bdd_relation_suivie |> rename(cadre = Var1, proportion = Freq)

# Ajouter une variable indiquant le type relationnel
bdd_couple$type_relationnel <- "Couple"
bdd_histoire$type_relationnel <- "Histoire d'un soir"
bdd_relation_suivie$type_relationnel <- "Relation suivie"

# Réunir les trois bases pour construire le graphique
bdd_graphique <- bind_rows(
  bdd_histoire,
  bdd_relation_suivie,
  bdd_couple
)

# Ordonner les cadres de rencontre pour l'affichage du graphique
# L'ordre est inversé car le graphique utilise coord_flip()
bdd_graphique$cadre <- factor(
  bdd_graphique$cadre,
  levels = c(
    "Autre cadre",
    "Fête ou soirée entre ami·es",
    "Réseaux sociaux ou jeux en ligne",
    "Chez un particulier ou par la famille",
    "Applications de rencontres",
    "Lieux publics",
    "Lieux d'étude ou de travail"
  )
)

# Ordonner les types relationnels comme dans la légende
bdd_graphique$type_relationnel <- factor(
  bdd_graphique$type_relationnel,
  levels = c(
    "Histoire d'un soir",
    "Relation suivie",
    "Couple"
  )
)

# Ouvrir Esquisse pour construire le graphique de manière interactive
esquisser()

# Produire le graphique final avec ggplot2
ggplot(bdd_graphique) +
  aes(x = cadre, y = proportion, fill = type_relationnel) +
  geom_col(position = "dodge") +
  scale_fill_manual(
    values = c(
      "Histoire d'un soir" = "#B5121B",
      "Relation suivie" = "grey80",
      "Couple" = "black"
    )
  ) +
  labs(
    x = NULL,
    y = "%",
    fill = NULL,
    title = "Cadres de rencontre selon le type relationnel (%)",
    caption = "M. Bergström, F. Maillochon, l’équipe Envie, Population & Sociétés, n° 623, mai 2024, Ined.\nLecture : parmi les personnes ayant été en couple au cours des 12 derniers mois, 34 % ont connu leur partenaire dans le cadre des études ou du travail.\nSource : Enquête Envie, Ined, 2023. Données pondérées."
  ) +
  coord_flip() +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
    plot.caption = element_text(face = "italic", hjust = 0),
    plot.caption.position = "plot"
  ) +
  ylim(0, 35)