Pyramide des ages

creation de la fonction et de la vignette

DESCRIPTION

@@ -19,8 +19,9 @@ Depends:
 Imports: 
     dplyr,
     forcats,
-    kableExtra,
     ggplot2,
+    glue,
+    kableExtra,
     magrittr,
     readr,
     stringr,

NAMESPACE

 # Generated by roxygen2: do not edit by hand
 
 export("%>%")
-export(affiche_tableau_evolpop)
 export(affiche_graphique_evolpop)
+export(affiche_pyramide_ages)
+export(affiche_tableau_evolpop)
 export(agrege_donnees_demog)
 export(cherche_reg_dep_epci)
 export(prepare_indicateur_evolpop)
@@ -20,12 +21,12 @@ importFrom(dplyr,starts_with)
 importFrom(dplyr,summarise_if)
 importFrom(dplyr,ungroup)
 importFrom(forcats,fct_inorder)
-importFrom(kableExtra,footnote)
-importFrom(kableExtra,kable)
-importFrom(kableExtra,kable_styling)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,coord_flip)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_text)
+importFrom(ggplot2,facet_wrap)
+importFrom(ggplot2,geom_col)
 importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,ggplot)
@@ -33,6 +34,10 @@ importFrom(ggplot2,labs)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,ylim)
+importFrom(glue,glue)
+importFrom(kableExtra,footnote)
+importFrom(kableExtra,kable)
+importFrom(kableExtra,kable_styling)
 importFrom(magrittr,"%>%")
 importFrom(readr,read_rds)
 importFrom(stringr,str_c)

R/affiche_pyramide_ages.R

+#' Fonction d'affichage de la pyramide des ages d'un territoire.
+#' Utilise
+#'
+#' @param x table de donnees devant contenir les variables `code_perimetre` et une colonne par modalite "`sexe` x `classe d'age`
+#' @param c_perimetre le code de l'EPCI dont on souhaite afficher la pyramide
+#' @param c_perimetre2 le code d'un deuxieme perimetre dont on souhaite afficher la pyramide en parallele. Idealement le departement ou la region d'appartenance.
+#' @param labelsource chaine de caractere indiquant la source de la donnee. Prevue pour les donnees de recensement de la population, la valeur par defaut est "Insee RP"
+#' @param ndl chaine de caractere correspondant a une note de lecture/de bas de page pour le tableau. Par defaut, la chaine est vide.
+#'
+#' @return le graphique de la pyramide des ages
+#'
+#' @export
+#'
+#' @importFrom dplyr group_by filter mutate select ungroup
+#' @importFrom ggplot2 ggplot geom_col facet_wrap labs theme coord_flip
+#' @importFrom glue glue
+#' @importFrom tidyr pivot_longer
+#'
+
+affiche_pyramide_ages <- function(x, c_perimetre,
+                                  c_perimetre2 = NA,
+                                  labelsource = "Insee",
+                                  ndl = "") {
+  # Si deuxieme perimetre, l'inclure a la variable de filtre
+  if(!is.na(c_perimetre2)) {
+    c_perimetre <- c(c_perimetre, c_perimetre2)
+  }
+  # Preparation du tableau en format long
+  d_pyr <-
+    x %>%
+    filter(code_perimetre %in% c_perimetre)%>%
+    select(ends_with("perimetre"), contains("_age_"))  %>%
+    pivot_longer(cols = contains("_age"),
+                 names_to = "var_cle",
+                 values_to = "nb_hab") %>%
+    arrange(type_perimetre, var_cle) %>%
+    mutate(sexe = str_sub(var_cle, 5, 10),
+           cl_age = str_c(str_sub(var_cle, 16, 17),
+                          "-",
+                          ifelse(str_sub(var_cle, 19, 20) == "99",
+                                 "plus",
+                                 str_sub(var_cle, 19, 20))
+           )
+    ) %>%
+    group_by(code_perimetre) %>%
+    mutate(prop_hab = ifelse(sexe == "femmes", -1, +1) *
+             nb_hab / max(nb_hab)
+    ) %>%
+    ungroup() %>%
+    select(cl_age, sexe, everything())
+
+  # Preparation du graphique
+  plot_pyr <-
+    d_pyr %>%
+    ggplot( aes(x=cl_age,
+                y = prop_hab, fill=sexe)) +
+    geom_col(position = "stack") +
+    scale_x_discrete(breaks = d_pyr$cl_age,
+                     labels = d_pyr$cl_age) +
+    scale_y_discrete(labels = element_blank()) +
+    labs(x = element_blank(),
+         y = element_blank(),
+         caption = glue("{labelsource}\n{ndl}")) +
+    theme_bw() +
+    theme(legend.title = element_blank(),
+          legend.text = element_text(size = 8),
+          # legend.position = c(0.05, 0.9) # option à creuser
+          legend.position = "bottom"
+    ) +
+    coord_flip()
+
+  # Si deuxieme perimetre doit etre affiche, prevoir les *facet_wrap* dans l'affichage
+  if(length(c_perimetre) > 1){
+    plot_pyr +
+      facet_wrap(ncol = 2,
+                 facets = "lib_perimetre")
+  } else {
+    plot_pyr
+  }
+} # fin function

man/affiche_pyramide_ages.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/affiche_pyramide_ages.R
+\name{affiche_pyramide_ages}
+\alias{affiche_pyramide_ages}
+\title{Fonction d'affichage de la pyramide des ages d'un territoire.
+Utilise}
+\usage{
+affiche_pyramide_ages(
+  x,
+  c_perimetre,
+  c_perimetre2 = NA,
+  labelsource = "Insee",
+  ndl = ""
+)
+}
+\arguments{
+\item{x}{table de donnees devant contenir les variables \code{code_perimetre} et une colonne par modalite "\code{sexe} x \verb{classe d'age}}
+
+\item{c_perimetre}{le code de l'EPCI dont on souhaite afficher la pyramide}
+
+\item{c_perimetre2}{le code d'un deuxieme perimetre dont on souhaite afficher la pyramide en parallele. Idealement le departement ou la region d'appartenance.}
+
+\item{labelsource}{chaine de caractere indiquant la source de la donnee. Prevue pour les donnees de recensement de la population, la valeur par defaut est "Insee RP"}
+
+\item{ndl}{chaine de caractere correspondant a une note de lecture/de bas de page pour le tableau. Par defaut, la chaine est vide.}
+}
+\value{
+le graphique de la pyramide des ages
+}
+\description{
+Fonction d'affichage de la pyramide des ages d'un territoire.
+Utilise
+}

vignettes/affiche_pyramide_ages.Rmd

+---
+title: "affiche_pyramide_ages"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{affiche_pyramide_ages}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+
+# Objectif
+A partir du tableau global des donnees, extraire les colonnes relatives aux classese quinquenales d'age par sexe, pour un EPCI et optionnellement pour la region Grand Est.
+Convertir le tableau en format wide_long, et decroiser les modalites sexe et classe d'age.
+La fonction ggplot() utilise le format de donnees long.
+
+# Prealables
+- recuperer les donnees issues du recensement de la population, disponibles a l'echelle communale
+- aggreger les donnees aux niveaux des EPCI, des Departements et de la region.
+- retenir uniquement les donnees concernant les territoires d'interet :
+  - l'EPCI selectionne
+  - la region Grand Est
+
+
+# A effectuer
+- [x] mettre en forme le tableau
+- [x] afficher le graphique
+
+```{r, message = FALSE}
+library(dplyr)
+library(tidyr)
+library(stringr)
+library(ggplot2)
+library(readr)
+library(forcats)
+library(glue)
+library(opm2020)
+```
+
+
+Cette fonction permet l'affichage de la pyramide des âges.
+
+#### A. Chargement des données
+
+```{r}
+d_pop_r44_file <- system.file("donnees_rds/d_pop_r44.rds",
+                              package = "opm2020")
+d_demog_global <- read_rds(d_pop_r44_file)
+```
+
+#### B. agrégation de toutes les données à l'échelle de l'EPCI, du département de l'EPCI et de la région
+
+```{r}
+d_demog_agreg <- d_demog_global %>% 
+  agrege_donnees_demog()
+```
+
+#### C. filtre sur EPCI courant, dep et région  
+
+Au préalable, charger les listes des EPCI et des communes, pour filtrer sur 1 EPCI.
+La préparation puis l'affichage du tableau se fera sur cet EPCI choisi
+
+```{r}
+# Chemins vers les fichiers du package opm2020
+l_epci_fr_file <- 
+  system.file("donnees_rds/l_epci_fr.rds",
+              package = "opm2020")
+
+l_epci_fr <- read_rds(l_epci_fr_file)
+
+```
+
+
+# Traitements prealables
+## zones geographiques choisies
+Lorsque 1 EPCI choisi, determiner son departement et sa region de rattachement.
+
+```{r}
+code_epci_test <- "240800847"  # CC des Portes du Luxembourg
+
+reg_dep_test <-
+  l_epci_fr %>% cherche_reg_dep_epci(code_epci_test)
+c_reg_epci_test <- reg_dep_test %>% 
+  pull(reg_siege)
+c_dep_epci_test <- reg_dep_test %>% 
+  pull(dep_siege)
+```
+
+
+### Affichage de la pyramide sans la région
+```{r}
+d_demog_agreg %>% 
+  affiche_pyramide_ages(code_epci_test,
+                        labelsource = "Insee RP 2016",
+                        ndl = "commentaire test")
+```
+
+### Affichage de la pyramide avec departement en parallèle
+```{r}
+d_demog_agreg %>% 
+  affiche_pyramide_ages(c_perimetre = code_epci_test,
+                        c_perimetre2 = c_dep_epci_test,
+                        labelsource = "Insee RP 2016")
+```
+
+### Affichage de la pyramide avec region en parallèle
+```{r}
+
+d_demog_agreg %>% 
+  affiche_pyramide_ages(c_perimetre = code_epci_test,
+                        c_perimetre2 = c_reg_epci_test,
+                        labelsource = "Insee RP 2016")
+```
+