---
title: "Subventions pour remplacement d'un chauffage à combustible fossile ou électrique"
lang: fr
subtitle: "Nombre de subventions et montants demandés, promis et payés, Vaud"
author: "DGE-DIREN"
date: last-modified # Renvoie automatiquement la date de dernière modification du .qmd
params: # ! `open_params_metadata_help()` pour des instructions de remplissage détaillées
fonction: 1 # Valeur numérique : 0=Non-défini/1=Description/2=Orientation/3=Pilotage
nature: 1 # Valeur numérique : 0=Non-défini/1=Actions/2=Effets/3=Impacts
idThematique: 08.05.03.04 # Identifiant selon nomenclature obsind theme/sous-theme/objet/id (p.ex. 08.03.01)
niveauPublication: 2 # Valeur numérique : 0=Non-défini/1=Interne/2=Public. Tout autre choix génère un avertissement
niveauDetail: Subvention # Texte libre qui indique le niveau minimal d'agrégation disponible pour l'indicateur (canton, commune, région, installation, véhicule, etc.)
frequenceMAJ: Annuel # Texte libre, idéalement à choisir parmi les codes suivants : mensuel/semestriel/annuel/biannuel/mensuel/tous les x ans/non-défini
moisMAJ: 2 # Valeur numérique : 0=Non-défini/1=Janvier/2=Février, etc.
disponibleDepuis: 2017 # Valeur numérique Année (aaaa) (p.ex. 2000)
personneReference: Steve Ducommun # Prénom+Nom de la personne référente de l'indicateur
mailReference: stat.energie@vd.ch # E-mail ACV (générique ou nominal, se terminant par @vd.ch)
uuid: 5bd4863d-b598-42f2-956d-3263bde5037d # !NE PAS MODIFIER! Identifiant unique généré automatiquement à la création de la fiche
uuidParent: null # Identifiant(s) unique(s) des indicateurs parents de l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
uuidEnfant: null # Identifiant(s) unique(s) des indicateurs enfants de l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
uuidConnexe: null # Identifiant(s) unique(s) des indicateurs connexes à l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
majCatalogue: 1 # Valeur numérique : 0=Non/1=Oui pour mettre à jour les métadonnées dans le catalogue des indicateurs (connexion au disque partagé ObsInd requise)
format:
html:
other-links: # Copier la structure ci-dessous pour remplacer/ajouter d'autres liens sous la table des matières
- text: Infos statistiques énergie
href: 'https://www.vd.ch/environnement/energie/chiffres-cles-et-statistiques-energie-vaud/'
target: '_blank'
- text: Profil climatique communes
href: 'https://stat-climat-vd.ch/profil-climat/'
target: '_blank'
- text: Direction de l'énergie
href: 'https://www.vd.ch/djes/dge/dge-diren'
target: '_blank'
metadata-files: # Ne pas supprimer !
- assets/format-options.yml
editor_options:
chunk_output_type: console
---
<!-- Les métadonnées ci-dessus doivent être remplies pour chaque fiche. Lorsqu'un champ n'est disponible, il est possible d'écrire "" ou NULL -->
<!-- Aide au remplissage : `obsindVD::open_aide_remplissage_help()` (lancer la ligne de code dans la console) -->
```{r setup}
#| echo: false
#| warning: false
#| message: false
#| results: asis
# version: 1.2.2 (01.09.2026)
# -----------------------------------------------------------------------------
# Ne rien modifier dans ce bloc de code !
# Ce bloc doit être lancé pour charger les métadonnées dans l'environnement !
# -----------------------------------------------------------------------------
# update_model_setup_code() pour mettre à jour ce bloc avec la version du dernier modèle
# Chargement (ou installation) des librairies disponibles sur CRAN
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, readxl, glue, gt, DT, ggiraph, scales, ggtext)
# Chargement de la librairie obsindVD privée
# Pour l'installation : suivre les instructions dans le BitBucket : https://dsigit.etat-de-vaud.ch/outils/git/projects/DGE/repos/obsind/
# Si l'accès n'est pas autorisé, faire une demande à l'Observatoire des indicateurs
library(obsindVD)
# Par défaut : ouvrir l'aide obsindVD (supprimer cette ligne si superflu)
open_fiche_quarto_help()
# Vérifie, ajoute et insère des valeurs par défaut pour les métadonnées manquantes (en-tête YAML)
complete_metadata_params()
# Extraction + validation des métadonnées (en-tête YAML)
selected_metadata <- return_selected_metadata()
# Ajout de l'identifiant dans les en-têtes du document html
display_identifiant(value = selected_metadata[['Identifiant thématique']])
```
::: {.callout-tip .narrow icon="false" collapse="true"}
# Métadonnées de l'indicateur
```{r}
# --------------------------------------
# Présentation des métadonnées ----
# --------------------------------------
tidyr::tibble(
`Attribut` = names(selected_metadata),
`Valeur` = selected_metadata
) |>
gt_table_ind()
```
:::
```{r}
# Préciser la dernière année pour laquelle les données sont complètes
an <- 2025
```
```{r}
# ---------------------------------------------------------
# Tableau de synthèse ----
# ---------------------------------------------------------
# Pour de l'aide sur comment remplir ce tableau de synthèse lancer la commande suivante dans la console :
# obsindVD::open_tableau_synthese_help()
# Pour afficher l'aide spécifique à une fonction, ajouter '?' avant l'appel de la fonction :
# ?icon_up()
tableau_synthese <- list(
# Premier indicateur... attention à la structure !
list(
titre_indicateur = "Subventions octroyées annuellement pour le remplacement d'un chauffage à combustible fossile ou électrique, Vaud <b>[nbre]</b>",
valeur_2025 = 1419,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA,
obj_2050 = "...",
tendance_observée = icon_down(type = "trend", text = paste0("2019-", an)), # icon_up(), icon_flat(), icon_down()
tendance_évaluée = "..." # icon_meh() # icon_happy(), icon_meh(), icon_sad()
),
# Second indicateur... Répliquer la même structure autant de fois que d'indicateurs à afficher dans le tableau de synthèse
list(
titre_indicateur = "Montants des subventions octroyées annuellement pour le remplacement d'un chauffage à combustible fossile ou électrique, Vaud <b>[Mio CHF]</b>",
valeur_2025 = 17.9,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA, # icon_up(type = "obj"), # On peut modifier 'Cible non chiffrée' en modifiant l'argument text = "" par exemple pour ne rien afficher
obj_2050 = "...",
tendance_observée = icon_down(type = "trend", text = paste0("2019-", an)), # text obligatoire pour type = 'trend'
tendance_évaluée = "..." # icon_happy(tooltip = "Exemple d'info-bulle personnalisé") # 'tooltip' modifie l'info-bulle par défaut
)
)
# Impression du tableau de synthèse
print_tableau_synthese(tableau_synthese) # Le résultat peut être customisé comme un objet {gt}
```
# Description {#sec-description}
Cet indicateur renseigne à la fois sur le nombre de projets et sur les montants pour lesquels le Canton de Vaud s’est engagé à octroyer des subventions en vue du remplacement d’un système de chauffage à combustible fossile (mazout ou gaz) ou d’un chauffage électrique. Des subventions du [Programme Bâtiments](https://www.vd.ch/environnement/energie/subventions-programme-batiments) soutient le remplacement du chauffage par des solutions à base d’énergies renouvelables (bois, pompe à chaleur) ou par un raccordement à un réseau de chauffage.
# Cadre de référence {#sec-cadre-reference}
Les objectifs de réduction de la consommation d’énergies sont définis dans la Conception cantonale de l’énergie ([CoCEn 2019](https://www.vd.ch/fileadmin/user_upload/themes/environnement/energie/fichiers_pdf/CoCEn_Pub_complete_20190816.pdf)), dont un des cadres est la loi fédérale sur la réduction des émissions de CO<sub>2</sub> ([RS 641.71](https://www.lexfind.ch/fe/fr/tol/26489/versions/261035/fr)).
# Graphique {#sec-graphique}
```{r, echo=FALSE, message=FALSE, warning=FALSE, results='hide'}
# ---------------------------------------------------------
# Préparation des données à partir des données brutes
# ---------------------------------------------------------
# Reprendre le même code que pour la fiche IND_08.05.03.01_Subventions_Batiments
# S'assurer que utilsDIREN est installée
# remove.packages("utilsDIREN") # (si message erreur <utilsDIREN.rdb is corrupt>)
devtools::install("P:/DIREN/11 POLITIQUE ENERG/11.08 Indicateurs et stat/0_R_packages_DIREN/utilsDIREN")
## format ----
# source("P:\\DIREN\\11 POLITIQUE ENERG\\11.08 Indicateurs et stat\\14 Scripts génériques R\\format_variables.R", encoding = "UTF-8")
utilsDIREN::load_format_variables()
# Vérifier que l'objet est bien importé
if(!exists("mesures_pb")){
message("L'objet 'mesures_pb' n'existe pas, vérifier blablabla")
}
expected_domaines <- c("Mesures indirectes", "Isolation thermique",
"Technique du bâtiment", "Rénovation de systèmes", "Construction neuve",
"Chauffage centralisé")
actual_domaines <- mesures_pb |> distinct(MESURE_DOMAINE) |> pull(MESURE_DOMAINE)
if(length(setdiff(expected_domaines, actual_domaines))>0){
stop("Les domaines de 'mesures_pb' attendus ne correspondent pas à ce qui est observé")
}
# load data ----
# Idéalement voir si on peut utiliser le "find_latest_date_file". Sinon, pas grave on changera à chaque fois manuellement
pb_file <- utilsDIREN::find_latest_date_file(
dir = "P:/DIREN/02 PILOTAGE DIREN/02.11 Bases de donnees/PROGRAMME_BATIMENTS/04_extractions_traitees/",
type = "files",
file_pattern = "^PB_API_2017-01-01",
date_type = "date"
)
pb_read <- read_xlsx(pb_file) |>
janitor::clean_names(case="screaming_snake") |>
# Exclure les mesures concernant la mobilité (VD1) et les VD2
filter(!MESURE %in% c("VD1", "VD2")) |>
# Changer des noms de variables
# Promesses => ANNEE_BUDGET_PROMESSE (car cohérent avec IWF)
# Paiements => ANNEE_DECISION_PAIEMENT (car cohérent avec année où les travaux ont été payés (et non budgetisés))
rename(ANNEE_PROMESSE = ANNEE_BUDGET_PROMESSE, ANNEE_PAIEMENT = ANNEE_DECISION_PAIEMENT )
# prepare data ----
# Créer une colonne DEMANDE où il y a un "1" partout (demandes transmises à la DIREN)
pb_prep <- pb_read |>
# Rajout de "NA" pour tous les montants des demandes de subvention (sinon ça bloque car il n'y a pas de telle variable)
mutate(MONTANT_IMPORT = NA) |>
# Créer une colonne IMPORT où il y a un "1" partout (demandes transmises à la DIREN)
mutate(IMPORT = 1) |>
# Nouvelle variable AE_APRES_TRAD
# Traduction des ae informés dans la base données PB
mutate(AE_APRES_TRAD = case_when(
AE_APRES %in% c("holz") ~ "Bois-Pellets",
AE_APRES %in% c("wpl", "wps", "wpw") ~ "PAC",
AE_APRES %in% c("wn") ~ "CAD",
ID %in% c("VD-25-1713-IP19", "VD-25-2639-IP19", "VD-25-4438-IP19", "VD-25-5356-IP19", "VD-25-4649-IP19") ~"PAC", # Cas de IP19 qui avaient électricité comme AE_APRES. Après vérification par ASL, c'est CAD
TRUE ~ AE_APRES
)) |>
# mutate(AE = case_when(
# AE_allemand %in% c("eledezent", "eledez") ~ "Chauffage électrique décentralisé",
# AE_allemand == "elezent" ~ "Chauffage électrique centralisé",
# AE_allemand == "oel" ~ "Chauffage au mazout",
# AE_allemand == "gas" ~ "Chauffage à gaz",
# AE_allemand %in% c("wp", "sole", "wasser", "umwelt", "wps", "wpl", "wpw") ~ "Pompe à chaleur", # we are more specific after with M05/M06
# AE_allemand == "wn" ~ "Raccordement à un réseau de chaleur",
# AE_allemand %in% c("pellets", "holz", "stueck", "pellet", "schnitzel") ~ "Chauffage au bois",
# AE_allemand %in% c("abwaerme", "sonst", "and") ~ "Autre",
# .default = NA
# Nouvelle variable AE_APRES_NEW
# Pour près de la moitié des subventions M2 à M07, l'agent énergétique après manque. On déduit donc l'agent énergétique d'après la subvention
mutate(AE_APRES_NEW = case_when(
MESURE %in% c("M02", "M03","M04","IP04") ~ "Bois-Pellets",
MESURE %in% c("M05", "M06", "IP05", "IP06") ~ "PAC",
MESURE %in% c("M07", "IP07") ~ "CAD",
TRUE ~ AE_APRES_TRAD
))
## Integrate Domaine de mesures ----
mesures_pb <- mesures_pb |>
select(MESURE, MESURE_TRAD, MESURE_DOMAINE)
pb <- pb_prep |>
left_join(mesures_pb, join_by(MESURE))
### Ordrer les mesures ----
fct_trad_mesure <- c("Isolation thermique","Technique du bâtiment",
"Rénovation de systèmes", "Construction neuve", "Chauffage centralisé", "Mesures indirectes")
pb <- pb |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure))
### Créer MONTANT_PROMESSE_EGID et MONTANT_PAIEMENT_EGID pour tenir compte du nombre d'EGID concernés par une subvention
### Chaque ligne correspond à un EGID (et non pas subvention)
# pb <- pb |>
# separate_rows(EGID, sep = ";") |>
# mutate(EGID = trimws(EGID)) |>
# group_by(ID) |>
# mutate(nb_EGID = n()) |>
# ungroup() |>
# mutate(MONTANT_PAIEMENT_EGID = MONTANT_PAIEMENT / nb_EGID,
# MONTANT_PROMESSE_EGID = MONTANT_PROMESSE / nb_EGID)
# function ----
prepare_pb_statistics <- function(data, var_type){
## sélection des années concernées ----
data <- data |>
filter(.data[[paste0("ANNEE_", var_type)]]<=an)
###########################################
# mesures_total (Nombre et Montants) ----
###########################################
# Nombre de subventions
mesures_nombre <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(NOMBRE = n()) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = NOMBRE)|>
mutate(TYPE = "Subventions_Nombre")
# Montants des subventions
mesures_montants <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT)|>
mutate(TYPE = "Subventions_Montants")
# Montants médians des subventions
mesures_median <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT_MEDIAN)|>
mutate(TYPE = "Subventions_Median")
# Montants médians totaux
median_tot <- data |>
filter(.data[[var_type]]==1) |>
group_by(MESURE_DOMAINE) |>
summarise(MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT_MEDIAN)|>
mutate(TYPE = "Subventions_Median_total")
# Lier N et Montants
mesures_total <- mesures_nombre |> bind_rows(mesures_montants, median_tot, mesures_median)
# output_2 <- data |>
# dplyr::filter(.data[[var_type]]==1) |>
# dplyr::group_by(.data[[paste0("ANNEE_", var_type)]]) |>
# dplyr::summarise(
# n = n(),
# MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)
# ) |>
# mutate(TYPE = paste0(var_type, "_OUTPUT_2"))
# output <- mesures |> bind_rows(output_2)
##################################################
# renov : partielle et globale ----
##################################################
# Rénovations partielles : Mesure M01 (Façade, toit, …) sans Bonus (M14 ou M15)
# Il s'agit donc de prendre les M01 qui ne font pas partie de la liste des EGID ayant reçu un bonus
# Rénovation globale:
# - M01 en combinaison avec M14 ou M15 (ou IP14 depuis 2025)
# - M12 ou M13
# DF par types de mesures
m01 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE == "M01")
m1213 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M12", "M13"))
m1415 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c( "M14", "M15","IP14"))
# Listes par types de mesures
liste_m01 <- m01 |>
pull(EGID)
liste_m1415 <- m1415 |>
pull(EGID)
# M01 sans bonus M14 ou M15
m01_sans_m1415 <- m01 |>
filter(!EGID %in% liste_m1415)
# M1415 AVEC M01
m1415_avec_m01 <- m1415 |>
filter(EGID %in% liste_m01)
# M01 avec bonus M14 ou M15
m01_avec_m1415 <- m01 |>
filter(EGID %in% liste_m1415)
# renov_partielle
renov_partielle <- m01_sans_m1415 |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_PARTIELLE")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_partielle_total <- m01_sans_m1415 |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_PARTIELLE_TOTAL")
# renov_globale
# Rénovations globales: Mesures M12 (minergie), M13 (CECB), M01+M14 (Bonus rénovation complète), M01+M15 (Bonus Minergie)
# lier les deux files qui contiennent les rénovation globales (m01_avec_m1415 et m1415_avec_m01)
renov_glob_temp <- m01_avec_m1415 |>
bind_rows (m1415_avec_m01)
renov_glob_temp <- renov_glob_temp |>
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
ungroup()
renov_globale <- renov_glob_temp |>
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(NOMBRE = n(),
MONTANT = sum(MONTANT_EGID, na.rm = T),
MONTANT_MEDIAN = median(MONTANT_EGID, na.rm = T)) |>
mutate(TYPE = "RENOV_GLOBALE")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_globale_total <- renov_glob_temp |>
summarise(!!col_annee := 9999 ,
NOMBRE = n(),
MONTANT = sum(MONTANT_EGID, na.rm = T),
MONTANT_MEDIAN = median(MONTANT_EGID, na.rm = T)) |>
mutate(TYPE = "RENOV_GLOBALE_TOTAL")
# renov totale (partielle ou globale)
renov_tot_temp <- m01_sans_m1415 |> # renov_partielle
bind_rows (m01_avec_m1415, m1415_avec_m01) # renov_globale
renov_tot <- renov_tot_temp |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_TOT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_tot_total <- renov_tot_temp |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_TOT_TOTAL")
# Lier toutes les tables renov
renov <- renov_tot_total |> bind_rows(renov_tot, renov_partielle_total, renov_partielle, renov_globale_total, renov_globale)
# renov <- renov_partielle_total |> bind_rows( renov_partielle, renov_globale_total, renov_globale)
#########################################
# rempl_syst : Remplacements de chaudières ----
# Remplacement GAZ, MAZOUT et ELECTRICITE
##########################################
# Total (Gaz, Mazout ou Electricité)
######
rempl_tot <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("gas", "oel", "elezent", "eledezent", "eledez" ) ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_TOT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_tot_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("gas", "oel", "elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_TOT_TOTAL")
# GAZ
######
rempl_gaz <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "gas" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_GAZ")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_gaz_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "gas" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_GAZ_TOTAL")
# MAZOUT
########
rempl_mazout <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_MAZOUT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_mazout_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_MAZOUT_TOTAL")
# ELECTRICITE
#############
rempl_elec <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_ELEC")
# group_by(.data[[paste0("ANNEE_", var_type)]]) |>
# summarise(NOMBRE = n(),
# MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
# MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
# mutate(TYPE = "REMPLACEMENT_ELEC")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_elec_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_ELEC_TOTAL")
# Lier GAZ, MAZOUT et ELECTRIC
rempl_syst <- rempl_tot_total |> bind_rows(rempl_tot, rempl_gaz_total, rempl_gaz, rempl_mazout_total, rempl_mazout, rempl_elec_total, rempl_elec)
#######################################################################################################
# ae_apres_chgt ----
# Agent énergétique qui remplace GAZ, MAZOUT et ELECTRICITE
# Mesures M02-04 IP04 (Bois), M05-06 IP05-06 (PAC) et M07 IP07 (CAD)
# IP19 retirés car certains pourraient ne pas concerner un chgt de chauffage
#######################################################################################################
# GAZ
ae_apres_gaz <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19"), AE_AVANT == "gas") |>
distinct(EGID,.data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_GAZ")
# MAZOUT
ae_apres_mazout <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel") |>
distinct(EGID, .data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_MAZOUT")
# MAZOUT
ae_apres_elec <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19"), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
distinct(EGID, .data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_ELEC")
# Lier GAZ, MAZOUT et ELECTRIC
ae_apres_chgt <- ae_apres_gaz |> bind_rows(ae_apres_mazout, ae_apres_elec)
#######################################################################################################
# cecb_plus : Audits énergétiques ----
#######################################################################################################
# Subventions pour des CECB+ (Code = IM07)
cecb_plus_temp <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("IM07")) |>
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(NOMBRE = n(),
MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
mutate(TYPE = "CECB_PLUS")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
cecb_plus_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("IM07")) |>
summarise(!!col_annee := 9999 ,
NOMBRE = n(),
MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
mutate(TYPE = "CECB_PLUS_TOTAL")
# Lier les deux
cecb_plus <- cecb_plus_total |> bind_rows(cecb_plus_temp)
#######################################################################################################
# Préparation pour file Excel ----
list_objets <- list("mesures_total" = mesures_total,
"renov" = renov,
"rempl_syst" = rempl_syst,
"ae_apres_chgt" = ae_apres_chgt,
"cecb_plus" = cecb_plus
)
writexl::write_xlsx(list_objets, glue("./data/Subventions_{var_type}.xlsx"))
list_objets
}
file_type <- c("PAIEMENT", "PROMESSE", "IMPORT")
purrr::walk(.x = file_type, .f = \(type) prepare_pb_statistics(data = pb, var_type = type))
stats_pb <- purrr::map(
setNames(file_type, file_type),
\(type) prepare_pb_statistics(data = pb, var_type = type)
)
# names(stats_pb) <- file_type
#
#
# datatable(stats_pb$PAIEMENT$mesures_total)
```
```{r }
#| label: fig-G1
##| fig-cap: "Subventions octroyées pour remplacement d'un chauffage à combustile fossile ou électrique, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G1 - Subventions promises pour rénovation globale ou partielle du bâtiment, Vaud
#_______________________________________________________
promesses_total <- stats_pb$PROMESSE$rempl_syst |>
filter(TYPE == "REMPLACEMENT_TOT") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
mutate(ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(NOMBRE_CUMULE = cumsum(NOMBRE)) |>
select(ANNEE, NOMBRE, NOMBRE_CUMULE)
# valeur du dernier NOMBRE_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul <- promesses_total |>
filter(ANNEE == an)
##########################################################
# Coefficient
coef <- min(promesses_total$NOMBRE, na.rm = TRUE) /
(0.14*max(promesses_total$NOMBRE_CUMULE, na.rm = TRUE))
g1_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses_total,
aes(x = ANNEE, y = NOMBRE, fill = "REMPLACEMENT_TOT",
tooltip = paste("Subventions pour remplacement d'un chauffage fossile ou électrique ", ANNEE, " : ", label_number(accuracy = 1, big.mark = "'")(NOMBRE)),
data_id = paste(ANNEE, "annuel")),
width = 0.7,
# position = "stack",
color = NA
) +
# Ajout du total sur les stack
geom_text(
data = promesses_total,
inherit.aes = FALSE,
aes(
x = ANNEE,
y = NOMBRE,
label = label_number(accuracy = 1, big.mark = "'")(NOMBRE)
),
vjust = -0.5,
size = 3
) +
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
label = scales::label_number(big.mark = "'")(NOMBRE_CUMULE)
),
hjust = 0.1, # décale à gauche
vjust = 2, # décalé vers le haut
size = 3.5,
color = "red"
#,
# fontface = "bold"
)+
# lignes pour TOTAL_CUMULE
geom_line_interactive(
data = promesses_total,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
color = "Cumul",
group = 1
),
linewidth = 1.1
) +
geom_point_interactive(
data = promesses_total,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
color = "Cumul",
tooltip = paste(
"Total cumulé des subventions pour remplacement d'un chauffage fossile ou électrique ",
ANNEE, " : ",
scales::label_number(big.mark = "'")(NOMBRE_CUMULE)
)
,
data_id = paste(ANNEE, NOMBRE_CUMULE, "cumul_pt")
),
size = 2
)+
# Colors
scale_fill_manual(
values = c(
"REMPLACEMENT_TOT" = "#1b9e77"),
labels = c(
"REMPLACEMENT_TOT" = "Subventions promises\nannuellement")
) +
scale_color_manual(
values = c("Cumul" = "red"),
labels = c("Cumul" = "Nombre cumulé\nde subventions")
)+
# Titles and caption
scale_y_continuous(
name = "Nombre de subventions annuelles",
sec.axis = sec_axis(~ . / coef, name = "Nombre cumulé de subventions")
) +
scale_x_discrete()+
# scale_x_continuous(breaks = sort(unique(promesses$ANNEE)))+
labs(
title = str_wrap("**Subventions promises pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Subventions annuelles en nombre [nbre]",
fill = NULL,
color = NULL,
caption = "Source: IWF / DGE-DIREN<br>Etat au 31.12.2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_markdown(face = "bold", size = 12),
plot.subtitle = element_markdown(size = 10),
plot.caption = element_markdown(hjust = 0, size = 9, margin = margin(t = 5), face = "italic"), # rajout italic
plot.caption.position = "plot",
plot.margin = margin(10, 10, 30, 10),
legend.position = "bottom", # "top" "left" "right" "none"
legend.box = "horizontal", #"horizontal"
legend.box.just = "left", # aligne les blocs à gauche
legend.justification = "left",
legend.text = element_markdown(size = 10),
legend.title = element_markdown(size = 12),
legend.spacing.y = unit(0.1, "cm"), # espace entre blocs
legend.margin = margin(t = 0, b = 0), # supprime marge globale
legend.box.spacing = unit(0.1, "cm"), # espace bloc-légende vs reste du plot
axis.text = element_text(size = 8),
axis.title = element_markdown(size = 10)
)
obsindVD::girafe_light(g1_plot,
# Ajout de la transparence aux éléments non-survolés !
options = list(
opts_hover_inv(css = "opacity:0.5;"),
opts_hover(css = "opacity:1;"),
# Ajout du nom du PNG téléchargé + remplacement de 'download' par 'télécharger' (survol icône)
opts_toolbar(
position = "topright",
hidden = c("zoom", "selection"),
pngname = paste0(selected_metadata[['Identifiant thématique']], "_G1"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g1_Subventions_Remplacement_Chauffages_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G2
##| fig-cap: "Agents énergétiques remplacés grâce à subventions, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G2 - Agents énergétiques remplacés grâce à subventions, Vaud
#_______________________________________________________
promesses_chgt <- stats_pb$PROMESSE$rempl_syst |>
filter(ANNEE_PROMESSE != 9999 & TYPE != "REMPLACEMENT_TOT" )|>
mutate(
ANNEE = factor(ANNEE_PROMESSE),
TYPE = case_when(
TYPE == "REMPLACEMENT_GAZ" ~ "Gaz",
TYPE == "REMPLACEMENT_MAZOUT" ~ "Mazout",
TYPE == "REMPLACEMENT_ELEC" ~ "Electricité",
TRUE ~ TYPE),
TYPE = factor(
TYPE,
levels = c("Gaz", "Mazout", "Electricité")
)) |>
select(ANNEE, NOMBRE, TYPE) |>
arrange(ANNEE)
g2_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses_chgt,
aes(x = ANNEE, y = NOMBRE, fill = TYPE, group = TYPE,
tooltip = paste("Subventions pour remplacement d'un ", TYPE, ANNEE, ":", label_number(accuracy = 1, big.mark = "'")(NOMBRE)),
data_id = paste(ANNEE, TYPE, "annuel")),
width = 0.7,
position = "dodge",
color = NA
) +
# Ajout de la valeur
geom_text(
data = promesses_chgt,
inherit.aes = FALSE,
aes(
x = ANNEE,
y = NOMBRE,
label = label_number(accuracy = 1, big.mark = "'")(NOMBRE),
group = TYPE
),
position = position_dodge(width = 0.7),
vjust = -0.5,
size = 2
) +
# Colors
scale_fill_manual(
values = c(
"Gaz" = "#6a8caf",
"Mazout" = "#c78a92",
"Electricité" = "#f0d47a"
)
) +
# Titles and caption
scale_y_continuous(
name = "Nombre de subventions annuelles"
) +
scale_x_discrete()+
# scale_x_continuous(breaks = sort(unique(promesses$ANNEE)))+
labs(
title = str_wrap("**Anciens chauffages à combustible fossile ou électrique remplacés grâce aux subventions, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Subventions en nombre [nbre]",
fill = NULL,
color = NULL,
caption = "Source: IWF / DGE-DIREN<br>Etat au 31.12.2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_markdown(face = "bold", size = 12),
plot.subtitle = element_markdown(size = 10),
plot.caption = element_markdown(hjust = 0, size = 9, margin = margin(t = 5), face = "italic"), # rajout italic
plot.caption.position = "plot",
plot.margin = margin(10, 10, 30, 10),
legend.position = "bottom", # "top" "left" "right" "none"
legend.box = "vertical", #"horizontal"
legend.box.just = "left", # aligne les blocs à gauche
legend.justification = "left",
legend.text = element_markdown(size = 10),
legend.title = element_markdown(size = 12),
legend.spacing.y = unit(0.1, "cm"), # espace entre blocs
legend.margin = margin(t = 0, b = 0), # supprime marge globale
legend.box.spacing = unit(0.1, "cm"), # espace bloc-légende vs reste du plot
axis.text = element_text(size = 8),
axis.title = element_markdown(size = 10)
)
obsindVD::girafe_light(g2_plot,
# Ajout de la transparence aux éléments non-survolés !
options = list(
opts_hover_inv(css = "opacity:0.5;"),
opts_hover(css = "opacity:1;"),
# Ajout du nom du PNG téléchargé + remplacement de 'download' par 'télécharger' (survol icône)
opts_toolbar(
position = "topright",
hidden = c("zoom", "selection"),
pngname = paste0(selected_metadata[['Identifiant thématique']], "_G2"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g2_Subventions-Remplacement_Chauffage_Agent-Energetiques-changed_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G3
##| fig-cap: "Montants des subventions octroyées pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G3 - Montants des subventions octroyées pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud
#_______________________________________________________
promesses_montants_total <- stats_pb$PROMESSE$rempl_syst |>
filter(TYPE == "REMPLACEMENT_TOT") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
mutate(MONTANT = MONTANT/1e6,
ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(MONTANT_CUMULE = cumsum(MONTANT)) |>
select(ANNEE, MONTANT, MONTANT_CUMULE)
# valeur du dernier MONTANT_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul_montants <- promesses_montants_total |>
filter(ANNEE == an)
promesses_montants <- stats_pb$PROMESSE$rempl_syst |>
filter(ANNEE_PROMESSE != 9999 & TYPE != "REMPLACEMENT_TOT" ) |>
mutate(
MONTANT = MONTANT/1e6,
ANNEE = factor(ANNEE_PROMESSE),
TYPE = case_when(
TYPE == "REMPLACEMENT_GAZ" ~ "Gaz",
TYPE == "REMPLACEMENT_MAZOUT" ~ "Mazout",
TYPE == "REMPLACEMENT_ELEC" ~ "Electricité",
TRUE ~ TYPE),
TYPE = factor(
TYPE,
levels = c("Gaz", "Mazout", "Electricité")
)) |>
select(ANNEE, MONTANT, TYPE) |>
arrange(ANNEE)
# Coefficient
coef <- min(promesses_montants$MONTANT, na.rm = TRUE) /
(0.04*max(promesses_montants_total$MONTANT, na.rm = TRUE))
g3_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses_montants,
aes(x = ANNEE, y = MONTANT, fill = TYPE, group = TYPE,
tooltip = paste("Montants octroyés pour remplacement d'un chauffage ", TYPE, " en ", ANNEE, " : ", label_number(accuracy = 0.1, big.mark = "'")(MONTANT), " Mio CHF"),
data_id = paste(ANNEE, TYPE, "annuel")),
width = 0.7,
position = "dodge",
color = NA
) +
# Ajout du total sur les histo
geom_text(
data = promesses_montants,
inherit.aes = FALSE,
aes(
x = ANNEE,
y = MONTANT,
label = label_number(accuracy = 0.1, big.mark = "'")(MONTANT), " Mio CHF",
group = TYPE
),
position = position_dodge(widt = 0.7),
vjust = -0.5,
size = 3
) +
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul_montants,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
label = scales::label_number(accuracy = 0.1)(MONTANT_CUMULE), " Mio CHF"
),
hjust = 0.5, # décale à gauche
vjust = 2, # décalé vers le bas
size = 3.5,
color = "red",
# fontface = "bold"
)+
# lignes pour TOTAL_CUMULE
geom_line_interactive(
data = promesses_montants_total,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
color = "Cumul",
group = 1
),
linewidth = 1.1
) +
geom_point_interactive(
data = promesses_montants_total,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
color = "Cumul",
tooltip = paste(
"Total cumulé des montants octroyés en ",
ANNEE, " : ",
scales::label_number(accuracy = 0.1)(MONTANT_CUMULE), " Mio CHF"
)
,
data_id = paste(ANNEE, MONTANT_CUMULE, "cumul_pt")
),
size = 2
)+
# Colors
scale_fill_manual(
values = c(
"Gaz" = "#6a8caf",
"Mazout" = "#c78a92",
"Electricité" = "#f0d47a"
)
) +
scale_color_manual(
values = c("Cumul" = "red"),
labels = c("Cumul" = "Montants cumulés des\nsubventions rénovations")
)+
# Titles and caption
scale_y_continuous(
name = "Montants annuels [Mio CHF]",
sec.axis = sec_axis(~ . / coef, name = "Montants cumulés [Mio CHF] ")
) +
scale_x_discrete()+
labs(
title = str_wrap("**Montants octroyés pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Montants des subventions [Mio CHF]",
fill = NULL,
color = NULL,
caption = "Source: IWF / DGE-DIREN<br>Etat au 31.12.2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_markdown(face = "bold", size = 12),
plot.subtitle = element_markdown(size = 10),
plot.caption = element_markdown(hjust = 0, size = 9, margin = margin(t = 5), face = "italic"), # rajout italic
plot.caption.position = "plot",
plot.margin = margin(10, 10, 30, 10),
legend.position = "bottom", # "top" "left" "right" "none"
legend.box = "vertical", #"horizontal"
legend.box.just = "left", # aligne les blocs à gauche
legend.justification = "left",
legend.text = element_markdown(size = 10),
legend.title = element_markdown(size = 12),
legend.spacing.y = unit(0.1, "cm"), # espace entre blocs
legend.margin = margin(t = 0, b = 0), # supprime marge globale
legend.box.spacing = unit(0.1, "cm"), # espace bloc-légende vs reste du plot
axis.text = element_text(size = 8),
axis.title = element_markdown(size = 10)
)
obsindVD::girafe_light(g3_plot,
# Ajout de la transparence aux éléments non-survolés !
options = list(
opts_hover_inv(css = "opacity:0.5;"),
opts_hover(css = "opacity:1;"),
# Ajout du nom du PNG téléchargé + remplacement de 'download' par 'télécharger' (survol icône)
opts_toolbar(
position = "topright",
hidden = c("zoom", "selection"),
pngname = paste0(selected_metadata[['Identifiant thématique']], "_G3"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g3_Montants_Subventions_Remplacement_chauffage_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
# Analyse {#sec-analyse}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
## Description statistique {#sec-analyse-description}
Le nombre de subventions promises pour le remplacement d’un chauffage à combustible fossile (gaz ou mazout) ou électrique par des énergies renouvelables était en constante augmentation entre 2017 (312) et 2023 (2’201). Le nombre de promesses de subventions a baissé en 2024 et 2025 pour atteindre 1’419 en 2025 (@fig-G1). La baisse observée depuis 2024 est surtout prononcée pour les bâtiments qui étaient chauffés par des énergies fossiles. Dans le cas de remplacement d’un chauffage électrique, le nombre de subventions est resté relativement stable depuis 2023 (@fig-G2).
Depuis le lancement du Programme Bâtiment en 2017, près de 10'000 subventions ont été octroyées au total pour un montant cumulé de plus de 100 millions de francs : 42 millions pour le remplacement d’une chaudière à mazout, 29 millions pour celui d’une chaudière à gaz et 32 millions pour celui d’un chauffage électrique (@tbl-T1).
Les montants médians promis diffèrent selon le type de chauffage à changer. Pour le remplacement de chaudières à gaz et à mazout, la moitié des subventions concerne des montants supérieurs à 5'000 francs (@tbl-T1). Pour ce qui concerne le remplacement des chauffages électriques, les montants médians sont plus de trois fois supérieurs : 17'500 francs entre 2021 et 2024. Cela s’explique par le fait qu’il est parfois nécessaire d’installer des radiateurs lors de remplacement d’un chauffage électrique décentralisé. 2025 voit l’introduction de la mesure IP-19 (remplacement d’un chauffage électrique ou fossile décentralisé) : son but est d’encourager davantage les propriétaires de bâtiments chauffés par des chauffages électriques à remplacer leur système de chauffage. À cette fin le montant médian de la subvention a augmenté à 20'000 francs en 2025.
Dans la majorité des cas, les anciens chauffages à combustible fossile ou électriques ont été remplacés par une pompe à chaleur. On l’observe dans 75% des cas lors du remplacement d’une chaudière à mazout, dans 90% des cas lors du remplacement d’une chaudière à gaz et dans 89% des cas lors du remplacement d’un chauffage électrique (@tbl-T2). Une chaudière à bois ou à pellets a été privilégiée dans respectivement 17%, 4% et 9% des cas. Des raccordements à un chauffage à distance ont été effectués dans 8% des remplacements de chaudières à mazout et 6% des chaudières à gaz. Ils sont très rares dans le cas d’un remplacement de chauffage électrique (moins de 2%). Pour ce type de cas, les pompes à chaleur sont clairement privilégiées.
## Interprétation {#sec-analyse-interpretation}
La hausse significative des remplacements de chauffages à combustibles fossiles ou électriques est en partie liée à l’augmentation des prix de l’énergie et aux tensions géopolitiques. A noter que le montant d’encouragement pour ce type de subventions a progressivement augmenté entre 2017 et 2023 : pour les installations de petite puissance, le montant forfaitaire pour les PAC air-eau a augmenté de 67% et celui pour les PAC sol-eau de 150%.
A cela s’ajoute le fait que plus de 50 communes ont mis en place des subventions communales.
## Périmètre et limites {#sec-analyse-perimetre}
Dans l’optique d’exploiter au maximum le budget à disposition chaque année et de prendre en compte les promesses de subventions qui n’aboutissent pas (refus, annulations ou réductions), le montant total des subventions octroyées (promises) annuellement dépasse celui du budget annuel depuis 2018 (surengagement entre 4 et 6%).
Le nombre de subventions octroyées en 2022 est par exemple sous-évalué : le budget (après surengagement de 6%) avait déjà été épuisé 2 mois et demi avant la fin de l’année. Autour de 380 subventions (dont 90% de PAC) ont ainsi été préréservées et octroyées en 2022 sur le budget 2023, pour un montant cumulé de 3,4 millions de francs.
Il convient par ailleurs de noter que les données relatives aux dernières années sont susceptibles d’évoluer légèrement à chaque mise à jour de cette fiche d’indicateurs, notamment en raison des modifications apportées aux subventions promises (par exemple en cas d’annulation ou de correction lors du versement).
# Tableaux {#sec-tableaux}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
```{r}
#| label: tbl-T1
##| tbl-cap: "Nombre de subventions octroyées annuellement pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud"
promesses_nbre_long <- stats_pb$PROMESSE$rempl_syst |>
# filter(TYPE == "Subventions_Nombre") |>
mutate(Année = as.character(ANNEE_PROMESSE)) |>
select(-c(MONTANT, MONTANT_MEDIAN, ANNEE_PROMESSE)) |>
ungroup() |>
mutate(TYPE = case_when(
Année == "9999" & TYPE == "REMPLACEMENT_TOT_TOTAL" ~ "REMPLACEMENT_TOT",
Année == "9999" & TYPE == "REMPLACEMENT_GAZ_TOTAL" ~ "REMPLACEMENT_GAZ",
Année == "9999" & TYPE == "REMPLACEMENT_MAZOUT_TOTAL" ~ "REMPLACEMENT_MAZOUT",
Année == "9999" & TYPE == "REMPLACEMENT_ELEC_TOTAL" ~ "REMPLACEMENT_ELEC",
TRUE ~ TYPE
)) |>
mutate(Année = case_when(
Année == "9999" ~ "Total",
TRUE ~ Année
))
promesses_nbre_wide <- promesses_nbre_long |>
pivot_wider(names_from = TYPE, values_from = NOMBRE)
t1 <- promesses_nbre_wide|>
gt() |>
tab_header(title = md("**Subventions octroyées pour remplacement d'un chauffage à combustible fossile ou électrique**"),
subtitle = "Selon le type de chauffage, Vaud")|>
cols_width(everything() ~ pct(100 / ncol(promesses_nbre_wide))) |>
tab_style(style = cell_text(weight = "bold"),
locations = list(cells_body(rows = Année == "Total"),
cells_column_labels(),
cells_body(columns = "REMPLACEMENT_TOT"))) |>
tab_style(
style = cell_text(align = "center"),
locations = cells_column_labels()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_footnotes()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_source_notes()
) |>
cols_align(align = "center") |> #, columns = "Année") |>
cols_label(
Année = "Année",
REMPLACEMENT_TOT = "Total",
REMPLACEMENT_GAZ = "Gaz",
REMPLACEMENT_MAZOUT = "Mazout",
REMPLACEMENT_ELEC = "Eléctrique"
) |>
cols_label_with(
columns = -c("Année"),
fn = \(col) md(paste0(col, "\n\n[nbre]"))
) |>
fmt_number(columns = -Année,
sep_mark = "'",
decimals = 0
) |>
tab_footnote(footnote = "Les mesures concernées par ces subventions sont les mesures M02-M04 et IP04 (installation de chauffage à bois), M05-M06 et IP05-IP06 (installation d'une pompe à chaleur), M07 et IP07 (raccordement à un réseau de chauffage) et IP19 (remplacement d’un chauffage électrique ou fossile décentralisé).",
locations = cells_title(groups = "title"),
placement = "right") |>
tab_style(style = cell_borders(sides = "all"),
locations = list(cells_column_labels(), cells_column_spanners())) |>
tab_style(style = cell_borders(sides = c("left", "right")),
locations = list(cells_body())) |>
tab_options(column_labels.border.bottom.color = "black") |>
# fmt_missing(columns = everything(), missing_text = "") |>
opt_table_outline(style = "solid", width = px(2), color = "lightgrey") |>
tab_source_note(
source_note = md("*Source: IWF / DGE-DIREN<br>Etat au 31.12.2025*")
)
t1
gtsave(t1, glue("./images/t1_Promesses_Remplacement_Systeme_nbre_annee_2017-{an}.html"))
```
```{r}
#| label: tbl-T2
##| tbl-cap: "Montants des subventions octroyées pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud"
promesses_montants_long <- stats_pb$PROMESSE$rempl_syst |>
# filter(TYPE == "Subventions_Nombre") |>
mutate(Année = as.character(ANNEE_PROMESSE)) |>
select(-c(NOMBRE, MONTANT_MEDIAN, ANNEE_PROMESSE)) |>
ungroup() |>
mutate(TYPE = case_when(
Année == "9999" & TYPE == "REMPLACEMENT_TOT_TOTAL" ~ "REMPLACEMENT_TOT",
Année == "9999" & TYPE == "REMPLACEMENT_GAZ_TOTAL" ~ "REMPLACEMENT_GAZ",
Année == "9999" & TYPE == "REMPLACEMENT_MAZOUT_TOTAL" ~ "REMPLACEMENT_MAZOUT",
Année == "9999" & TYPE == "REMPLACEMENT_ELEC_TOTAL" ~ "REMPLACEMENT_ELEC",
TRUE ~ TYPE
)) |>
mutate(
Année = case_when(
Année == "9999" ~ "Total",
TRUE ~ Année),
MONTANT = MONTANT/1e6)
promesses_montants_wide <- promesses_montants_long |>
pivot_wider(names_from = TYPE, values_from = MONTANT)
t2 <- promesses_montants_wide|>
gt() |>
tab_header(title = md("**Montants des subventions octroyées pour remplacement d'un chauffage à combustible fossile ou électrique**"),
subtitle = "Selon le type de chauffage, Vaud") |>
cols_width(everything() ~ pct(100 / ncol(promesses_montants_wide))) |>
tab_style(style = cell_text(weight = "bold"),
locations = list(cells_body(rows = Année == "Total"),
cells_column_labels(),
cells_body(columns = "REMPLACEMENT_TOT"))) |>
tab_style(
style = cell_text(align = "center"),
locations = cells_column_labels()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_footnotes()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_source_notes()
) |>
cols_align(align = "center") |> #, columns = "Année") |>
# cols_label_with(
# columns = -c("Année"),
# fn = \(col) md(paste0(col, "\n\n[Mio CHF]"))
#) |>
fmt_number(columns = -Année,
sep_mark = "'",
decimals = 1
) |>
cols_label(
Année = "Année",
REMPLACEMENT_TOT = "Total",
REMPLACEMENT_GAZ = "Gaz",
REMPLACEMENT_MAZOUT = "Mazout",
REMPLACEMENT_ELEC = "Eléctrique"
) |>
tab_footnote(footnote = "Les mesures concernées par ces subventions sont les mesures M02-M04 et IP04 (installation de chauffage à bois), M05-M06 et IP05-IP06 (installation d'une pompe à chaleur), M07 et IP07 (raccordement à un réseau de chauffage) et IP19 (remplacement d’un chauffage électrique ou fossile décentralisé).",
locations = cells_title(groups = "title"),
placement = "right") |>
tab_style(style = cell_borders(sides = "all"),
locations = list(cells_column_labels(), cells_column_spanners())) |>
tab_style(style = cell_borders(sides = c("left", "right")),
locations = list(cells_body())) |>
tab_options(column_labels.border.bottom.color = "black") |>
fmt_missing(columns = everything(), missing_text = "") |>
opt_table_outline(style = "solid", width = px(2), color = "lightgrey") |>
tab_source_note(
source_note = md("*Source: IWF / DGE-DIREN<br>Etat au 31.12.2025*")
)
t2
gtsave(t2, glue("./images/t2_Promesses_Remplacement_Systeme_Montants_annee_2017-{an}.html"))
```
```{r}
#| label: tbl-T3
##| tbl-cap: "Subventions pour remplacer un chauffage à combustible fossile ou électrique, selon le nouveau et l'ancien type de chauffage, 2017-2025, Vaud"
promesses_chgts_temp <- stats_pb$PROMESSE$ae_apres_chgt |>
mutate(
TYPE = recode(TYPE,
AE_APRES_GAZ = "Gaz",
AE_APRES_MAZOUT = "Mazout",
AE_APRES_ELEC = "Electrique"
)
)
total_temp <- promesses_chgts_temp|>
group_by(TYPE) |>
summarise(NOMBRE = sum(NOMBRE, na.rm = TRUE)) |>
mutate(AE_APRES_NEW = "Total",
perc = 100)
promesses_chgts <- promesses_chgts_temp |>
bind_rows(total_temp)
promesses_chgts_wide <- promesses_chgts |>
pivot_wider(
id_cols = TYPE,
names_from = AE_APRES_NEW,
values_from = c(NOMBRE, perc),
names_glue = "{AE_APRES_NEW}_{.value}"
) |>
select(TYPE,Total_NOMBRE, Total_perc, "Bois-Pellets_NOMBRE", "Bois-Pellets_perc", CAD_NOMBRE, CAD_perc, PAC_NOMBRE, PAC_perc)
promesses_chgts_wide_final <- promesses_chgts_wide |>
bind_rows(
promesses_chgts_wide |>
summarise(
TYPE = "Total",
across(-TYPE, sum, na.rm = TRUE)
) |>
mutate(
Total_perc = 100,
`Bois-Pellets_perc` = `Bois-Pellets_NOMBRE` / Total_NOMBRE * 100,
CAD_perc = CAD_NOMBRE / Total_NOMBRE * 100,
PAC_perc = PAC_NOMBRE / Total_NOMBRE * 100
)
)
promesses_chgts_wide_final <- promesses_chgts_wide_final |>
arrange(desc(TYPE == "Total"))
t3 <- promesses_chgts_wide_final |>
gt() |>
tab_header(title = md("**Nombre de subventions pour le remplacement d'un chauffage à combustible fossile ou électrique**"), # ajout du titre en gras avec md() + syntaxe **
subtitle = "Selon le nouveau et l'ancien type de chauffage, 2017-2025, Vaud") |>
cols_label(
TYPE = md("**Ancien chauffage remplacé**")
) |>
cols_label_with(
columns = -TYPE,
fn = ~ ifelse(grepl("NOMBRE", .x), "[nbre]", "[%]")
) |>
# spanners
tab_spanner(label = "Total", columns = starts_with("Total"), level = 1) |>
tab_spanner(label = "Bois-Pellets", columns = starts_with("Bois-Pellets"), level = 1) |>
tab_spanner(label = "CAD", columns = starts_with("CAD"), level = 1) |>
tab_spanner(label = "Pompe à chaleur", columns = starts_with("PAC"), level = 1) |>
tab_spanner(
label = md("**Nouveau système de chauffage subventionné**"),
columns = -TYPE,
level = 2) |>
# format
fmt_number(columns = ends_with("NOMBRE"), decimals = 0, sep_mark = "'") |>
fmt_number(columns = ends_with("perc"), decimals = 1) |>
# style
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(rows = TYPE == "Total")
) |>
tab_style(
style = cell_text(align = "center", v_align = "middle"),
locations = cells_column_labels()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_footnotes()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_source_notes()
) |>
tab_footnote(footnote = "Les mesures concernées par ces subventions sont les mesures M02-M04 et IP04 (installation de chauffage à bois), M05-M06 et IP05-IP06 (installation d'une pompe à chaleur), M07 et IP07 (raccordement à un réseau de chauffage) et IP19 (remplacement d’un chauffage électrique ou fossile décentralisé).",
locations = cells_title(groups = "title"),
placement = "right") |>
tab_source_note(
source_note = md("*Sources : StatVD / CFF / DGE-DIREN<br>Etat au 25.11.2025*"))
t3
gtsave(t3, glue("./images/t3_Crosstable_anciens_nouveaux_chauffages_2015-{an}.html"))
```
# Méthode {#sec-methode}
Les données proviennent de IWF, prestataire informatique chargé de la plateforme de gestion des demandes de subvention du Programme Bâtiments, qui met à disposition des cantons les données concernant les subventions qu’ils octroient dans le cadre du Programme Bâtiments, qu’il s’agisse des demandes de subventions, des subventions pour lesquelles une décision d’octroi a été prise (subventions promises) ou des subventions payées. Ce programme subventionne les travaux de rénovation effectués sur les bâtiments.
Les mesures concernées par ces subventions sont les mesures M02-M04 et IP04 (installation de chauffage à bois), M05-M06 et IP05-IP06 (installation d'une pompe à chaleur), M07 et IP07 (raccordement à un réseau de chauffage) et IP19 (remplacement d’un chauffage électrique ou fossile décentralisé).
Subventions promises : nombre de demandes de subventions acceptées sur une année par le Canton dans le cadre du Programme Bâtiments.
Montant des subventions promises : montant cumulé des subventions acceptées sur une année par le Canton dans le cadre du Programme Bâtiments.
# Comparaison {#sec-comparaison}
Les comparaisons intercantonales doivent se faire avec prudence. La plupart des écarts sont souvent induits par des fluctuations de la demande et sont peu influençables par la politique cantonale. Les rapports annuels du Programme Bâtiments permettent certaines comparaisons entre le taux de remplacement des chauffages du canton de Vaud avec celui des autres cantons ou par rapport à la moyenne suisse.
Le site du Groupement professionnel suisse pour les pompes à chaleur ([GSP](https://www.fws.ch/fr/statistiques/)) donne des statistiques annuelles sur les chiffres de vente des pompes à chaleur depuis 2010.
# Références {#sec-ref}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
## Fiches associées {#sec-ref-fiches}
**Fiches Indicateur** :
* [IND_08.05.03.01 : Subventions dans le cadre du Programme Bâtiments, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.01_Subventions_Batiments.html)
* [IND_08.05.03.02 : Subventions pour rénovation partielle ou globale du bâtiment, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.02_Subventions_Renovation_Batiment.html)
* [IND_08.05.03.06 : Subventions pour des certificats énergétiques CECB+, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.06_Subventions_CECB_Plus.html)
## Autres références {#sec-ref-autres}
* [DGE-DIREN - Conception cantonale de l’énergie (CoCEn 2019)](https://www.vd.ch/fileadmin/user_upload/themes/environnement/energie/fichiers_pdf/CoCEn_Pub_complete_20190816.pdf)
* [DGE-DIREN - Programme Bâtiments Vaud](https://www.vd.ch/themes/environnement/energie/subventions-programme-batiments)
* [Loi fédérale sur la réduction des émissions de CO<sub>2</sub> (Loi sur le CO<sub>2</sub>, 641.71)](https://www.fedlex.admin.ch/eli/cc/2000/148/fr)
* [OFEN - Le Programme Bâtiments - Rapports annuels](https://www.leprogrammebatiments.ch/fr/meta/publications-et-photos/rapports-et-statistiques/)
# Glossaire {#sec-glossaire}
```{r}
# ---------------------------------------------------------
# Bloc pour lecture du file BRUT où se trouvent toutes les définition pour le glossaire et création du data.frame "definition" ----
# ---------------------------------------------------------
tryCatch(
expr = {readxl::read_excel("P:/DIREN/11 POLITIQUE ENERG/11.08 Indicateurs et stat/1 Indicateurs DIREN/3-Fiches IND MET OBJ/Liste Definitions.xlsx",
skip = 2) |>
janitor::clean_names(case="screaming_snake") |>
select(TERME, DEFINITION) |>
readr::write_csv2("./data/definitions.csv")
},
error = function(e) message("Attention: la table définition n'a pas pu être réactualisée avec les données brutes du P:/ ", e$message),
warning = function(w) message("Attention: la table définition n'a pas pu être réactualisée avec les données brutes du P:/ ", w$message)
)
```
```{r}
# ---------------------------------------------------------
# Bloc pour sélectionner les définitions à apparaître dans le glossaire ----
# ---------------------------------------------------------
# Lecture du file
def_tot <- readr::read_delim(file = "./data/definitions.csv",
delim = ";",
show_col_types = FALSE) |>
# Mettre les premières lettres de chaque définition en majuscule
dplyr::mutate(DEFINITION = stringr::str_replace(DEFINITION,"^\\p{L}",stringr::str_to_upper))
# Sélection des définitions
definitions <- def_tot |>
filter(TERME %in% c(
"Subventions octroyées",
"Montant médian",
"Rénovation partielle",
"Rénovation globale"
))
# Print de la table avec modification des columns
definitions |>
gt_table_ind() |>
gt::cols_label(TERME = "", DEFINITION ="Définition") |>
gt::tab_options(table.align = "left")
```
# Annexes {#sec-annexes .unnumbered}
## Subventions demandées {.unnumbered}
```{r}
demande_temp <- stats_pb$IMPORT$rempl_syst |>
filter(ANNEE_IMPORT != 9999 & TYPE != "REMPLACEMENT_TOT") |>
arrange(ANNEE_IMPORT) |>
select(TYPE, ANNEE_IMPORT, NOMBRE)
datatable(
demande_temp,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_renov_demandes_annee_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = c('NOMBRE'),
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Subventions octroyées {.unnumbered}
```{r}
promesse_temp <- stats_pb$PROMESSE$rempl_syst |>
filter(ANNEE_PROMESSE != 9999 & TYPE != "REMPLACEMENT_TOT") |>
arrange(ANNEE_PROMESSE) |>
relocate(TYPE, ANNEE_PROMESSE)
datatable(
promesse_temp,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_renov_promesses_annee_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = c('NOMBRE','MONTANT', 'MONTANT_MEDIAN'),
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Subventions payées {.unnumbered}
```{r}
paiement_temp <- stats_pb$PAIEMENT$rempl_syst |>
filter(ANNEE_PAIEMENT != 9999 & TYPE != "REMPLACEMENT_TOT") |>
arrange(ANNEE_PAIEMENT) |>
relocate(TYPE, ANNEE_PAIEMENT)
datatable(
paiement_temp,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_renov_paiements_annee_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = c('NOMBRE','MONTANT', 'MONTANT_MEDIAN'),
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```