---
title: "Subventions pour rénovation partielle ou globale du bâtiment"
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.02 # 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: 83e2056f-f338-4636-b8cc-46af8abe7df0 # !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 rénovation du bâtiment, Vaud <b>[nbre]</b>", # Par défaut = titre issu de la métadonnée (en-tête du document)
valeur_2025 = 904,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA,
obj_2050 = "...",
tendance_observée = icon_flat(type = "trend", text = paste0("2019-", an)), # icon_up(), icon_flat(), icon_down()
tendance_évaluée = NA #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 rénovation du bâtiment, Vaud <b>[Mio CHF]</b>",
valeur_2025 = 35.2,
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_flat(type = "trend", text = paste0("2019-", an)), # text obligatoire pour type = 'trend'
tendance_évaluée = NA #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 informe à la fois sur le nombre de projets et sur les montants pour lesquels le Canton de Vaud s’est engagé à octroyer des subventions, à travers le [Programme Bâtiments](https://www.vd.ch/environnement/energie/subventions-programme-batiments), pour encourager les travaux d'isolation thermique partielle ou globale de la façade, du toit, des murs et/ou du sol. Cet indicateur informe sur les mesures mise en place par le Canton pour augmenter les rénovations des bâtiments en matière d'isolation thermique.
# 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, 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 (ou M10 (ajout en 2026))
# 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", "M10"))
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), M10 (Amélioration classes 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)
)
```
```{r }
#| label: fig-G1
##| fig-cap: "Subventions octroyées pour rénovation (partielle ou globale) du bâtiment, 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$renov |>
filter(TYPE == "RENOV_TOT") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
select(ANNEE_PROMESSE, NOMBRE) |>
mutate(ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(NOMBRE_CUMULE = cumsum(NOMBRE))
# valeur du dernier NOMBRE_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul <- promesses_total |>
filter(ANNEE == an)
promesses <- stats_pb$PROMESSE$renov |>
filter(TYPE %in% c("RENOV_PARTIELLE", "RENOV_GLOBALE") )|>
mutate(
ANNEE = factor(ANNEE_PROMESSE),
TYPE = case_when(
TYPE == "RENOV_PARTIELLE" ~ "Rénovations partielles",
TYPE == "RENOV_GLOBALE" ~ "Rénovations globales",
TRUE ~ TYPE),
TYPE = factor(
TYPE,
levels = c("Rénovations globales", "Rénovations partielles")
)) |>
select(ANNEE, NOMBRE, TYPE) |>
arrange(ANNEE)
# Coefficient
coef <- min(promesses$NOMBRE, na.rm = TRUE) /
(3*max(promesses_total$NOMBRE, na.rm = TRUE))
g1_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses,
aes(x = ANNEE, y = NOMBRE, fill = TYPE, group = TYPE,
tooltip = paste("Subventions pour ", TYPE, ANNEE, ":", label_number(accuracy = 1, big.mark = "'")(NOMBRE)),
data_id = paste(ANNEE, TYPE, "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.5, # décale à gauche
vjust = -0.8, # 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 rénovation 2017-",
ANNEE, ":",
scales::label_number(big.mark = "'")(NOMBRE_CUMULE)
)
,
data_id = paste(ANNEE, NOMBRE_CUMULE, "cumul_pt")
),
size = 2
)+
# Colors
scale_fill_manual(
values = c(
"Rénovations globales" = "#1b9e77",
"Rénovations partielles" = "#a6dba0"
),
labels = c(
"Rénovations globales" = "Rénovation globale",
"Rénovations partielles" = "Rénovation partielle"
)
) +
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 rénovation du bâtiment, 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(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-Renovations_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G2
##| fig-cap: "Montants des subventions octroyées pour rénovation (partielle ou globale) du bâtiment, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G2 - Montants des subventions promises pour rénovation globale ou partielle du bâtiment, Vaud
#_______________________________________________________
promesses_montants_total <- stats_pb$PROMESSE$renov |>
filter(TYPE == "RENOV_TOT") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
select(ANNEE_PROMESSE, MONTANT, MONTANT_MEDIAN) |>
mutate(MONTANT = MONTANT/1e6,
MONTANT_MEDIAN = MONTANT_MEDIAN/1e6,
ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(MONTANT_CUMULE = cumsum(MONTANT))
# 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$renov |>
filter(TYPE %in% c("RENOV_PARTIELLE", "RENOV_GLOBALE") )|>
mutate(
MONTANT = MONTANT/1e6,
MONTANT_MEDIAN = MONTANT_MEDIAN/1e6,
ANNEE = factor(ANNEE_PROMESSE),
TYPE = case_when(
TYPE == "RENOV_PARTIELLE" ~ "Rénovations partielles",
TYPE == "RENOV_GLOBALE" ~ "Rénovations globales",
TRUE ~ TYPE),
TYPE = factor(
TYPE,
levels = c("Rénovations globales", "Rénovations partielles")
)) |>
select(ANNEE, MONTANT, MONTANT_MEDIAN, TYPE) |>
arrange(ANNEE)
# Coefficient
coef <- min(promesses_montants$MONTANT, na.rm = TRUE) /
(3*max(promesses_montants_total$MONTANT, na.rm = TRUE))
g2_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 ", TYPE, ANNEE, ":", label_number(accuracy = 0.1, big.mark = "'")(MONTANT), " Mio CHF"),
data_id = paste(ANNEE, TYPE, "annuel")),
width = 0.7,
position = "stack",
color = NA
) +
# Ajout du total sur les stack
geom_text(
data = promesses_montants_total,
inherit.aes = FALSE,
aes(
x = ANNEE,
y = MONTANT,
label = label_number(accuracy = 0.1, big.mark = "'")(MONTANT), " Mio CHF"
),
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 = -0.8, # décalé vers le haut
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 pour rénovation 2017-",
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(
"Rénovations globales" = "#1b9e77",
"Rénovations partielles" = "#a6dba0"
),
labels = c(
"Rénovations globales" = "Rénovation globale",
"Rénovations partielles" = "Rénovation partielle"
)
) +
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 rénovation du bâtiment, 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(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_Montants_subventions-Renovations_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}
Après avoir atteint un record en 2023 avec 1’238 subventions promises pour la rénovation de bâtiments (partielle ou globale), leur nombre est en recul les années suivantes (904 en 2025; @fig-G1). À l’inverse, les montants octroyés poursuivent leur progression : alors qu’ils s’élevaient à 33 millions de francs en 2023, ils atteignent 35 millions en 2025 (@fig-G2).
La part des rénovations globales parmi l’ensemble des subventions de rénovation est passée de moins de 20 % en 2017 à plus d’un tiers en 2024, avant de redescendre à 21 % en 2025.
Le montant médian des subventions promises pour une rénovation partielle se situe autour de 10 000 francs, tandis que, pour les rénovations globales, 50 % des subventions promises dépassent 40’000 francs en 2025. Depuis le lancement du Programme Bâtiments, un total de 263 millions de francs a été octroyé pour la rénovation de bâtiments, dont 125 millions pour des rénovations partielles et 138 millions pour des rénovations globales (@tbl-T1).
## Interprétation {#sec-analyse-interpretation}
La diminution des rénovations partielles observée depuis 2020 s’explique, d’une part, par la période liée à la pandémie de COVID-19 en 2020–2021 et, d’autre part, par la réduction, intervenue en janvier 2021, du montant d’encouragement pour la mesure M01 (travaux d’isolation thermique), passé de 60 à 50 CHF/m<sup>2</sup>. Cette adaptation avait été décidée pour des raisons budgétaires.
La baisse de la proportion de subventions accordées aux rénovations globales entre 2024 et 2025 s’explique en grande partie par le fait que, durant l’année 2025, l’octroi de ces subventions a fortement concerné de grands bâtiments. Les montants très élevés associés à ces projets ont conduit à l’épuisement du budget annuel alloué aux rénovations globales dès la fin de l’été 2025.
## 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, annulation ou réduction), le montant total des subventions octroyées annuellement dépasse celui du budget annuel depuis 2018 (surengagement entre 4 et 6%). Les valeurs concernant l’année 2022 sont par exemple sous-évaluées dans ces résultats, car le budget (après surengagement de 6%) a été épuisé 2 mois et demi avant la fin de l’année : autour de 220 subventions pour des rénovations partielles et 70 subventions pour des rénovations globales ont été préréservées puis octroyées en 2023, pour un montant cumulé s’élevant à 6 mioCHF.
Il convient par ailleurs de noter que les données relatives aux dernières années sont susceptibles d’évoluer légèrement à chaque mis à 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}
```{r}
#| label: tbl-T1
# #| tbl-cap: "Subventions octroyées pour rénovation du bâtiment (partielle ou globale), Vaud"
promesses_nbre_long <- stats_pb$PROMESSE$renov |>
# 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 == "RENOV_TOT_TOTAL" ~ "RENOV_TOT",
Année == "9999" & TYPE == "RENOV_PARTIELLE_TOTAL" ~ "RENOV_PARTIELLE",
Année == "9999" & TYPE == "RENOV_GLOBALE_TOTAL" ~ "RENOV_GLOBALE",
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 rénovation du bâtiment**"),
subtitle = "Rénovations partielles et globales, 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 = "RENOV_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",
RENOV_TOT = "Total",
RENOV_PARTIELLE = "Rénovation partielle",
RENOV_GLOBALE = "Rénovation globale"
) |>
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 = "Rénovation partielle: amélioration de l'isolation thermique de la façade, du toit, des murs et/ou du sol contre terre (mesure M01) qui a été subventionnée sans qu'il n'y ait eu eu de bonus pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l'amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).",
locations = cells_column_labels(columns="RENOV_PARTIELLE"),
placement = "right") |>
tab_footnote(footnote = "Rénovation globale: rénovation obtenant le label Minergie (mesure M12), atteignant les classes CECB C/B ou B/A (mesure M13), amélioration de la classe d’efficacité CECB pour les bâtiments protégés au niveau patrimonial (mesure M10), ayant reçu un bonus en complément à la mesure M01 pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l’amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).",
locations = cells_column_labels(columns="RENOV_GLOBALE"),
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_Subventions_Renovation_nbre_2017-{an}.html"))
```
```{r}
#| label: tbl-T2
##| tbl-cap: "Montants des subventions octroyées pour rénovation du bâtiment (partielle ou globale), Vaud"
promesses_montants_long <- stats_pb$PROMESSE$renov |>
# 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 == "RENOV_TOT_TOTAL" ~ "RENOV_TOT",
Année == "9999" & TYPE == "RENOV_PARTIELLE_TOTAL" ~ "RENOV_PARTIELLE",
Année == "9999" & TYPE == "RENOV_GLOBALE_TOTAL" ~ "RENOV_GLOBALE",
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 rénovation du bâtiment**"),
subtitle = "Rénovations partielles et globales, 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 = "RENOV_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") |>
fmt_number(columns = -Année,
sep_mark = "'",
decimals = 1
) |>
cols_label(
Année = "Année",
RENOV_TOT = "Total",
RENOV_PARTIELLE = "Rénovation partielle",
RENOV_GLOBALE = "Rénovation globale"
) |>
cols_label_with(
columns = -c("Année"),
fn = \(col) md(paste0(col, "\n\n[Mio CHF]"))
) |>
tab_footnote(footnote = "Rénovation partielle: amélioration de l'isolation thermique de la façade, du toit, des murs et/ou du sol contre terre (mesure M01) qui a été subventionnée sans qu'il n'y ait eu eu de bonus pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l'amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).",
locations = cells_column_labels(columns="RENOV_PARTIELLE")) |>
tab_footnote(footnote = "Rénovation globale: rénovation obtenant le label Minergie (mesure M12), atteignant les classes CECB C/B ou B/A (mesure M13), amélioration de la classe d’efficacité CECB pour les bâtiments protégés au niveau patrimonial (mesure M10), ayant reçu un bonus en complément à la mesure M01 pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l’amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).",
locations = cells_column_labels(columns="RENOV_GLOBALE")) |>
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_Subventions_Renovation_montants_2017-{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.
Une rénovation est considérée comme « *partielle* » lorsqu’elle consiste en une amélioration de l’isolation thermique de la façade, du toit, des murs et/ou du sol contre terre (mesure M01), subventionnée sans octroi d’un bonus pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l’amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).
Une rénovation est considérée comme « *globale* » lorsqu’elle remplit au moins l’un des critères suivants : l’obtention du label Minergie (mesure M12), l’atteinte des classes CECB C/B ou B/A (mesure M13), l’amélioration de la classe d’efficacité CECB pour les bâtiments protégés au niveau patrimonial (mesure M10), ou l’octroi d’un bonus en complément à la mesure M01 pour la rénovation complète de l’enveloppe du bâtiment (mesure M14), l’atteinte du standard Minergie (mesure M15) ou l’amélioration de l’efficacité de l’enveloppe du bâtiment (mesure IP14).
Le label [Minergie](https://www.minergie.ch/fr/) correspond à une certification officiellement délivrée après vérification du respect des exigences du référentiel Minergie, tandis que le standard Minergie désigne le niveau de performance énergétique visé par le bâtiment indépendamment de l'obtention formelle du label.
Subventions promises : nombre de demandes de subventions pour lesquelles le Canton a donné son accord de principe. L’année correspond à celle du budget auquel il est rattaché.
Montant des subventions promises : montant cumulé des subventions acceptées pour le budget d’une certaine année.
# Comparaison {#sec-comparaison}
Les comparaisons intercantonales doivent être effectuées avec prudence. La plupart des écarts sont souvent induits par des fluctuations de la demande et sont peu influençables par la politique cantonale.
# Références {#sec-ref}
## 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.04 : Subventions pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.04_Subventions_Remplacement_Chaudiere.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",
"Rénovation globale",
"Rénovation partielle",
"Montant médian"
))
# 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$renov |>
filter(ANNEE_IMPORT != 9999 & TYPE != "RENOV_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$renov |>
filter(ANNEE_PROMESSE != 9999 & TYPE != "RENOV_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$renov |>
filter(ANNEE_PAIEMENT != 9999 & TYPE != "RENOV_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;")
```