Skip to content
Snippets Groups Projects
Commit aa8594e5 authored by Juliette Engelaere-Lefebvre's avatar Juliette Engelaere-Lefebvre
Browse files

WIP - factorisation des fonctions, palettes et référentiels 

Reste à adapter la suite...
parent fcc7e1b4
Branches
No related tags found
1 merge request!21Resolve "Réagencer la production et les lecture des données complémentaires"
Hide whitespace changes
Inline Side-by-side
0_compilation_TEO.Rmd
+ 19
− 45
View file @ aa8594e5
......@@ -83,14 +83,27 @@ compil_teo_1 <- compil_teo %>%
id_attest_mecc, capa_nm3_par_h_mecc, contains("lambert93"), #Total_tonnage,
contains("adresse"), Departement) %>%
mutate(id_table = coalesce(as.character(id_aile), id_compil),
# des UIOM dans la liste ?
etat_d_avancement_compil = if_else(grepl(" Incinération ", nom_structure_compil),
paste(etat_d_avancement_compil, "(pas de valo de biogaz a priori)"),
etat_d_avancement_compil),
statut_agrege = case_when(
grepl("abandon|suspendu|arrêt|résilié|fermé", tolower(etat_d_avancement_compil)) ~ "Abandon",
grepl("projet|travaux|émergence|réflexion|instruction", tolower(etat_d_avancement_compil)) ~ "Projet",
grepl("fonctionnement|service", tolower(etat_d_avancement_compil)) ~ "En service",
TRUE ~ "A voir"))
# Installations à couvrir par l'enquête = installations ne fonctionnement
# exception 2022 : l'installation 45 a été arrête dans le courant de l'année 2022, on la garde encore un petit peu
inst_arret_pdt_camp <- c("45")
compil_teo_2 <- compil_teo_1 %>%
filter(statut_agrege != "Abandon", !grepl("pas de valo de biogaz", etat_d_avancement_compil ))
if(params$campagne == "2022") {
compil_teo_2 <- compil_teo_2 %>%
bind_rows(filter(compil_teo_1, id_aile %in% inst_arret_pdt_camp) )
}
```
`r compil_teo_1 %>% filter(statut_agrege == "Abandon" | grepl("pas de valo de biogaz", etat_d_avancement_compil)) %>% nrow()` installations sont écartées car elle correspondent à des projets abandonnés, arrêtés, fermés, résiliés, suspendus ou sans valorisation du biogaz.
......@@ -140,7 +153,7 @@ compil_teo_3 <- compil_teo_2 %>%
`r nrow(explo_geoloc)` installations ne sont pas géolocalisées par TEO. On procède à leur géocodage grâce à la base adresse nationale package {BanR} et aux adresses rassemblées par TEO. On utilise de préférence l'adresse S3IC, ou si non renseignée, celle de SINOE, ou si non renseignée également, l'adresse saisie par la MECC pour les attestations biométhane. En l'absence d'adresses, l'installation est géolocalisée au centroïde la commune.
```{r versement SGBD, eval=params$sgbd_util=="does"}
```{r versement SGBD, eval=(params$sgbd_util=="does")}
nom_table <- str_standardize(nom_compil_teo) %>% gsub("^var_|_ods$", "", .)
date_table <- str_extract(nom_table, "[0-9]{8}_") %>% str_remove("_")
nom_table <- str_remove(nom_table, "[0-9]{8}_") %>% paste0("_", date_table)
......@@ -156,16 +169,12 @@ commentaire_sgbd <- "Compilation réalisée par Téo à partir du croisement de
commenter_table(comment = commentaire_sgbd,
table = nom_table, schema = "mecc_bilans_metha", db = "production")
```
# Préparation en vue d'une publication de la compil sur consultation et SIGloire
```{r publication}
# A récupérer dans compil_teo les attributs publiés par TEO sur son open data, absent de compil 3
attr_pub_TEO <- compil_teo %>%
mutate(date_mes = coalesce(annee_de_mise_en_service, annee_de_mise_en_service_aile)) %>%
......@@ -224,8 +233,11 @@ commenter_table(comment = commentaire_sgbd_consultation, table = paste0(nom_tabl
schema = "mecc_bilans_metha", db = "production")
post_dico_attr(dico = dico_var, table = paste0(nom_table, "_synthese"),
schema = "mecc_bilans_metha", db = "production")
schema = "mecc_bilans_metha", db = "production")
```
```{r pub_consultation}
## bascule sur la base de consultation
poster_data(data = compil_publication, user = "admin",
table = "r_methanisation_p_r52",
......@@ -247,44 +259,6 @@ Autres exports : couches spatiales, table de données complémentaire pour compi
sf::st_write(compil_teo_3, paste0("donnees_redresses/compil_teo_", date_table, "_enservice_ou_enprojet.csv"), layer_options = "GEOMETRY=AS_XY", delete_layer = TRUE)
save(compil_teo_3, file = paste0("donnees_redresses/compil_teo_", date_table, "_enservice_ou_enprojet.RData" ))
# Exports données complémentaires pour la compilation des réponses (dites le nous une fois depuis bilan 2022)-----
# onglet S3IC
onglet_s3ic <- compil_teo_1 %>%
filter(statut_agrege == "En service") %>%
mutate(id_aile_old = "a completer annee prcdtes") %>%
select(id_aile = id_table, id_aile_old, typologie = typologie_compil, id_compil, s3ic = id_GUN, mwh_primaire = mwh_primaire_aile, Total_tonnage = tep_aile)
# Onglet registre électricité
onglet_reg_elec <- compil_teo %>%
filter(!is.na(id_rte), etat_d_avancement_aile != "Arrêté") %>%
select(id_aile, id_RTE = id_rte, nom_rte, MW_elec_RTE, date_mes_RTE)
# ajout registre électricité SGBD : données au 31/12, plus récentes que celles figurant la compil TEO
table_elec <- paste0("registre_inst_electr_", params$campagne, "_r52")
registre_elec_0 <- importer_data(table = table_elec, schema = "mecc_electricite", db = "production")
registre_elec <- registre_elec_0 %>%
st_drop_geometry() %>%
select(id_RTE = id_inst, nominstallation, date_inst, puiss_mw, prod_mwh_an) %>%
semi_join(onglet_reg_elec)
onglet_reg_elec_complete <- left_join(onglet_reg_elec, registre_elec) %>%
mutate(nom_rte = coalesce(nominstallation, nom_rte),
MW_elec_RTE = coalesce(puiss_mw, MW_elec_RTE),
date_mes_RTE = coalesce(date_inst, date_mes_RTE)) %>%
select(id_aile, id_RTE, nom_rte, MW_elec_RTE, date_mes_RTE)
# Onglet registre biométhane
onglet_reg_ch4 <- compil_teo %>%
filter(!is.na(id_unique_bioch4_registre), etat_d_avancement_aile != "Arrêté") %>%
select(id_aile, id_unique_bioch4_registre, nom_du_projet_registre, typo_registre = typo_registre_registre,
date_mes_registre = date_mes_registre_registre, capa_prod_gwh_an_registre = capa_prod_gwh_an_registre_registre,
starts_with("quantite_annuelle_injectee")) %>%
rename_with(~gsub("xxxx", params$campagne, .x))
writexl::write_xlsx(x = list(reg_elec = onglet_reg_elec_complete,
rg_ch4 = onglet_reg_ch4,
s3ic = onglet_s3ic),
path = paste0("compilation/tmp/aide_donnees_complementaires_", params$campagne, ".xlsx"))
```
0_donnees_ref_palettes.Rmd 0 → 100644
+ 498
− 0
View file @ aa8594e5
---
title: "Données de références et palettes bilans annuels méthaniseurs `r params$campagne`"
author: "Juliette Engelaere-Lefebvre"
date: "`r format(Sys.Date(), '%d/%m/%Y')`"
output: html_document
params:
vpn: TRUE
campagne: "2022"
sgbd_util: "does"
compil_teo: "compilation_metha_teo_20230310"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(tidyverse)
library(readODS)
library(readxl)
library(tricky)
library(lubridate)
library(datalibaba)
library(sf)
library(glue)
library(gouvdown)
```
Les données de références sont lues à différents endroits :
- lors de la compil TEO
- lors de la lecture des données
- lors du redressement des données
Egalement les palettes, sont créées à différents moments, cela rend compliqué l'appropriation du projet par d'autres.
Il est nécessaire de factoriser tout cela pour dans un Rmd à lire avant la compilation des réponses pour plus de clarté.
# Paramètres
- [ ] filigrane (intro 4e rmd)
- [ ] adresse fichier données complémentaire
```{r parametres}
# filigrane nom source
filigrane <- paste0("Bilans de fonctionnement biogaz ", params$campagne, " - DREAL Pays de la Loire")
if(params$vpn) {
repertoire <- paste0("../W_exports_DS/", params$campagne, "/")
} else {
repertoire <- paste0("W:/SRB/Bilans annuels méthanisation ", params$campagne, "/")
}
fic_ods <- list.files(repertoire, full.names = TRUE) %>% grep(".ods|.xls", ., value = TRUE) %>%
setdiff(grep("_exemple|_suivi|modifVisi", ., value = TRUE))
fic_tb_data_comp <- regmatches(fic_ods, regexpr("donnees_complementaires*\\.ods", fic_ods))[1] %>%
paste0(repertoire, "/", .)
rm(fic_ods, repertoire)
```
# Datasets
## Inventaires installations externes
### Compil TEO et ses croisements S3IC
```{r dataset}
# Exports données complémentaires pour la compilation des réponses (dites le nous une fois depuis bilan 2022)-----
compil_teo <- importer_data(table = params$compil_teo, schema = "mecc_bilans_metha", db = "production", user = params$sgbd_util)
# onglet S3IC - liste des installations en fonctionnement
onglet_s3ic <- compil_teo %>%
filter(statut_agrege != "Projet") %>%
select(id_aile = id_table, statut_agrege, typologie = typologie_compil, id_compil, s3ic = id_GUN,
mwh_primaire = mwh_primaire_aile, Total_tonnage = tep_aile) %>%
st_drop_geometry()
```
### Référentiel AILE
Le référentiel des installations AILE à bâtir contient les évolutions des identifiants AILE et la typologie des installations, détaillé et groupée
```{r ref_aile 1}
tb_psg_id_aile <- read_ods(fic_tb_data_comp, sheet = "evol_id_aile", col_types = NA) %>%
replace_na(list(id_aile_old = "")) %>%
# on complète avec l'ensemble des installations
full_join(onglet_s3ic %>% select(id_aile) %>% st_drop_geometry(), by = "id_aile") %>%
mutate(id_aile_new = id_aile) %>%
distinct() %>%
separate(id_aile_old, into = c("id_aile_old_1", "id_aile_old_2"), fill = "right") %>%
pivot_longer(cols = c("id_aile_old_1", "id_aile_old_2", "id_aile_new"),
values_to = "id_aile_old") %>%
filter(!is.na(id_aile_old)) %>%
select(-name) %>%
distinct() %>%
left_join(select(onglet_s3ic, id_aile, typo_maj = typologie), by = "id_aile")
# verif_appariement
nrow(filter(tb_psg_id_aile, is.na(typo_maj))) == 0
```
```{r ref_aile typo}
typo_aile <- read_ods(fic_tb_data_comp, sheet = "ref_type_install",
col_types = "ff")
ref_aile <- tb_psg_id_aile %>%
left_join(typo_aile, by = c("typo_maj" = "typo_aile"))
# verif_appariement
nrow(filter(ref_aile, is.na(typo))) == 0
poster_data(ref_aile, table = paste0("referentiel_aile_", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = c("id_aile", "id_aile_old"), overwrite = TRUE, droits_schema = TRUE)
rm(tb_psg_id_aile, typo_aile)
```
```{r fonction maj id_aile, warning=FALSE}
maj_id_aile <- function(table, champ = "id_aile", garder_typo = FALSE) {
var_suppr <- c("id_aile_old", "typo")
if(!garder_typo) {var_suppr <- c(var_suppr, "typo_maj")}
right_join(ref_aile, table, by = c("id_aile_old" = champ)) %>%
select(-all_of(var_suppr)) %>%
distinct()
}
```
```{r fonction typo aile regroupee}
regroupe_typo_aile <- function(table, champ = "typo_aile"){
select(ref_aile, contains("typo")) %>%
distinct() %>%
right_join(table, by = c("typo_aile" = champ)) %>%
select(-typo_aile) %>%
rename(typo_aile = typo) %>%
distinct()
}
```
### Registres
```{r dataset registres}
# Onglet registre électricité
onglet_reg_elec <- compil_teo %>%
filter(!is.na(id_rte)) %>%
select(id_aile, id_RTE = id_rte) %>%
st_drop_geometry()
# ajout registre électricité SGBD : données au 31/12, plus récentes que celles figurant la compil TEO
table_elec <- paste0("registre_inst_electr_", params$campagne, "_r52")
registre_elec_0 <- importer_data(table = table_elec, schema = "mecc_electricite", db = "production")
registre_elec <- registre_elec_0 %>%
st_drop_geometry() %>%
select(id_RTE = id_inst, nom_rte = nominstallation, date_mes_RTE = date_inst, MW_elec_RTE = puiss_mw, prod_mwh_an)
tb_passage_aile_registre <- left_join(onglet_reg_elec, registre_elec) %>%
select(id_aile, id_RTE, nom_rte, MW_elec_RTE, date_mes_RTE) %>%
mutate(id_aile = as.character(id_aile)) %>%
filter(!is.na(id_aile)) %>%
maj_id_aile("id_aile", garder_typo = FALSE)
rm(onglet_reg_elec, table_elec, registre_elec_0, registre_elec)
# Onglet registre biométhane
# dernier registre biométhane disp dans le SGBD, données injection millésime N disponibles en août N+1
con <- connect_to_db(db = "production")
table_bioch4 <- datalibaba::list_tables(con = con, schema = "mecc_gaz", db = "production") %>%
grep("^registre_biogaz_...._r52$", ., value = TRUE) %>%
sort(x = ., decreasing = TRUE) %>%
.[1]
DBI::dbDisconnect(con)
registre_bioch4 <- importer_data(table = table_bioch4, schema = "mecc_gaz", db = "production") %>%
st_drop_geometry()
onglet_reg_ch4 <- compil_teo %>%
st_drop_geometry() %>%
mutate(id_unique_bioch4_registre = as.character(id_unique_bioch4_registre)) %>%
filter(!is.na(id_unique_bioch4_registre)) %>%
left_join(registre_bioch4, by = c("id_unique_bioch4_registre" = "id_unique_projet")) %>%
select(id_aile, id_unique_bioch4_registre, nom_du_projet, typo_registre = type,
date_mes_registre = date_de_mes, capa_prod_gwh_an_registre = capacite_de_production_gwh_an,
annee, quantite_annuelle_injectee_en_gwh) %>%
pivot_wider(names_from = "annee", values_from = "quantite_annuelle_injectee_en_gwh", names_glue = "{.value}_{annee}")
rm(table_bioch4, registre_bioch4, con, compil_teo)
writexl::write_xlsx(x = list(reg_elec = tb_passage_aile_registre,
rg_ch4 = onglet_reg_ch4,
s3ic = onglet_s3ic),
path = paste0("compilation/tmp/aide_donnees_complementaires_", params$campagne, ".xlsx"))
```
## Nomenclatures, objectifs et gisements intrants (issus intrants_valo)
```{r typo intrants}
# chargement de la typologie des intrants
typo_dechets <- read_ods(fic_tb_data_comp, sheet = "intrants_typo") %>%
# le double espace entre disparaît à la lecture du ficher ?!?
mutate(Categorie_intrants = gsub("grasses (avec produits ", "grasses (avec produits ", Categorie_intrants, fixed = TRUE)) %>%
mutate(groupe = fct_inorder(groupe))
poster_data(typo_dechets, table = paste0("referentiel_intrants_", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "cat_intr_court", overwrite = TRUE, droits_schema = TRUE)
```
### Saisies libellés, gisements et objectifs 2030 SRB
```{r}
obj_2030 <- tribble(
~lib_fam_srb, ~obj_2030_tonnes, ~famille_srb, ~gisement_total,
"Effluents d'élevage" , 5310000 , "A" , 22000000 ,
"Ensilage de cultures intermédiaires" , 1000000 , "B" , 3320000 ,
"Résidus de cultures dont issus de silos" , 145000 , "C" , 5323000 ,
"Déchets verts" , 35000 , "D" , 695000 ,
"Industries agro-alimentaires (IAA) + Abattoirs" , 270000 , "E" , 900000 ,
"Assainissement" , 365000 , "F" , 990000 ,
"Déchets organiques fermentescibles" , 70000 , "G" , 215000 ,
"Ensilage de cultures principales" , 0 , "Z", 0
)
# vérif appariement typo_dechet, TRUE attendu
typo_dechets %>%
left_join(obj_2030, by = "famille_srb") %>%
filter(is.na(lib_fam_srb)) %>%
nrow() == 0
poster_data(obj_2030, table = paste0("obj_2030_srb", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "famille_srb", overwrite = TRUE, droits_schema = TRUE)
```
### Libellés et gisements étude Solagro/Téo 2024
```{r}
gismts_solagro <- read_ods(fic_tb_data_comp, sheet = "gismt_teo_solagro")
# vérif appariement typo_dechet, TRUE attendu
typo_dechets %>%
left_join(gismts_solagro, by = "type_gismnt_solagro") %>%
filter(is.na(ordre_solagro)) %>%
nrow() == 0
poster_data(gismts_solagro, table = paste0("gisement_solagro", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "ordre_solagro", overwrite = TRUE, droits_schema = TRUE)
```
# Palettes
- [x] famille intrants (5e rmd)
- [x] domaines intrants (5e rmd)
- [x] srb (5e rmd)
- [x] srb 2 (5e rmd, L1044)
- [x] solagro (a créer)
- [x] pal carto 1 (5e rmd, L384)
- [x] pal carto 2 (5e rmd, L440)
- [x] pal-type_valo (5e rmd, ?)
- [x] pal_typo_groupee (5e Rmd, L520)
## Palettes intrants
### fonction de visualisation d'une palette
```{r viz_palette}
viz_pal <- function(vec_pal) {
barplot(rep(1, length(vec_pal)), names.arg = str_wrap(names(vec_pal), 3),
col = vec_pal, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
}
```
### Nomenclature famille
```{r palettes famille intrants, fig.height=2, fig.width=12}
# palette et familles
palette_famille_intrants <- tribble(
~famille_intrants_court, ~nom_couleur,
"Effluents d’élevage", "a1",
"CIVE", "c2",
"Cultures principales", "d1",
"Résidus végétaux des exploitations agricoles", "b2",
"Déchets végétaux IAA", "b4",
"Déchets verts", "b0",
"Déchets STEP urbaine", "p1",
"Déchets animaux IAA", "o0",
"Déchets animaux abattoirs", "p2",
"Biodéchets", "g2",
"Glycérine", "r3"
) %>%
mutate(val_couleur = gouv_colors(nom_couleur))
col_fam <- typo_dechets %>%
arrange(ordre_famille) %>%
select(famille_intrants_court, Famille_intrants) %>%
distinct() %>%
left_join(palette_famille_intrants, by = "famille_intrants_court")
# Vérif appariement palette famille (TRUE attendu)
nrow(filter(col_fam, is.na(nom_couleur))) == 0
vec_col_famille <- col_fam$val_couleur %>% setNames(col_fam$Famille_intrants)
vec_col_famille_court <- col_fam$val_couleur %>% setNames(col_fam$famille_intrants_court)
# Visualisation de la palette
viz_pal(vec_col_famille)
```
### Nomenclature SRB
```{r palettes srb, fig.height=2, fig.width=12}
palette_srb <- select(typo_dechets, famille_intrants_court, famille_srb) %>%
distinct() %>%
left_join(obj_2030 %>% select(contains("_srb")), by = "famille_srb") %>%
left_join(palette_famille_intrants, by = "famille_intrants_court") %>%
# on garde la couleur des 'Déchets animaux IAA' pour les IAA
filter(!(famille_intrants_court %in% c("Déchets végétaux IAA", "Déchets animaux abattoirs", "Glycérine"))) %>%
arrange(famille_srb) %>%
mutate(lib_fam_srb = fct_inorder(lib_fam_srb)) %>%
select(contains("srb"), contains("couleur")) %>%
mutate(lib_fam_srb_2 = gsub("Ensilage de c", "C", lib_fam_srb))
# un sous vecteur de couleur nommées
vec_col_srb <- palette_srb$val_couleur[c(1:8)] %>% setNames(palette_srb$lib_fam_srb[c(1:8)])
vec_col_srb_2 <- palette_srb$val_couleur[c(1:8)] %>%
setNames(palette_srb$lib_fam_srb_2[c(1:8)])
# Visualisation de la palette
viz_pal(vec_col_srb_2)
```
### Nomenclature à 4 postes
```{r palettes groupes intrants, fig.height=2, fig.width=12}
col_group <- col_fam %>%
left_join(select(typo_dechets, famille_intrants_court, groupe),
by = "famille_intrants_court") %>%
filter(!(nom_couleur %in% c("b4", "c2", "d1", "p1"))) %>%
group_by(groupe) %>%
slice(1) %>%
ungroup()
vec_col_group <- col_group$val_couleur %>% setNames(col_group$groupe)
# Visualisation de la palette
viz_pal(vec_col_group)
rm(col_group, col_fam)
```
### Nomenclature gisement solagro
```{r palettes solagro, fig.height=2, fig.width=12}
palette_solagro <- gismts_solagro %>%
select(type_gismnt_solagro) %>%
left_join(typo_dechets %>% select(famille_intrants_court, type_gismnt_solagro),
by = "type_gismnt_solagro") %>%
distinct() %>%
filter(type_gismnt_solagro != "Hors gisements étude TEO Solagro") %>%
left_join(palette_famille_intrants, by = "famille_intrants_court") %>%
filter(!grepl("abattoir|végétaux IAA|Glycérine", famille_intrants_court)) %>%
select(type_gismnt_solagro, contains("couleur"))
vec_col_solagro <- palette_solagro$val_couleur %>%
setNames(palette_solagro$type_gismnt_solagro)
viz_pal(vec_col_solagro)
```
```{r palettes solagro-srb, fig.height=2, fig.width=12}
palette_solagro_srb <- palette_srb %>%
filter(famille_srb != "Z")
vec_col_solagro_srb <- palette_solagro_srb$val_couleur %>%
setNames(palette_solagro_srb$lib_fam_srb_2)
viz_pal(vec_col_solagro_srb)
rm(palette_solagro, palette_solagro_srb)
```
## Palettes type d'installations
```{r palettes type valo, fig.height=2, fig.width=12}
pal_typ_valo <- c("Injection" = gouv_colors("o1")[[1]], "Cogénération" = gouv_colors("f1")[[1]], "Mixte" = gouv_colors("c1")[[1]])
# # Visualisation de la palette
viz_pal(pal_typ_valo)
```
```{r palettes carto1, fig.height=2, fig.width=12}
pal_carto_1 <- c(gouv_colors("m1")[[1]], gouv_colors("i1")[[1]], gouv_colors("f2")[[1]], gouv_colors("c1")[[1]]) %>%
setNames(c("Chaudière", "Cogénération", "Cogénération et injection", "Injection"))
viz_pal(pal_carto_1)
```
```{r palettes carto2, fig.height=2, fig.width=12}
carto2 <- ref_aile %>%
select(typo_maj, typo) %>%
unique() %>%
arrange(typo)
## todo : besoin de mettre typo_maj dans ref_aile en factoeur ordonnée ?
pal_carto_2 <- c(gouv_colors("b1")[[1]], gouv_colors("d2")[[1]], gouv_colors("r2")[[1]],
gouv_colors("p2")[[1]], gouv_colors("q1")[[1]]) %>%
setNames(levels(carto2$typo))
viz_pal(pal_carto_2)
```
```{r palettes cat installation, fig.height=2, fig.width=12}
pal_typo_groupee <- c(gouv_colors("b1")[[1]], gouv_colors("d2")[[1]], gouv_colors("r2")[[1]], gouv_colors("p2")[[1]]) %>%
setNames(c(levels(carto2$typo)[1:3], "Autre"))
viz_pal( pal_typo_groupee)
rm(carto2)
```
# Fonctions
- [x] mise à jour id_aile (intro 4e rmd) --> dans § ref AILE
- [x] regroupe typo AILE (L181 5e rmd) --> dans § ref AILE
- [x] ligne total (intro 5e rmd)
- [x] colonne total (intro 5e Rmd)
- [ ] ordonne intrants (5e Rmd, L152)
```{r}
ligne_tot <- function(df, i, col_gv = "h4"){
row_spec(df, row = i, bold = TRUE, background = gouv_colors(col_gv))
}
col_tot <- function(df, j, col_gv = "h4"){
column_spec(df, column = j, bold = TRUE) #, background = gouv_colors(col_gv)
}
```
```{r ordre intrants}
# ordre des familles
famille_ordre <- palette_famille_intrants %>%
mutate(ordre = row_number()) %>%
left_join(typo_dechets, by = "famille_intrants_court") %>%
select(ordre, Famille_intrants, famille_intrants_court) %>%
distinct() %>%
arrange(ordre)
## Une fonction pour ordonner les tables de données intrants selon l'ordre souhaité pour les familles intrants
ordonne_intrant <- function(table, champ = "Famille_intrants"){
if(grepl("cat", tolower(champ))){
var_ordre <- "num_ordre_cat"
} else if(grepl("srb", tolower(champ))){
var_ordre <- "famille_srb"
} else {
var_ordre <- "ordre_famille"
}
right_join(typo_dechets %>% select(all_of(c(champ, var_ordre))) %>% distinct(), table, by = champ) %>%
arrange(across(all_of(var_ordre))) %>% ## arrange(across(var_ordre))
select(-all_of(var_ordre))
}
```
```{r sauv datamart}
rm(fic_tb_data_comp, viz_pal)
datamart <- setdiff(ls(), params)
save(list = datamart, file = paste0("donnees_ref", params$campagne, ".RData"))
```
---
- [ ] Poster tous les référentiels dans le SGBD
- [ ] Nettoyer et gérer les incidences dans les autres Rmd
1-lecture_des_reponses.Rmd
+ 6
− 60
View file @ aa8594e5
......@@ -189,7 +189,7 @@ fic_isdnd <- regmatches(fic_ods, regexpr("dossiers_.*loire-bilan-annuel-isdnd_.*
sort(decreasing = TRUE) %>% head(1)
fic_metha <- regmatches(fic_ods, regexpr("dossiers_.*loire-bilan-annuel-methanisation_.*\\.ods", fic_ods)) %>%
sort(decreasing = TRUE) %>% head(1)
fic_tb_data_comp <- regmatches(fic_ods, regexpr("donnees_complementaires*\\.ods", fic_ods))[1]
```
......@@ -245,37 +245,7 @@ On charge à cette même occasion les identifiants s3ic et les données de proje
Ces données sont contenues dans l'onglet 'S3IC' de la table de données complémentaire.
Il est constitué par SCTE à partir de la dernière compilation des installations de valorisation du biogaz réalisée par TEO.
```{r chargement ref AILE et fonction maj, warning=FALSE}
# lecture du fichier de données complémentaires, onglets s3ic constitué par SCTE
a_croiser_0 <- read_ods(paste0(repertoire, "/", fic_tb_data_comp), sheet = "s3ic") %>%
mutate(id_aile = as.character(id_aile),
id_aile_new = id_aile) %>%
distinct %>%
separate(id_aile_old, into = c("id_aile_old_1", "id_aile_old_2")) %>%
pivot_longer(cols = c("id_aile_old_1", "id_aile_old_2", "id_aile_new"),
values_to = "id_aile_old") %>%
select(-name) %>%
distinct()
a_croiser <- a_croiser_0 %>%
select(-id_aile_old) %>%
distinct()
tb_psg_id_aile <- select(a_croiser_0, contains("aile"), typo_maj = typologie) %>%
mutate(across(everything(), as.character)) %>%
filter(!is.na(id_aile_old))
maj_id_aile <- function(table, champ = "id_aile", garder_typo = FALSE) {
var_suppr <- c("id_aile_old")
if(!garder_typo) {var_suppr <- c(var_suppr, "typo_maj")}
resultat <- right_join(tb_psg_id_aile, table, by = c("id_aile_old" = champ)) %>%
select(-all_of(var_suppr)) %>%
distinct()
}
rm(a_croiser_0)
```
## Correspondance des champs entre questionnaires
......@@ -679,25 +649,14 @@ La MECC souhaite associer aux réponses de l'enquête des informations issues de
```{r maj id AILE}
compil_reponses <- compil_reponses_0 %>%
left_join(select(a_croiser, id_aile, s3ic, mwh_ep_projet_aile = mwh_primaire, tonnage_projet_aile = Total_tonnage), by = "id_aile") %>%
left_join(select(onglet_s3ic, id_aile, s3ic, mwh_ep_projet_aile = mwh_primaire, tonnage_projet_aile = Total_tonnage),
by = "id_aile") %>%
rename(typo_aile = typo_maj)
rm(a_croiser)
rm(onglet_s3ic)
```
### Régistre des installations de production d'électricité au 31 déc
On charge la table de passage entre les identifiants AILE et ceux du registre électricité, établie à partir de la liste des installations du fichier TEO, et consignée dans l'onglet "reg_elec" de la table de données auxiliaires.
<!-- TODO 2023 : éviter cette étape de copier/coller manuel, cf fichier `r paste0("compilation/tmp/aide_donnees_complementaires_", params$campagne, ".xlsx")` créée ligne 261 du script de réception de la compilation TEO. -->
```{r ajout identifiant registre}
tb_passage_aile_registre <- read_ods(paste0(repertoire, "/", fic_tb_data_comp), sheet = "reg_elec", col_names = TRUE, row_names = FALSE, skip = 0) %>%
mutate(id_aile = as.character(id_aile)) %>%
filter(!is.na(id_aile)) %>%
maj_id_aile("id_aile", garder_typo = FALSE)
```
Lors de l'étape de croisement des sources, Téo a identifié et apparié avec AILE `r nrow(tb_passage_aile_registre)` installations en cogénération dans le registre électricité.
......@@ -869,10 +828,7 @@ n_distinct(intrants_compil0$fic) != sum(tb_psg$fic_intrant_trouve, na.rm = TRUE)
On complète la compilation des réponse intrants en lui adjoignant la nomenclature de référence des intrants, rassemblée dans le tableur de données complémentaires au niveau de l'onglet "intrants_typo".
```{r lecture fichiers intrants2}
# chargement de la typologie des intrants
typo_dechets <- read_ods(paste0(repertoire, "/", fic_tb_data_comp), sheet = "intrants_typo") %>%
# le double espace entre disparaît à la lecture du ficher ?!?
mutate(Categorie_intrants = gsub("grasses (avec produits ", "grasses (avec produits ", Categorie_intrants, fixed = TRUE))
intrants_compil <- intrants_compil0 %>%
select(-code_dechet_aile, -code_dechet_sinoe) %>%
......@@ -1049,11 +1005,6 @@ rm(assemblage, typage_nom_champ)
```
# Chargement de la nomenclature des typologies des installations AILE
```{r}
typo_aile_groupee <- read_ods(paste0(repertoire, "/", fic_tb_data_comp), sheet = "ref_type_install")
```
# Campagne précente : récupération des informations des questions non reposées
......@@ -1222,13 +1173,8 @@ poster_data(injections_mensuelles_compil, table = paste0("injections_mensuelles_
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "id_DS", overwrite = TRUE, droits_schema = TRUE)
poster_data(tb_psg_id_aile, table = paste0("referentiel_aile_", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = c("id_aile", "id_aile_old"), overwrite = TRUE, droits_schema = TRUE)
poster_data(typo_dechets, table = paste0("referentiel_intrants_", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "cat_intr_court", overwrite = TRUE, droits_schema = TRUE)
```
......
2-redressement_reponses.Rmd
+ 10
− 71
View file @ aa8594e5
......@@ -231,6 +231,9 @@ compil_pluriannuelle_intrants <- intrants_redresses %>%
"Boues de station d'épuration urbaine - en tonnes matière sèche", cat_intrant))
)
# Les millésimes d'enquêtes disponibles
mil_disp <- unique(compil_pluriannuelle_intrants$campagne) %>% sort(decreasing = TRUE)
```
## calcul des agrégats par installation
......@@ -326,75 +329,13 @@ compil_reponses_ssRGPD_redr <- compil_reponses_sans_RGPD %>%
# Demandes Nathalie suivi SRB
## Agrégation des familles d'intrants selon nomenclature SRB
### Enrichissement du référentiel des intrants avec les familles SRB
```{r}
typo_dechets_SRB <- typo_dechets %>%
select(-contains("code")) %>%
mutate(num_ordre_cat = row_number(),
famille_srb = c(rep("A", 11), rep("Z", 4), rep("B", 2), rep("C", 5), rep("D", 4), rep("E", 26),
rep("F", 3), rep("G", 4)))
typo_dechets_SRB
poster_data(typo_dechets_SRB, table = paste0("referentiel_intrants_", params$campagne),
schema = "mecc_bilans_metha", db = "production",
post_row_name = FALSE, pk = "cat_intr_court", overwrite = TRUE, droits_schema = TRUE)
```
Ou va la glycérine ? --> avec IAA (E)
### Saisies des objectifs 2030 SRB par famille SRB
```{r}
obj_2030 <- tribble(
~lib_fam_srb, ~obj_2030_tonnes, ~famille_srb, ~gisement_total,
"Effluents d'élevage" , 5310000 , "A" , 22000000 ,
"Ensilage de cultures intermédiaires" , 1000000 , "B" , 3320000 ,
"Résidus de cultures dont issus de silos" , 145000 , "C" , 5323000 ,
"Déchets verts" , 35000 , "D" , 695000 ,
"Industries agro-alimentaires (IAA) + Abattoirs" , 270000 , "E" , 900000 ,
"Assainissement" , 365000 , "F" , 990000 ,
"Déchets organiques fermentescibles" , 70000 , "G" , 215000 ,
"Ensilage de cultures principales" , 0 , "Z", 0
)
obj_2030
```
### Saisies des gisements étude solagro/téo
```{r}
gismts_solagro <- tribble(
~type_gismnt_solagro, ~ agri_or_not, ~tMB_gismt_solagro, ~gsmt_44, ~gsmt_49, ~gsmt_53, ~gsmt_72, ~gsmt_85,
'Industries agro-alimentaires', 'Non agricole', 506029.06, 91549.9842071919, 107103.625677652, 86954.8389686411, 101828.940850351, 118591.667452748,
'Restauration collective + FFOM + Huiles alimentaires usagées', 'Non agricole', 50427.74 + 4677 + 203747, 22372.7111314 + 2180.63716842105 + 82829.2301361387, 10576.4448286 + 936.631357894736 + 38651.73612, 6530.8482796 + 439.733257894737 + 15808.34604, 3481.1299384 + 288.178136842105 + 31413.9546070046, 7465.4205814 + 832.277942105264 + 35043.4594936858,
'Grandes et moyennes surfaces', 'Non agricole', 70096.5, 23107.9, 14595.9, 6117, 11374.3, 14901.4,
'Déchets verts', 'Non agricole', 206419.18, 76431.1225, 36678.8864, 22865.6526, 25737.6451, 44705.86095,
'Fauches de bord de route', 'Non agricole', 68422.05, 16037.0817031836, 15440.4324856043, 8631.15091755341, 12736.6867230023, 15576.7004373233,
'Boues de STEP urbaines', 'Non agricole', 823021.60, 395504.2, 125980.6, 48286.6, 147492.8, 105757.4,
'Fumiers', 'Agricole', 9921535.79, 1543174.9238259, 2129721.73102675, 2213695.65263518, 1193624.35645406, 2841319.11935107,
'Lisiers', 'Agricole', 3253537.28, 659257.177404864, 593064.698038978, 882307.635826431, 605645.163772189, 513262.611406465,
'Fientes', 'Agricole', 4249316.22, 384783.454656448, 785783.600238677, 478591.570806799, 1044574.40772036, 1555583.18425172,
'Résidus de culture dont menue-paille', 'Agricole', 295976.89, 3179.12598470527, 67378.6555059071, 17167.927870519, 140941.431371892, 67309.7485404636,
'Issus de silos', 'Agricole', 60510.12, 8621.52773047976, 11724.5504932977, 13310.6090560535, 12405.4640731522, 14447.9749655294,
'CIVE', 'Agricole', 2844870.99, 392462.3215, 593103.051281818, 589962.518031818, 500055.578068182, 769287.523472727,
'Hors gisements étude TEO Solagro', NA, 0, 0, 0, 0, 0, 0,
)
gismts_solagro
```
## Agrégation des familles d'intrants selon nomenclature SRB et Solagro
### Calculs agrégats SRB
```{r indic group SRB}
indic_suivi_SRB <- typo_dechets_SRB %>%
indic_suivi_SRB <- typo_dechets %>%
select(Famille_intrants, famille_srb) %>%
distinct() %>%
full_join(obj_2030, by = "famille_srb") %>%
......@@ -424,7 +365,7 @@ indic_suivi_SRB
Correspondance SRB / etude solagro
```{r}
incoherences_gpes_SRB_solagro <- typo_dechets_SRB %>%
incoherences_gpes_SRB_solagro <- typo_dechets %>%
left_join(obj_2030) %>%
add_count(type_gismnt_solagro, name = "nb_cat_solagro") %>%
add_count(famille_srb, name = "nb_cat_srb") %>%
......@@ -434,13 +375,11 @@ incoherences_gpes_SRB_solagro <- typo_dechets_SRB %>%
```
## Tableau de suivi fin par catégorie d'intrants
```{r}
typo_dechets_SRB <- typo_dechets_SRB %>%
typo_dechets <- typo_dechets %>%
# Ajout catégorie 2019 'autres bio déchets'
bind_rows(tibble(ordre_famille = 10, domaine_intrants = "Autres",
famille_intrants_court = "Biodéchets", Famille_intrants = "Biodéchets",
......@@ -450,7 +389,7 @@ typo_dechets_SRB <- typo_dechets_SRB %>%
df <- compil_pluriannuelle_intrants %>%
select(campagne, Dep, id_aile, Famille_intrants, cat_intrant, tonnage_total) %>%
left_join(typo_dechets_SRB, by = c("Famille_intrants", "cat_intrant" = "Categorie_intrants"))
left_join(typo_dechets, by = c("Famille_intrants", "cat_intrant" = "Categorie_intrants"))
lignes_cat <- df %>%
group_by(campagne, num_ordre_cat, Famille_intrants, cat_intrant, Dep) %>%
......@@ -463,7 +402,7 @@ lignes_cat <- df %>%
lignes_fam <- lignes_cat %>%
group_by(campagne, Famille_intrants, Dep) %>%
summarise(tonnages_declares = sum(tonnages_declares), .groups = "drop") %>%
left_join(typo_dechets_SRB %>% group_by(Famille_intrants, famille_intrants_court) %>% summarise(num_ordre_fam = min(num_ordre_cat), .groups = "drop" ),
left_join(typo_dechets %>% group_by(Famille_intrants, famille_intrants_court) %>% summarise(num_ordre_fam = min(num_ordre_cat), .groups = "drop" ),
by = "Famille_intrants") %>%
bind_rows(group_by(., campagne, Dep) %>%
summarise(Famille_intrants = "Total", famille_intrants_court = "Total", num_ordre_fam = 999,
......@@ -519,7 +458,7 @@ writexl::write_xlsx(x = list(compil_reponses_ss_RGPD_redresse = compil_reponses_
path = paste0(getwd(), "/compilation/", lubridate::today(), "_indicateurs_intrants_", params$campagne, ".xlsx"))
save(compil_reponses5, compil_reponses_sans_RGPD, typo_dechets_SRB, compil_pluriannuelle_intrants, typo_aile_groupee,
save(compil_reponses5, compil_reponses_sans_RGPD, typo_dechets, compil_pluriannuelle_intrants, typo_aile_groupee, mil_disp,
indic_suivi_SRB, gismts_solagro, obj_2030, suivi_fin, file = paste0("intrants_pour_valo_", params$campagne,".RData"))
```
......
4-intrants_valo.Rmd
+ 18
− 201
View file @ aa8594e5
......@@ -47,182 +47,22 @@ ggplot2::theme_set(gouvdown::theme_gouv(plot_title_size = 12, subtitle_size = 1
plot.margin = margin(t = 0.15, r = 0.15, b = 0.15, l = 0.15, unit = "pt")))
load(paste0("intrants_pour_valo_", params$campagne, ".RData"))
load(paste0("donnees_ref", params$campagne, ".RData"))
intrants_redresses <- filter(compil_pluriannuelle_intrants, campagne == params$campagne ) %>%
select(-campagne)
ligne_tot <- function(df, i, col_gv = "h4"){
row_spec(df, row = i, bold = TRUE, background = gouv_colors(col_gv))
}
# filigrane nom source
filigrane <- paste0("Bilans de fonctionnement biogaz ", params$campagne, " - DREAL Pays de la Loire")
```
# Nomenclatures, ordre et palette
## Familles d'intrants : saisie de la palette de couleurs et des domaines d'intrants (4 modalités)
```{r echo = TRUE, fig.height=2, fig.width=12}
palette_famille_intrants <- tribble(
~famille_intrants_court, ~nom_couleur, ~groupe,
"Effluents d’élevage", "a1", "Effluents d’élevage",
"CIVE", "c2", "Végétaux agricoles",
"Cultures principales", "d1", "Végétaux agricoles",
"Résidus végétaux des exploitations agricoles", "b2", "Végétaux agricoles",
"Déchets végétaux IAA", "b4", "Végétaux non agricoles",
"Déchets verts", "b0", "Végétaux non agricoles",
"Déchets STEP urbaine", "p1", "Autres",
"Déchets animaux IAA", "o0", "Autres",
"Déchets animaux abattoirs", "p2", "Autres",
"Biodéchets", "g2", "Autres",
"Glycérine", "r3", "Autres"
) %>%
mutate(val_couleur = gouv_colors(nom_couleur),
groupe = as_factor(groupe) %>% fct_inorder)
col_fam <- typo_dechets_SRB %>%
arrange(ordre_famille) %>%
select(famille_intrants_court, Famille_intrants) %>%
distinct() %>%
left_join(palette_famille_intrants, by = "famille_intrants_court")
vec_col_famille <- col_fam$val_couleur %>% setNames(col_fam$Famille_intrants)
# ordre des familles
famille_ordre <- palette_famille_intrants %>%
mutate(ordre = row_number()) %>%
left_join(typo_dechets_SRB, by = "famille_intrants_court") %>%
select(ordre, Famille_intrants, famille_intrants_court) %>%
distinct() %>%
arrange(ordre)
# Visualisation de la palette
barplot(rep(1, nrow(palette_famille_intrants)), names.arg = str_wrap(palette_famille_intrants$famille_intrants_court, 3),
col = palette_famille_intrants$val_couleur, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
# # meme chose que
# barplot(rep(1, length(vec_col_famille)), names.arg = str_wrap(names(vec_col_famille), 3),
# col = vec_col_famille, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
# # meme chose que
# barplot(rep(1, nrow(col_fam)), names.arg = str_wrap(col_fam$famille_intrants_court, 3),
# col = col_fam$val_couleur, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
# # meme chose que
# barplot(rep(1, nrow(col_fam)), names.arg = str_wrap(paste(col_fam$nom_couleur, "-" , col_fam$famille_intrants_court), 4),
# col = col_fam$val_couleur, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
```
```{r echo = TRUE, fig.height=2, fig.width=12}
# Visualisation de la palette vec_col_famille
barplot(rep(1, length(vec_col_famille)), names.arg = str_wrap(names(vec_col_famille), 3),
col = vec_col_famille, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
```
## Palette et famille SRB
```{r pal srb, fig.height=2, fig.width=12}
palette_srb <- select(typo_dechets_SRB, famille_intrants_court, famille_srb) %>%
distinct() %>%
left_join(obj_2030 %>% select(contains("_srb")), by = "famille_srb") %>%
left_join(palette_famille_intrants, by = "famille_intrants_court") %>%
# on garde la couleur des 'Déchets animaux IAA' pour les IAA
filter(!(famille_intrants_court %in% c("Déchets végétaux IAA", "Déchets animaux abattoirs", "Glycérine"))) %>%
arrange(famille_srb) %>%
mutate(lib_fam_srb = lib_fam_srb %>% as.factor() %>% fct_inorder) %>%
select(contains("srb"), contains("couleur"))
# Visualisation de la palette
barplot(rep(1, nrow(palette_srb)), names.arg = str_wrap(palette_srb$lib_fam_srb, 3),
col = palette_srb$val_couleur, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.8)
```
```{r pal intrants 4 modalites, fig.height=2, fig.width=12}
col_group <- palette_famille_intrants %>%
filter(!(nom_couleur %in% c("b4", "c2", "d1", "p1"))) %>%
group_by(groupe) %>%
slice(1) %>%
ungroup()
vec_col_group <- col_group$val_couleur %>% setNames(col_group$groupe)
vec_groupe_famille <- c(vec_col_famille, vec_col_group , "white")
rm(col_group, col_fam)
barplot(rep(1, length(vec_col_group)), names.arg = str_wrap(names(vec_col_group), 15),
col = vec_col_group, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.85)
```
## Typologie d'installations regroupées
```{r}
typo_aile <- typo_aile_groupee %>%
rename(typo_aile = typologie,
typo = typologie_regroupee) %>%
bind_rows(data.frame(typo_aile = "Centralisé mono-acteur", typo = "Centralisé")) %>%
mutate(across(everything(), as.factor))
rm(typo_aile_groupee)
typo_aile
```
```{r}
regroupe_typo_aile <- function(table, champ = "typo_aile"){
right_join(typo_aile, table, by = c("typo_aile" = champ)) %>%
select(-typo_aile) %>%
rename(typo_aile = typo) %>%
distinct()
}
```
## Une fonction pour ordonner les tables de données selon l'ordre souhaité pour les familles intrants
```{r}
ordonne_intrant <- function(table, champ = "Famille_intrants"){
if(grepl("cat", tolower(champ))){
var_ordre <- "num_ordre_cat"
} else if(grepl("srb", tolower(champ))){
var_ordre <- "famille_srb"
} else {
var_ordre <- "ordre_famille"
}
right_join(typo_dechets_SRB %>% select(all_of(c(champ, var_ordre))) %>% distinct(), table, by = champ) %>%
arrange(across(var_ordre)) %>%
select(-all_of(var_ordre))
}
# table <- intrants_redresses %>%
# group_by(Famille_intrants) %>%
# summarise(
# Tonnage = sum(tonnage_total) %>% round(0),
# part = round(sum(tonnage_total)/vol_reg*100, 1),
# nb = n_distinct(id_aile), .groups = "drop")
#
# ordonne_intrant(table = table, champ = "Famille_intrants")
```
# 00- Dénombrement des installations ayant déclaré leurs intrants par année
```{r denombrement reg}
mil_disp <- unique(compil_pluriannuelle_intrants$campagne) %>% sort(decreasing = TRUE)
compil_pluriannuelle_intrants %>%
regroupe_typo_aile() %>%
......@@ -361,15 +201,13 @@ indic_suivi_SRB %>%
```{r viz SRB, fig.height=4, fig.width=10}
# vecteur de couleur nommées
vec_col_srb <- palette_srb$val_couleur[c(1:8)] %>% setNames(palette_srb$lib_fam_srb[c(1:8)])
indic_suivi_SRB %>%
filter(famille_srb != "Y") %>% # on enlève le total
select(contains("srb"), contains("tonn")) %>% #names()
pivot_longer(cols = contains("tonn"), names_to = "annee", values_to = "millions de tonnes") %>%
mutate(annee = str_extract(annee, "\\d{4}"), `millions de tonnes` = `millions de tonnes` / 1000000,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb$lib_fam_srb),
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb)),
# les cultures principales doivent être comptées à part
`millions de tonnes` = if_else(famille_srb == "Z", -`millions de tonnes`, `millions de tonnes`)) %>%
ggplot(aes(fill = lib_fam_srb, x = annee, y = `millions de tonnes`)) +
......@@ -391,7 +229,7 @@ indic_suivi_SRB %>%
select(contains("srb"), contains("tonn")) %>% #names()
pivot_longer(cols = contains("tonn"), names_to = "annee", values_to = "millions de tonnes") %>%
mutate(annee = str_extract(annee, "\\d{4}"), `millions de tonnes` = `millions de tonnes` / 1000000,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb$lib_fam_srb),
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb)),
# les cultures principales doivent être comptées à part
`millions de tonnes` = if_else(famille_srb == "Z", -`millions de tonnes`, `millions de tonnes`)) %>%
ggplot(aes(x = annee, y = `millions de tonnes`, fill = annee, color = annee)) +
......@@ -417,7 +255,7 @@ indic_suivi_SRB %>%
mutate(avancement_2030 = 1) %>%
pivot_longer(cols = contains("avancement"), names_to = "annee", values_to = "pourcent") %>%
mutate(annee = str_extract(annee, "\\d{4}"), pourcent = pourcent * 100,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb$lib_fam_srb) %>% fct_rev()) %>%
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb)) %>% fct_rev()) %>%
filter(annee %in% c(params$campagne, "2030")) %>%
ggplot(aes(fill = lib_fam_srb, x = lib_fam_srb, y = pourcent, alpha = annee)) +
geom_bar(stat = 'identity', position = position_dodge(width = 0)) + coord_flip() +
......@@ -441,7 +279,7 @@ interm <- indic_suivi_SRB %>%
mutate(gisement_9999 = 1) %>%
pivot_longer(cols = contains("gisement"), names_to = "annee", values_to = "pourcent") %>% # View
mutate(annee = str_extract(annee, "\\d{4}"), pourcent = pourcent * 100,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb$lib_fam_srb) %>% fct_rev()) %>%
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb)) %>% fct_rev()) %>%
filter(annee %in% c(params$campagne, "9999", "2030"))
ggplot(filter(interm, annee %in% c(params$campagne, "9999")), aes(x = lib_fam_srb, y = pourcent)) +
......@@ -467,7 +305,7 @@ indic_suivi_SRB %>%
mutate(gisement_9999 = 1) %>%
pivot_longer(cols = contains("gisement"), names_to = "annee", values_to = "pourcent") %>% # %>% View
mutate(annee = str_extract(annee, "\\d{4}"), pourcent = pourcent * 100,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb$lib_fam_srb) %>% fct_rev()) %>%
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb)) %>% fct_rev()) %>%
filter(annee %in% c(params$campagne, "9999")) %>%
ggplot(aes(fill = lib_fam_srb, x = lib_fam_srb, y = pourcent, alpha = annee)) +
geom_bar(stat = 'identity', position = position_dodge(width = 0)) + coord_flip() +
......@@ -486,7 +324,7 @@ Comparaison des gisements SRB / SOLAGRO
```{r passage SRB solagro}
comp_srb_solagro <- select(typo_dechets_SRB, contains("solagro"), contains("srb")) %>%
comp_srb_solagro <- select(typo_dechets, contains("solagro"), contains("srb")) %>%
left_join(select(palette_srb, famille_srb, val_couleur)) %>%
left_join(obj_2030) %>%
left_join(gismts_solagro) %>%
......@@ -538,7 +376,7 @@ noms_ter <- nom_zone(type_zone = "Départements", code_zone = list_dep_in_reg(co
gsmt_sol_dep_mil <- expand_grid(Dep = ter, campagne = mil_disp) %>%
cross_join(gismts_solagro %>% rowid_to_column("ordre_solagro"))
indic_suivi_solagro_base <- typo_dechets_SRB %>%
indic_suivi_solagro_base <- typo_dechets %>%
select(cat_intrant = Categorie_intrants, Famille_intrants, type_gismnt_solagro) %>%
distinct() %>%
full_join(gsmt_sol_dep_mil, by = "type_gismnt_solagro") %>%
......@@ -596,26 +434,12 @@ Taux de mobilisation du gisement SOLAGRO : graphiques
```{r viz solagro 1}
palette_solagro <- gismts_solagro %>%
select(type_gismnt_solagro) %>%
left_join(typo_dechets_SRB %>% select(famille_intrants_court, type_gismnt_solagro),
by = "type_gismnt_solagro") %>%
distinct() %>%
filter(type_gismnt_solagro != "Hors gisements étude TEO Solagro") %>%
left_join(palette_famille_intrants, by = "famille_intrants_court") %>%
filter(!grepl("abattoir|végétaux IAA", famille_intrants_court)) %>%
select(type_gismnt_solagro, contains("couleur"))
vec_col_solagro <- palette_solagro$val_couleur %>%
setNames(palette_solagro$type_gismnt_solagro)
interm_solagro <- indic_suivi_solagro_base %>%
filter(campagne == params$campagne, type_gismnt_solagro %in% palette_solagro$type_gismnt_solagro) %>%
filter(campagne == params$campagne, type_gismnt_solagro %in% names(vec_col_solagro)) %>%
select(zone, type_gismnt_solagro, tx_mob_gsmt, gsmt_tmb, tmb_decl = tonnages_declares) %>% #names()
mutate(tx_gsmt_9999 = 100) %>%
pivot_longer(cols = c(contains("gsmt"), contains("tmb")), names_to = "serie", values_to = "valeur") %>%
mutate(type_gismnt_solagro = factor(type_gismnt_solagro, levels = palette_solagro$type_gismnt_solagro) %>%
mutate(type_gismnt_solagro = factor(type_gismnt_solagro, levels = names(vec_col_solagro)) %>%
fct_rev())
creer_taux_mob_solagro_ter <- function(terr = "49", typ = "tx") {
......@@ -642,7 +466,7 @@ map(ter, ~creer_taux_mob_solagro_ter(terr = .x, typ = "tmb"))
```
```{r viz solagro srb}
indic_suivi_solagro <- typo_dechets_SRB %>%
indic_suivi_solagro <- typo_dechets %>%
select(Famille_intrants, famille_srb) %>%
distinct() %>%
full_join(obj_2030, by = "famille_srb") %>%
......@@ -665,13 +489,6 @@ indic_suivi_solagro <- typo_dechets_SRB %>%
arrange(famille_srb)
palette_solagro_srb <- palette_srb %>%
mutate(lib_fam_srb_2 = gsub("Ensilage de c", "C", lib_fam_srb)) %>%
filter(famille_srb != "Z")
vec_col_solagro_srb <- palette_solagro_srb$val_couleur %>%
setNames(palette_solagro_srb$lib_fam_srb_2)
interm_solagro_srb <- indic_suivi_solagro %>%
filter(obj_2030_tonnes != 0, famille_srb != "Y") %>%
mutate(part_obj_2030_gisement = obj_2030_tonnes/gismt_solagro) %>%
......@@ -680,7 +497,7 @@ interm_solagro_srb <- indic_suivi_solagro %>%
pivot_longer(cols = contains("gisement"), names_to = "annee", values_to = "pourcent") %>% # View
mutate(lib_fam_srb = gsub("Ensilage de c", "C", lib_fam_srb)) %>%
mutate(annee = str_extract(annee, "\\d{4}"), pourcent = pourcent * 100,
lib_fam_srb = factor(lib_fam_srb, levels = palette_solagro_srb$lib_fam_srb_2) %>% fct_rev(),
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_solagro_srb)) %>% fct_rev(),
obj_depasse = lag(pourcent) >= pourcent) %>%
filter(annee %in% c(params$campagne, "9999", "2030"))
......@@ -738,7 +555,7 @@ df_reg <- intrants_redresses %>%
group_by(Famille_intrants) %>%
summarise(Tonnage = sum(tonnage_total) %>% round(0)) %>%
mutate(dim = 2) %>%
left_join(select(typo_dechets_SRB, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
left_join(select(typo_dechets, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
ordonne_intrant() %>%
mutate(Famille = fct_inorder(Famille_intrants),
poids = round(Tonnage/sum(Tonnage)*100, 1),
......@@ -797,7 +614,7 @@ intrants_redresses %>%
# ordre des familles
famille_ordre <- palette_famille_intrants %>%
mutate(ordre = row_number()) %>%
left_join(typo_dechets_SRB, by = "famille_intrants_court") %>%
left_join(typo_dechets, by = "famille_intrants_court") %>%
select(ordre, Famille_intrants, famille_intrants_court) %>%
distinct() %>%
arrange(ordre)
......@@ -820,7 +637,7 @@ creer_graph_dep <- function(dep = "44"){
group_by(Famille_intrants) %>%
summarise(Tonnage = sum(tonnage_total) %>% round(0)) %>%
mutate(dim = 2) %>%
left_join(select(typo_dechets_SRB, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
left_join(select(typo_dechets, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
ordonne_intrant() %>%
mutate(Famille = fct_inorder(Famille_intrants),
poids = round(Tonnage/sum(Tonnage)*100, 1),
......@@ -969,7 +786,7 @@ ggplot(df, aes(x = campagne, y = Tonnage, fill = Famille)) +
## Par type d'installation
```{r evol typo aile}
domN_intrants <- select(typo_dechets_SRB, ordre_famille, Famille_intrants, domaine_intrants) %>%
domN_intrants <- select(typo_dechets, ordre_famille, Famille_intrants, domaine_intrants) %>%
arrange(ordre_famille) %>%
distinct() %>%
mutate(domaine_intrants = as.factor(domaine_intrants) %>% fct_inorder)
......@@ -1045,7 +862,7 @@ montrer les catégories au sein de chaque famille : Cultures principales, Cultu
df_zoom_veg <- compil_pluriannuelle_intrants %>%
left_join(famille_ordre, by = "Famille_intrants") %>%
filter(ordre %in% c(2:4)) %>%
left_join(typo_dechets_SRB %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
left_join(typo_dechets %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
group_by(campagne, typo_aile, ordre, num_ordre_cat) %>%
summarise(Famille = first(Famille_intrants), famille_intrants_court = first(famille_intrants_court), cat_intrant = first(cat_intr_court),
Tonnage = sum(tonnage_total, na.rm = TRUE) %>% round(1), nb_inst_decl = n_distinct(id_aile), .groups = "drop") %>%
......@@ -1159,7 +976,7 @@ df_zoom_effluent <- compil_pluriannuelle_intrants %>%
regroupe_typo_aile() %>%
left_join(famille_ordre, by = "Famille_intrants") %>%
filter(ordre == 1) %>%
left_join(typo_dechets_SRB %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
left_join(typo_dechets %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
group_by(campagne, typo_aile, ordre, num_ordre_cat) %>%
summarise(Famille = first(Famille_intrants), famille_intrants_court = first(famille_intrants_court), cat_intrant = first(cat_intr_court),
Tonnage = sum(tonnage_total, na.rm = TRUE) %>% round(1), nb_inst_decl = n_distinct(id_aile), .groups = "drop") %>%
......
5-Rapport.Rmd
+ 12
− 165
View file @ aa8594e5
......@@ -8,7 +8,6 @@ output:
logo: "prefecture_r52"
params:
campagne: "2022"
compil_teo: "croisement_biogaz_teo_20230310"
sgbd_util: "does"
---
......@@ -58,153 +57,20 @@ load(paste0("intrants_pour_valo_", params$campagne, ".RData"))
intrants_redresses <- filter(compil_pluriannuelle_intrants, campagne == params$campagne ) %>%
select(-campagne)
# récupération des dernières données de croisement TEO et filtre sur les en service dans l'année
load(paste0("donnees_ref", params$campagne, ".RData"))
ligne_tot <- function(df, i, col_gv = "h4"){
row_spec(df, row = i, bold = TRUE, background = gouv_colors(col_gv))
}
col_tot <- function(df, j, col_gv = "h4"){
column_spec(df, column = j, bold = TRUE) #, background = gouv_colors(col_gv)
}
# initialisation exports xls
exports_xls <- list()
# filigrane nom source
filigrane <- paste0("Bilans de fonctionnement biogaz ", params$campagne, " - DREAL Pays de la Loire")
# Les millésimes d'enquêtes disponibles
mil_disp <- unique(compil_pluriannuelle_intrants$campagne) %>% sort(decreasing = TRUE)
```
```{r palettes}
# palette et familles
palette_famille_intrants <- tribble(
~famille_intrants_court, ~nom_couleur, ~groupe,
"Effluents d’élevage", "a1", "Effluents d’élevage",
"CIVE", "c2", "Végétaux agricoles",
"Cultures principales", "d1", "Végétaux agricoles",
"Résidus végétaux des exploitations agricoles", "b2", "Végétaux agricoles",
"Déchets végétaux IAA", "b4", "Végétaux non agricoles",
"Déchets verts", "b0", "Végétaux non agricoles",
"Déchets STEP urbaine", "p1", "Autres",
"Déchets animaux IAA", "o0", "Autres",
"Déchets animaux abattoirs", "p2", "Autres",
"Biodéchets", "g2", "Autres",
"Glycérine", "r3", "Autres"
) %>%
mutate(val_couleur = gouv_colors(nom_couleur),
groupe = as_factor(groupe) %>% fct_inorder)
col_fam <- typo_dechets_SRB %>%
arrange(ordre_famille) %>%
select(famille_intrants_court, Famille_intrants) %>%
distinct() %>%
left_join(palette_famille_intrants, by = "famille_intrants_court")
vec_col_famille <- col_fam$val_couleur %>% setNames(col_fam$Famille_intrants)
vec_col_famille_court <- col_fam$val_couleur %>% setNames(col_fam$famille_intrants_court)
palette_srb <- select(typo_dechets_SRB, famille_intrants_court, famille_srb) %>%
distinct() %>%
left_join(obj_2030 %>% select(contains("_srb")), by = "famille_srb") %>%
left_join(palette_famille_intrants, by = "famille_intrants_court") %>%
# on garde la couleur des 'Déchets animaux IAA' pour les IAA
filter(!(famille_intrants_court %in% c("Déchets végétaux IAA", "Déchets animaux abattoirs", "Glycérine"))) %>%
arrange(famille_srb) %>%
mutate(lib_fam_srb = lib_fam_srb %>% as.factor() %>% fct_inorder) %>%
select(contains("srb"), contains("couleur"))
# un sous vecteur de couleur nommées
vec_col_srb <- palette_srb$val_couleur[c(1:8)] %>% setNames(palette_srb$lib_fam_srb[c(1:8)])
col_group <- palette_famille_intrants %>%
filter(!(nom_couleur %in% c("b4", "c2", "d1", "p1"))) %>%
group_by(groupe) %>%
slice(1) %>%
ungroup()
vec_col_group <- col_group$val_couleur %>% setNames(col_group$groupe)
vec_groupe_famille <- c(vec_col_famille, vec_col_group , "white")
rm(col_group, col_fam)
pal_typ_valo <- c("Injection" = gouv_colors("o1")[[1]], "Cogénération" = gouv_colors("f1")[[1]], "Mixte" = gouv_colors("c1")[[1]])
# # Visualisation de la palette
# barplot(rep(1, length(pal_typ_valo)), names.arg = names(pal_typ_valo),
# col = pal_typ_valo, border = NA, axes = FALSE, horiz = FALSE, cex.names = 0.6)
```
```{r ordre intrants}
# ordre des familles
famille_ordre <- palette_famille_intrants %>%
mutate(ordre = row_number()) %>%
left_join(typo_dechets_SRB, by = "famille_intrants_court") %>%
select(ordre, Famille_intrants, famille_intrants_court) %>%
distinct() %>%
arrange(ordre)
## Une fonction pour ordonner les tables de données intrants selon l'ordre souhaité pour les familles intrants
ordonne_intrant <- function(table, champ = "Famille_intrants"){
if(grepl("cat", tolower(champ))){
var_ordre <- "num_ordre_cat"
} else if(grepl("srb", tolower(champ))){
var_ordre <- "famille_srb"
} else {
var_ordre <- "ordre_famille"
}
right_join(typo_dechets_SRB %>% select(all_of(c(champ, var_ordre))) %>% distinct(), table, by = champ) %>%
arrange(across(all_of(var_ordre))) %>%
select(-all_of(var_ordre))
}
# table <- intrants_redresses %>%
# group_by(Famille_intrants) %>%
# summarise(
# Tonnage = sum(tonnage_total) %>% round(0),
# part = round(sum(tonnage_total)/vol_reg*100, 1),
# nb = n_distinct(id_aile), .groups = "drop")
#
# ordonne_intrant(table = table, champ = "Famille_intrants")
```
```{r typo aile regroupee}
## Typologie d'installations regroupées
typo_aile <- typo_aile_groupee %>%
rename(typo_aile = typologie,
typo = typologie_regroupee) %>%
bind_rows(data.frame(typo_aile = "Centralisé mono-acteur", typo = "Centralisé")) %>%
mutate(across(everything(), ~as.factor(.x) %>% fct_inorder()))
regroupe_typo_aile <- function(table, champ = "typo_aile"){
right_join(typo_aile, table, by = c("typo_aile" = champ)) %>%
select(-typo_aile) %>%
rename(typo_aile = typo) %>%
distinct()
}
```
```{r taux reponse}
# récupération des dernières données de croisement TEO et filtre sur les en service dans l'année
nom_fic_teo <- paste0("compil_teo_der_", params$campagne,".RData")
if(file.exists(nom_fic_teo)){
load(nom_fic_teo)
} else {
compil_teo_der <- importer_data(table = params$compil_teo, schema = "mecc_bilans_metha",
db = "production", user = params$sgbd_util)
save(compil_teo_der, file = nom_fic_teo)
}
compil_teo <- compil_teo_der %>%
compil_teo <- compil_teo %>%
filter(statut_agrege == "En service", annee_de_mise_en_service_compil <= params$campagne)
nb_isdnd <- compil_teo %>% filter(grepl("ISDND", typologie_compil)) %>% nrow()
nb_step <- compil_teo %>% filter(grepl("STEP", typologie_compil)) %>% nrow()
......@@ -368,7 +234,7 @@ Elle permet la réduction des émissions de gaz à effet de serre et de l'usage
### La méthanisation est en plein essor en Pays de la Loire
```{r etat filiere campagne + 1}
compil_teo_serv_mil_plus_1 <- compil_teo_der %>% filter(statut_agrege == "En service")
compil_teo_serv_mil_plus_1 <- compil_teo %>% filter(statut_agrege == "En service")
coef_dev <- format_fr_nb(nrow(compil_teo_serv_mil_plus_1) / 52, 1)
```
......@@ -379,12 +245,6 @@ En mars `r params$campagne %>% as.numeric + 1`, `r nrow(compil_teo_serv_mil_plus
carto1 <- compil_teo_serv_mil_plus_1 %>%
select(id_table, nom = nom_structure_compil, com = nom_commune_compil, valo = valorisation_principale_compil, MWh_ep = mwh_primaire_aile)
# mapview(carto1)
pal_carto_1 <- c(gouv_colors("m1")[[1]], gouv_colors("i1")[[1]], gouv_colors("f2")[[1]], gouv_colors("c1")[[1]]) %>%
setNames(c("Chaudière", "Cogénération", "Cogénération et injection", "Injection"))
# viz_pal(pal = pal_carto_1)
carto <- fond_carto(nom_reg = "Pays de la Loire", ombre = 0.00, espace = 0000)
dep_reg <- carto$departements %>%
select(1) %>% # /!\ on présuppose que les codes territoires sont toujours le 1er champ
......@@ -437,11 +297,6 @@ carto2 <- compil_teo_serv_mil_plus_1 %>%
st_as_sf()
pal_carto_2 <- c(gouv_colors("b1")[[1]], gouv_colors("d2")[[1]], gouv_colors("r2")[[1]],
gouv_colors("p2")[[1]], gouv_colors("q1")[[1]]) %>%
setNames(levels(carto2$typo_aile))
# viz_pal(pal = pal_carto_2)
base_gg +
# viz data
geom_sf(data = carto2, aes(fill = typo_aile, color = typo_aile), alpha = .8, shape = 21) +
......@@ -517,9 +372,7 @@ La typologie retenue pour les installations est celle de AILE :
* **ISDND** : installation de stockage de déchets non dangereux - gaz de décharge.
```{r analyse nb reponses graph typo}
pal_typo_groupee <- c(gouv_colors("b1")[[1]], gouv_colors("d2")[[1]], gouv_colors("r2")[[1]], gouv_colors("p2")[[1]]) %>%
setNames(c(levels(carto2$typo_aile)[1:3], "Autre"))
# viz_pal(pal = pal_typo_groupee)
compil_reponses_sans_RGPD <- compil_reponses_sans_RGPD %>%
mutate(Valo_NRJ_long = Valo_NRJ, Valo_NRJ = gsub(" .*$", "", Valo_NRJ))
......@@ -700,7 +553,7 @@ df_camembert <- intrants_redresses %>%
group_by(Famille_intrants) %>%
summarise(Tonnage = sum(tonnage_total) %>% round(5)) %>%
mutate(dim = 2) %>%
left_join(select(typo_dechets_SRB, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
left_join(select(typo_dechets, Famille_intrants, famille_intrants_court) %>% distinct, by = c("Famille_intrants" = "Famille_intrants")) %>%
ordonne_intrant() %>%
mutate(Famille = fct_inorder(Famille_intrants),
poids = round(Tonnage/sum(Tonnage)*100, 1),
......@@ -921,7 +774,7 @@ La somme des tonnages de ces deux familles est du même ordre de grandeur en `r
```{r evol typo aile}
domN_intrants <- select(typo_dechets_SRB, ordre_famille, Famille_intrants, domaine_intrants) %>%
domN_intrants <- select(typo_dechets, ordre_famille, Famille_intrants, domaine_intrants) %>%
arrange(ordre_famille) %>%
distinct() %>%
mutate(domaine_intrants = as.factor(domaine_intrants) %>% fct_inorder)
......@@ -1041,19 +894,13 @@ TODO : un pb de périmètre pour le calcul des totaux
```{r viz SRB, fig.height=4, fig.width=10}
palette_srb_2 <- palette_srb %>%
mutate(lib_fam_srb_2 = gsub("Ensilage de c", "C", lib_fam_srb))
vec_col_srb_2 <- palette_srb_2$val_couleur[c(1:8)] %>%
setNames(palette_srb_2$lib_fam_srb_2[c(1:8)])
indic_suivi_SRB %>%
filter(famille_srb != "Y") %>% # on enlève le total
select(contains("srb"), contains("tonn")) %>% #names()
mutate(lib_fam_srb = gsub("Ensilage de c", "C", lib_fam_srb)) %>%
pivot_longer(cols = contains("tonn"), names_to = "annee", values_to = "millions de tonnes") %>%
mutate(annee = str_extract(annee, "\\d{4}"), `millions de tonnes` = `millions de tonnes` / 1000000,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb_2$lib_fam_srb_2),
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb_2)),
# les cultures principales doivent être comptées à part
`millions de tonnes` = if_else(famille_srb == "Z", -`millions de tonnes`, `millions de tonnes`)) %>%
ggplot(aes(fill = lib_fam_srb, 40 , x = annee, y = `millions de tonnes`)) +
......@@ -1129,7 +976,7 @@ interm <- indic_suivi_SRB %>%
pivot_longer(cols = contains("gisement"), names_to = "annee", values_to = "pourcent") %>% # View
mutate(lib_fam_srb = gsub("Ensilage de c", "C", lib_fam_srb)) %>%
mutate(annee = str_extract(annee, "\\d{4}"), pourcent = pourcent * 100,
lib_fam_srb = factor(lib_fam_srb, levels = palette_srb_2$lib_fam_srb_2) %>% fct_rev(),
lib_fam_srb = factor(lib_fam_srb, levels = names(vec_col_srb_2)) %>% fct_rev(),
obj_depasse = lag(pourcent) >= pourcent) %>%
filter(annee %in% c(params$campagne, "9999", "2030"))
......@@ -1488,7 +1335,7 @@ méthaniseur, et parmi eux, `r irrigation[1, "n"][[1]]` (`r irrigation[1, "prop"
df_zoom_veg_dep <- compil_pluriannuelle_intrants %>%
left_join(famille_ordre, by = "Famille_intrants") %>%
filter(ordre %in% c(2:4)) %>%
left_join(typo_dechets_SRB %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
left_join(typo_dechets %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
group_by(campagne, typo_aile, ordre, num_ordre_cat, Dep) %>%
summarise(Famille = first(Famille_intrants), famille_intrants_court = first(famille_intrants_court), cat_intrant = first(cat_intr_court),
Tonnage = sum(tonnage_total, na.rm = TRUE), nb_inst_decl = n_distinct(id_aile), .groups = "drop") %>%
......@@ -1752,7 +1599,7 @@ df_zoom_effluent <- compil_pluriannuelle_intrants %>%
regroupe_typo_aile() %>%
left_join(famille_ordre, by = "Famille_intrants") %>%
filter(ordre == 1) %>%
left_join(typo_dechets_SRB %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
left_join(typo_dechets %>% select(cat_intrant = Categorie_intrants, cat_intr_court, num_ordre_cat), by = "cat_intrant") %>%
group_by(campagne, typo_aile, ordre, num_ordre_cat) %>%
summarise(Famille = first(Famille_intrants), famille_intrants_court = first(famille_intrants_court), cat_intrant = first(cat_intr_court),
Tonnage = sum(tonnage_total, na.rm = TRUE) %>% round(1), nb_inst_decl = n_distinct(id_aile), .groups = "drop") %>%
......@@ -1944,7 +1791,7 @@ options(knitr.kable.NA = '')
## Utilisation des libellés intrants court
suivi_fin_kable <- suivi_fin %>%
left_join(typo_dechets_SRB %>% select(Categorie_intrants, cat_intr_court),
left_join(typo_dechets %>% select(Categorie_intrants, cat_intr_court),
by = c("cat_intrant" = "Categorie_intrants")) %>%
mutate(cat_intrant = coalesce(cat_intr_court, cat_intrant))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment