---
title: "Subventions dans le cadre du Programme Bâtiments"
subtitle: "Nombre de subventions et montants demandés, promis et payés, Vaud"
lang: fr
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.01 # 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: 0e398244-6b10-4d80-b097-adc4e66c51cd # !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 promises par le Programme Bâtiments, Vaud <b>[nbre]</b>", # Par défaut = titre issu de la métadonnée (en-tête du document)
valeur_2025 = 4967,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA,
obj_2050 = "...",
tendance_observée = icon_up(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 = "Autre titre d'indicateur [kWh/hab]",
# valeur_2024 = NA,
# obj_2030 = NA, # valeur numérique OU icônes de flèches
# obj_2040 = icon_up(type = "obj"), # On peut modifier 'Cible non chiffrée' en modifiant l'argument text = "" par exemple pour ne rien afficher
# obj_2050 = 500,
# tendance_observée = icon_up(type = "trend", text = "2020-2024"), # 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 informe sur le nombre et les montants des subventions que le Canton de Vaud s’est engagé à verser à travers le [Programme Bâtiments](https://www.vd.ch/environnement/energie/subventions-programme-batiments) pour encourager les travaux d'isolation et favoriser la production d'énergie renouvelable dans le bâtiment. Il renseigne sur les mesures mises en place par le Canton pour améliorer l'efficacité énergétique des bâtiments et réduire les émissions de CO<sub>2</sub>.
# Cadre de référence {#sec-cadre-reference}
Les objectifs de réduction de la consommation des énergies et de hausse de la production d’énergies renouvelables 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}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
```{r}
# ---------------------------------------------------------
# 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 demandées, promises et payées dans le cadre du Programme Bâtiments, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G1 - Subventions demandées, promises et payées dans le cadre du Programme Bâtiments, Vaud
#_______________________________________________________
demandes <- stats_pb$IMPORT$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
# mutate(ANNEE_IMPORT = as.character(ANNEE_IMPORT)) |>
mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
mutate(VAR = "DEMANDE") |>
select(ANNEE_IMPORT, VAR, TOTAL) |>
rename(ANNEE = ANNEE_IMPORT) |>
# agrégation par année
group_by(ANNEE, VAR) |>
summarise(TOTAL = sum(TOTAL),
.groups = "drop") |>
arrange(ANNEE) |>
mutate(TOTAL_CUMULE = cumsum(TOTAL))
promesses <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
mutate(VAR = "PROMESSE") |>
select(ANNEE_PROMESSE, VAR, TOTAL) |>
rename(ANNEE = ANNEE_PROMESSE) |>
# agrégation par année
group_by(ANNEE, VAR) |>
summarise(TOTAL = sum(TOTAL),
.groups = "drop") |>
arrange(ANNEE) |>
mutate(TOTAL_CUMULE = cumsum(TOTAL))
# valeur du dernier NOMBRE_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul <- promesses |>
filter(ANNEE == an)
paiements <- stats_pb$PAIEMENT$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
mutate(VAR = "PAIEMENT") |>
select(ANNEE_PAIEMENT, VAR, TOTAL) |>
rename(ANNEE = ANNEE_PAIEMENT)|>
# agrégation par année
group_by(ANNEE, VAR) |>
summarise(TOTAL = sum(TOTAL),
.groups = "drop") |>
arrange(ANNEE) |>
mutate(TOTAL_CUMULE = cumsum(TOTAL))
nombre <- demandes |>
bind_rows(promesses, paiements)
nombre <- nombre |>
mutate(
VAR = VAR |> str_remove("\\[.*\\]") |> str_trim(),
VAR = recode(
VAR,
"DEMANDE" = "Subventions demandées",
"PROMESSE" = "Subventions promises",
"PAIEMENT" = "Subventions payées"
),
VAR = factor(
VAR,
levels = c(
"Subventions demandées",
"Subventions promises",
"Subventions payées"
)
)
)
g1_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = nombre,
aes(x = ANNEE, y = TOTAL, fill = VAR, group = VAR,
tooltip = paste("Nombre de ",VAR, " en ", ANNEE, " : ", label_number(accuracy = 1, big.mark = "'")(TOTAL)),
data_id = paste(ANNEE, VAR, "annuel")),
width = 0.7,
position = position_dodge(width = 0.7),
color = NA
) +
# lignes pour TOTAL_CUMULE
geom_line(
data = nombre,
aes(
x = ANNEE,
y = TOTAL_CUMULE,
group = VAR,
color = VAR,
),
linewidth = 1.1
) +
geom_point_interactive(
data = nombre,
aes(
x = ANNEE,
y = TOTAL_CUMULE,
group = VAR,
color = VAR,
tooltip = paste(
"Nombre cumulé des ",
VAR |> stringr::str_remove("\\[.*\\]"), " jusqu'en ",
ANNEE, " : ",
scales::label_number(big.mark = "'")(TOTAL_CUMULE)
),
data_id = paste(ANNEE, VAR, "cumul_pt")
),
size = 2
)+
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul,
aes(
x = ANNEE,
y = TOTAL_CUMULE ,
label = scales::label_number(big.mark = "'")(TOTAL_CUMULE)
),
hjust = 0.5, # décale à gauche
vjust = -0.8, # décalé vers le haut
size = 3.5,
color= "#00EE76"
# fontface = "bold"
)+
# Colors
scale_fill_manual(
values = c(
"Subventions demandées" = "#6495ED",
"Subventions promises" = "#00EE76",
"Subventions payées" = "#fcf635"
),
labels = c(
"Subventions demandées" = "Demandes",
"Subventions promises" = "Promesses",
"Subventions payées" = "Paiements"
)
) +
scale_color_manual(
values = c(
"Subventions demandées" = "#6495ED",
"Subventions promises" = "#00EE76",
"Subventions payées" = "#fcf635"
),
labels = c(
"Subventions demandées" = "Demandes",
"Subventions promises" = "Promesses",
"Subventions payées" = "Paiements"
)
) +
# Titles and caption
# labs(
# title = str_wrap("Subventions demandées, promises et payées dans le cadre du Programme Bâtiments, Vaud",
# width = 67),
# x = NULL,
# y= "Subventions en nombre [nbre]",
# fill = "Nombres annuels",
# color = "Nombres cumulés",
# caption = "Source: IWF / DGE_DIREN \nEtat au 31.12.2025"
# ) +
scale_x_continuous(breaks = sort(unique(nombre$ANNEE)))+
labs(
title = str_wrap("**Subventions demandées, promises et payées dans le cadre du Programme Bâtiments, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Subventions en nombre [nbre]",
fill = "Nombres annuels",
color = "Nombres cumulés",
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 = "right", # "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-PB_Demandes-Promesses-Payees_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G2
##| fig-cap: "Montants des subventions promises et payées dans le cadre du Programme Bâtiments, Vaud "
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# Montants des subventions promises et payées dans le cadre du Programme Bâtiments, Vaud
#_______________________________________________________
promesses <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Montants") |>
mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
mutate(VAR = "PROMESSE") |>
select(ANNEE_PROMESSE, VAR, TOTAL) |>
rename(ANNEE = ANNEE_PROMESSE) |>
# agrégation par année
group_by(ANNEE, VAR) |>
summarise(TOTAL = sum(TOTAL),
.groups = "drop") |>
arrange(ANNEE) |>
mutate(TOTAL_CUMULE = cumsum(TOTAL))
paiements <- stats_pb$PAIEMENT$mesures_total |>
filter(TYPE == "Subventions_Montants") |>
mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
mutate(VAR = "PAIEMENT") |>
select(ANNEE_PAIEMENT, VAR, TOTAL) |>
rename(ANNEE = ANNEE_PAIEMENT)|>
# agrégation par année
group_by(ANNEE, VAR) |>
summarise(TOTAL = sum(TOTAL),
.groups = "drop") |>
arrange(ANNEE) |>
mutate(TOTAL_CUMULE = cumsum(TOTAL))
montants <- promesses |>
bind_rows(paiements) |>
# présenter les montants en millions de francs
mutate(TOTAL = TOTAL/1e6,
TOTAL_CUMULE = TOTAL_CUMULE/1e6)
montants <- montants |>
mutate(
VAR = VAR |> str_remove("\\[.*\\]") |> str_trim(),
VAR = recode(
VAR,
"PROMESSE" = "Subventions promises",
"PAIEMENT" = "Subventions payées"
),
VAR = factor(
VAR,
levels = c(
"Subventions promises",
"Subventions payées"
)
)
)
# valeur du dernier NOMBRE_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul <- montants |>
filter(ANNEE == an & VAR == "Subventions promises")
g2_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = montants,
aes(x = ANNEE, y = TOTAL, fill = VAR, group = VAR,
tooltip = paste("Montants des ", VAR |> str_remove("\\[.*\\]"), ANNEE, ":", label_number(accuracy = 0.1, big.mark = "'")(TOTAL), " Mio francs"),
# tooltip = paste(VAR |> str_remove("\\[.*\\]"), ANNEE, ":", label_number(accuracy = 0.1, big.mark = "'")(TOTAL), " Mio francs"),
data_id = paste(ANNEE, VAR)),
width = 0.7,
position = position_dodge(width = 0.7),
color = NA
) +
# lignes pour TOTAL_CUMULE
geom_line(
data = montants,
aes(
x = ANNEE,
y = TOTAL_CUMULE,
group = VAR,
color = VAR,
),
linewidth = 1.1
) +
geom_point_interactive(
data = montants,
aes(
x = ANNEE,
y = TOTAL_CUMULE,
group = VAR,
color = VAR,
tooltip = paste(
"Montants cumulés des ",
VAR |> stringr::str_remove("\\[.*\\]"), " jusqu'en ",
ANNEE, ":",
scales::label_number(big.mark = "'")(TOTAL_CUMULE),
" Mio francs"
),
data_id = paste(ANNEE, VAR, "cumul_pt")
),
size = 2
)+
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul,
aes(
x = ANNEE,
y = TOTAL_CUMULE ,
label = scales::label_number(accuracy = 0.1)(TOTAL_CUMULE)
),
hjust = 0.5, # décale à gauche
vjust = -0.5, # décalé vers le haut
size = 3.5,
color= "#00EE76"
# fontface = "bold"
)+
# Colors
scale_fill_manual(
values = c(
"Subventions promises" = "#00EE76",
"Subventions payées" = "#fcf635"
),
labels = c(
"Subventions promises" = "Promesses",
"Subventions payées" = "Paiements"
)
) +
scale_color_manual(
values = c(
"Subventions promises" = "#00EE76",
"Subventions payées" = "#fcf635"
),
labels = c(
"Subventions promises" = "Promesses",
"Subventions payées" = "Paiements"
)
) +
scale_x_continuous(breaks = sort(unique(nombre$ANNEE)))+
labs(
title = str_wrap("**Montants des subventions promises et payées dans le cadre du Programme Bâtiment, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y = "Montants en millions de francs [Mio CHF]",
fill = "Montants annuels",
color = "Montants cumulés",
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 = "right", # "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-PB_Promesses-Payees_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G3
##| fig-cap: "Part du nombre de subventions promises dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
data_long <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
select(-TYPE) |>
pivot_longer(
cols = -1, # toutes les colonnes sauf la 1ère
names_to = "MESURE",
values_to = "NOMBRE"
) |>
rename(ANNEE = ANNEE_PROMESSE)
mesures_pct <- data_long |>
group_by(ANNEE) |>
mutate(
TOTAL = sum(NOMBRE, na.rm = TRUE),
PCT = NOMBRE / TOTAL * 100
) |>
ungroup() |>
mutate(
MESURE = factor(MESURE,
levels = c(
"Mesures indirectes",
"Chauffage centralisé",
"Construction neuve",
"Rénovation de systèmes",
"Technique du bâtiment",
"Isolation thermique"
)
)
)
g3_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = mesures_pct,
aes(x = ANNEE, y = PCT, fill = MESURE,
tooltip = paste(MESURE |> str_remove("\\[.*\\]"), ANNEE, ":", " ", label_number(accuracy = 1)(PCT), "%", " - ", label_number(accuracy = 1, big.mark = "'")(NOMBRE), "subventions"),
data_id = paste(ANNEE, MESURE)),
width = 0.7
) +
# Colors
scale_fill_manual(
values = c(
"Mesures indirectes" = "#D3D3D3",
"Chauffage centralisé" = "#6495ED",
"Construction neuve" = "#FFB90F",
"Rénovation de systèmes" = "#48A649",
"Technique du bâtiment" = "#FF870F",
"Isolation thermique" = "#9C6C3D"
),
name = NULL
) +
# Titles and caption
geom_text(
data = mesures_pct,
aes(
x = ANNEE,
y = PCT,
fill = MESURE,
label = ifelse(PCT>=3, paste0(round(PCT, 0),"%"), "")
),
position = position_stack(vjust = 0.5),
size = 2,
colour = "grey20"
) +
labs(
title = str_wrap("**Part du nombre de subventions promises dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y = "En %",
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 = "right", # "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_Subventions-PB_Part_Mesures_PAR_ANNEE_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G4
##| fig-cap: "Montants payés annuellemnt dans le cadre du Programme Bâtiments, selon l'année de la promesse, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
# Montants des subventions
payes_par_budget <- pb |>
filter(PAIEMENT==1) |>
filter(ANNEE_PAIEMENT <= an) |>
group_by(ANNEE_PAIEMENT, ANNEE_PROMESSE) |>
summarise(MONTANT = sum((MONTANT_PAIEMENT/1e6), na.rm = T)) |>
arrange(ANNEE_PROMESSE) |>
pivot_wider(names_from = ANNEE_PROMESSE, values_from = MONTANT)|>
mutate(TYPE = "ANNEE_BUDGET")
data_long <- payes_par_budget |>
select(-TYPE) |>
pivot_longer(
cols = -1, # toutes les colonnes sauf la 1ère
names_to = "ANNEE_PROMESSE",
values_to = "MONTANTS"
) |>
mutate(ANNEE_PROMESSE = factor(ANNEE_PROMESSE,
levels = sort(unique(ANNEE_PROMESSE), decreasing = TRUE)
))
g4_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = data_long,
aes(x = ANNEE_PAIEMENT, y = MONTANTS, fill = ANNEE_PROMESSE,
tooltip = paste("Montants promis en ", ANNEE_PROMESSE, " et payés en ", ANNEE_PAIEMENT, " : ", label_number(accuracy = 0.1, big.mark = "'")(MONTANTS), " Mio CHF"),
data_id = paste(ANNEE_PAIEMENT, ANNEE_PROMESSE)),
width = 0.7
) +
scale_fill_viridis_d(direction = -1, name = NULL)+
# Titles and caption
labs(
title = str_wrap("**Montants payés annuellemnt dans le cadre du Programme Bâtiments, selon l'année de la promesse, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y = "En Mio CHF",
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 = "right", # "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(g4_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']], "_G4"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g4_Montants_Subventions-PB_payes_PAR_ANNEE_PAIEMENT_ET_PROMESSE_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G5
#| include: false #afin que le graphique n'apparaisse pas dans le render, mais enregistré sous images
##| fig-cap: "Part du nombre de demandes de subventions dans le cadre du Programme Bâtiments, selon l'année et le statut fin 2025, Vaud"# AJOUT d'un graphique qui sera présent dans le dossier images, mais n'apparaîtra pas dans le rapport Markdown
# TAB 1: Subventions PB
pb_statut_final <- pb |>
filter(ANNEE_IMPORT <= an) |>
mutate(STATUT_FINAL = case_when(
PAIEMENT == 1 ~ "Subvention payée",
PAIEMENT != 1 & PROMESSE == 1 & ETAT %in% c("Dossier annulé", "Refusé") ~ "Subvention octroyée mais abandonnée",
PAIEMENT != 1 & PROMESSE == 1 & !ETAT %in% c("Dossier annulé", "Refusé") ~ "En traitement",
PAIEMENT != 1 & PROMESSE != 1 & ETAT == "Refusé" ~ "Demande refusée",
PAIEMENT != 1 & PROMESSE != 1 & ETAT == "Dossier annulé" ~ "Demande annulée",
PAIEMENT != 1 & PROMESSE != 1 & !ETAT %in% c("Dossier annulé", "Refusé") ~ "En traitement",
TRUE ~ "Autre"
))
data_long <- pb_statut_final |>
group_by(ANNEE_IMPORT, STATUT_FINAL) |>
summarise(NBRE = n()) |>
mutate(PERC = round(100*NBRE/sum(NBRE),1) ) |>
ungroup() |>
mutate(
STATUT_FINAL = factor(STATUT_FINAL,
levels = c(
"Subvention payée",
"Subvention octroyée mais abandonnée",
"En traitement",
"Demande refusée",
"Demande annulée"
)
)
)
#############################################################
g5_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = data_long,
aes(x = ANNEE_IMPORT, y = PERC, fill = STATUT_FINAL,
tooltip = paste(STATUT_FINAL |> str_remove("\\[.*\\]"), ANNEE_IMPORT, ":", " ", label_number(accuracy = 1)(PERC), "%", " - ", label_number(accuracy = 1, big.mark = "'")(NBRE), "subventions"),
data_id = paste(ANNEE_IMPORT, STATUT_FINAL)),
width = 0.7
) +
# Colors
scale_fill_manual(
values = c(
"Subvention payée" = "#48A649",
"Subvention octroyée mais abandonnée" = "#ffed00",
"En traitement" = "#D3D3D3",
"Demande refusée" = "#FF870F",
"Demande annulée" = "#e30613"
),
name = NULL
) +
geom_text(
data = data_long,
aes(
x = ANNEE_IMPORT,
y = PERC,
fill = STATUT_FINAL,
label = ifelse(PERC>=3, paste0(round(PERC, 0),"%"), "")
),
position = position_stack(vjust = 0.5),
size = 2,
colour = "grey20"
) +
# Titles and caption
labs(
title = str_wrap("**Part du nombre de demandes de subventions dans le cadre du Programme Bâtiments, selon l'année et le statut fin 2025, Vaud**", width = 73) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y = "En %",
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 = "right", # "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(g5_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']], "_G5"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g5_Subventions-PB_Statut_final_demandes_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
# Analyse {#sec-analyse}
## Description statistique {#sec-analyse-description}
Le nombre annuel de subventions promises dans le cadre du Programme Bâtiments du canton de Vaud a connu une progression continue entre 2017 (1’534) et 2023 (5’996). Après un recul observé en 2024, le volume des promesses a de nouveau augmenté en 2025 pour atteindre près de 5’000 subventions (@fig-G1). Cette reprise est toutefois largement attribuable à la forte hausse des mesures indirectes (44% ; IM01-07). Celles-ci englobent notamment les subventions destinées à l’établissement de certificats énergétiques des bâtiments avec rapport de conseil (@fig-G3). En 2025, parmi les mesures directes, les principales catégories de subventions concernaient le remplacement d’un chauffage fossile ou électrique par un chauffage renouvelable (34%), une isolation thermique (18%) ou une rénovation de systèmes (4%).
Depuis le lancement du programme en 2017, un total de 34'012 subventions a été octroyé, pour un montant cumulé de 478 millions de francs (@tbl-T2).
Les montants annuels totaux promis ont, quant à eux, augmenté de manière quasi continue depuis 2017 (@fig-G2). Ils ont atteint un pic de 73 millions de francs en 2024. En 2025, le montant des promesses est revenu à un niveau comparable à celui de 2023, soit un peu plus de 63 millions de francs.
Sur les quelques 70 millions de francs versés en 2025, près de la moitié concernait des subventions promises en 2025 ou 2024 (@fig-G4). De manière générale, la majorité des subventions est versée au cours de l’année suivant celle de leur octroi.
## Interprétation {#sec-analyse-interpretation}
L’augmentation du nombre de subventions accordées, conjuguée à la stabilité des montants versés, illustre l’adaptation du Canton afin de maximiser l’effet incitatif des aides tout en limitant les effets d’aubaine, en évitant de subventionner des investissements qui auraient été réalisés même en l’absence de soutien public.
## Périmètre et limites {#sec-analyse-perimetre}
Afin d’optimiser l’utilisation du budget annuel disponible et de tenir compte des promesses de subventions qui n’aboutissent pas (refus, annulations ou réductions), le montant total des subventions octroyées chaque année dépasse le budget annuel depuis 2018, avec un taux de surengagement compris entre 4 et 6%. Ainsi, le nombre de subventions octroyées en 2022 est par exemple sous-estimé : le budget (après un surengagement de 6%) a en effet été entièrement consommé environ deux mois et demi avant la fin de l’année. Plus de 700 subventions ont dès lors été préréservées et octroyées en 2022 sur le budget 2023, pour un montant total d’environ 10 millions de francs.
En raison de la diversité des types de subventions, un même bâtiment peut bénéficier de plusieurs aides au cours d’une même année. Inversement, certaines subventions peuvent concerner plusieurs bâtiments. Par conséquent, le nombre de bâtiments bénéficiant de subventions diffère généralement du nombre total de subventions recensées.
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 indicateurs, notamment en raison des modifications apportées aux subventions promises (par exemple en cas d’annulation ou de correction lors du versement).
Enfin, les subventions destinées à l’installation de bornes électriques n’ont pas été retenues dans le cadre des subventions pour le Programme Bâtiments.
# Tableaux {#sec-tableaux}
```{r}
#| label: tbl-T1
##| tbl-cap: "Subventions octroyées annuellement dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud"
promesses_nbre_temp <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
select(-TYPE) |>
ungroup() |>
arrange(ANNEE_PROMESSE) |>
rename("Année" = ANNEE_PROMESSE)|>
mutate(Total = rowSums(across(-Année), na.rm = TRUE)) |>
mutate(Année = as.character(Année)) |>
relocate("Année", "Total")
promesses_nbre_total <- promesses_nbre_temp |>
summarise(
across(-`Année`, ~sum(.x, na.rm = TRUE))
) |>
mutate("Année" = "Total")|>
relocate("Année")
promesses_nbre <- promesses_nbre_total |>
bind_rows(promesses_nbre_temp)
t1 <- promesses_nbre|>
mutate(across(-Année, \(col) na_if(col, y = 0))) |> # On change les 0 en NA comme ça sub_missing() ci-après transforme les 0 et les NA en "-" (par exemple)
gt() |>
tab_header(title = md("**Subventions octroyées annuellement dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud**")) |>
cols_width(everything() ~ pct(100 / ncol(promesses_nbre))) |>
tab_style(style = cell_text(weight = "bold"),
locations = list(cells_body(rows = Année == "Total"),
cells_column_labels(),
cells_body(columns = "Total"))) |>
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[nbre]"))
) |>
fmt_number(columns = -Année,
sep_mark = "'",
decimals = 0
) |>
tab_footnote(footnote = "Les six domaines de mesures du Programme Bâtiments sont une isolation thermique (M01; isolation du toit et des façades), la technique du bâtiment (M02-09; IP04-08; IP19; remplacement d'un chauffage fossile ou électrique par un chauffage renouvelable (bois, PAC, solaire thermique) ou le raccordement à un CAD), une rénovation de systèmes (M10-15; IP14; amélioration de la classe d’efficacité CECB, rénovation complète, …), une construction neuve (M16-17), un chauffage centralisé (M18; M18-1; M18-2; construction ou extension de réseau de chauffage à distance ou d'installation de production de chaleur), des mesures indirectes (IM01-07; certificats énergétiques des bâtiments avec rapport de conseil, …).",
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") |>
sub_missing(columns = everything(), missing_text = "-") |> # remplace la gestion des NA par '-' au lieu de '' (en lien avec le mutate où on change les 0 en NA)
# 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-PB_Promesses_nbre_annee_2017-{an}.html"))
```
```{r}
#| label: tbl-T2
##| tbl-cap: "Montants des subventions octroyées annuellement dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud"
promesses_montants_temp <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Montants") |>
select(-TYPE) |>
ungroup() |>
arrange(ANNEE_PROMESSE) |>
rename("Année" = ANNEE_PROMESSE)|>
mutate(Total = rowSums(across(-Année), na.rm = TRUE)) |>
mutate(Année = as.character(Année)) |>
# changer les montants en millions de francs
mutate(across(-Année, ~ ./1e6)) |>
relocate("Année", "Total")
promesses_montants_total <- promesses_montants_temp |>
summarise(
across(-`Année`, ~sum(.x, na.rm = TRUE))
) |>
mutate("Année" = "Total")|>
relocate("Année")
promesses_montants <- promesses_montants_total |>
bind_rows(promesses_montants_temp)
t2 <- promesses_montants|>
mutate(across(-Année, \(col) na_if(col, y = 0))) |> # On change les 0 en NA comme ça sub_missing() ci-après transforme les 0 et les NA en "-" (par exemple)
gt() |>
tab_header(title = md("**Montants des subventions octroyées annuellement dans le cadre du Programme Bâtiments, selon le domaine de mesures, Vaud**")) |>
cols_width(everything() ~ pct(100 / ncol(promesses_montants))) |>
tab_style(style = cell_text(weight = "bold"),
locations = list(cells_body(rows = Année == "Total"),
cells_column_labels(),
cells_body(columns = "Total"))) |>
tab_style(
style = cell_text(align = "center"),
locations = cells_column_labels()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_source_notes()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_footnotes()
) |>
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,
decimals = 1) |>
tab_footnote(footnote = "Les six domaines de mesures du Programme Bâtiments sont une isolation thermique (M01; isolation du toit et des façades), la technique du bâtiment (M02-09; IP04-08; IP19; remplacement d'un chauffage fossile ou électrique par un chauffage renouvelable (bois, PAC, solaire thermique) ou le raccordement à un CAD), une rénovation de systèmes (M10-15; IP14; amélioration de la classe d’efficacité CECB, rénovation complète, …), une construction neuve (M16-17), un chauffage centralisé (M18; M18-1; M18-2; construction ou extension de réseau de chauffage à distance ou d'installation de production de chaleur), des mesures indirectes (IM01-07; certificats énergétiques des bâtiments avec rapport de conseil, …).",
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" )|>
# ,
# footnotes.align = "left",
# source_notes.align = "left") |>
sub_missing(columns = everything(), missing_text = "-") |> # remplace la gestion des NA par '-' au lieu de '' (en lien avec le mutate où on change les 0 en NA)
# 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_Montants_Subventions-PB_annee_2017-{an}.html"))
```
# Méthode {#sec-methode}
Les données proviennent de IWF 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 subvention, des subventions pour lesquelles une décision d’octroi a été prise (subventions promises) ou des subventions payées.
Les six domaines de mesures du Programme Bâtiments pour lesquels les cantons peuvent proposer des subventions sont :
* Isolation thermique : M01 (isolation du toit et des façades)
* Rénovation de systèmes : M10-M15 ; IP14 (Amélioration de la classe d’efficacité CECB, rénovation complète, …)
* Technique du bâtiment : M02-M09 ; IP04-IP08 ; IP19 (remplacement d’un chauffage fossile ou électrique par un chauffage renouvelable (bois, PAC, solaire thermique) ou le raccordement à un CAD)
* Construction neuve : M16
* Chauffage centralisé : M18 (construction ou extension de réseau de chauffage à distance (CAD) ou d’installation de production de chaleur)
* Mesures indirectes : IM01-IM10 (Certificat énergétique des bâtiments avec rapport de conseil, …)
Demandes de subventions : nombre de demandes de subventions transmises au Canton. L’année correspond à l’année durant laquelle la demande a été déposée.
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é.
Subventions payées : nombre de subventions pour lesquelles un montant a été versé. L’année correspond à celle où le montant a été versé.
Montant des subventions promises : montant des subventions acceptées pour le budget d’une certaine année.
Montant des subventions payées : montant cumulé des subventions effectivement payées 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. En 2024, le canton de Vaud est le canton ayant octroyé les plus gros montants dans le cadre du Programme Bâtiments (voir les rapports annuels du Programme Bâtiments, Tableau 1c). En montants engagés par habitant, le canton de Vaud (87 francs par habitant) était largement supérieur à la moyenne suisse (61 francs par habitant) . Seuls les cantons des Grisons (207 CHF/hab), du Valais (124 CHF/hab) et de Genève (93 CHF/hab) avaient des montants supérieurs.
# 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.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.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"
))
# Ajouter Agents énergétiques
# 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}
## Nombre de subventions demandées {.unnumbered}
```{r}
df_demande_nbre_temp <- stats_pb$IMPORT$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
mutate(Type = "Demandes de subvention") |>
select(-TYPE) |>
rename(Année = ANNEE_IMPORT) |>
arrange(Année) |>
relocate(Type, Année)
df_demande_nbre_long <- df_demande_nbre_temp |>
pivot_longer(
cols = -c(Type, Année),
names_to = "Domaine",
values_to = "Nombre"
)
datatable(
df_demande_nbre_long,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_conso_ae_année_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = 'Nombre',
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Nombre de subventions octroyées {.unnumbered}
```{r}
df_promesses_nbre_temp <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
mutate(Type = "Subventions octroyées") |>
select(-TYPE) |>
rename(Année = ANNEE_PROMESSE) |>
arrange(Année) |>
relocate(Type, Année)
df_promesses_nbre_long <- df_promesses_nbre_temp |>
pivot_longer(
cols = -c(Type, Année),
names_to = "Domaine",
values_to = "Nombre"
)
datatable(
df_promesses_nbre_long,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_conso_ae_année_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = 'Nombre',
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Nombre de subventions payées {.unnumbered}
```{r}
df_paiements_nbre_temp <- stats_pb$PAIEMENT$mesures_total |>
filter(TYPE == "Subventions_Nombre") |>
mutate(Type = "Subventions payées") |>
select(-TYPE) |>
rename(Année = ANNEE_PAIEMENT) |>
arrange(Année) |>
relocate(Type, Année)
df_paiements_nbre_long <- df_paiements_nbre_temp |>
pivot_longer(
cols = -c(Type, Année),
names_to = "Domaine",
values_to = "Nombre"
)
datatable(
df_paiements_nbre_long,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_conso_ae_année_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = 'Nombre',
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Montants des subventions octroyées {.unnumbered}
```{r}
df_promesses_montants_temp <- stats_pb$PROMESSE$mesures_total |>
filter(TYPE == "Subventions_Montants") |>
mutate(Type = "Montants octroyés") |>
select(-TYPE) |>
rename(Année = ANNEE_PROMESSE) |>
# changer les montants en millions de francs
# mutate(across(where(is.numeric), ~ ./1e6)) |>
arrange(Année) |>
relocate(Type, Année)
df_promesses_montants_long <- df_promesses_montants_temp |>
pivot_longer(
cols = -c(Type, Année),
names_to = "Domaine",
values_to = "Montants CHF"
)
datatable(
df_promesses_montants_long,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_conso_ae_année_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = 'Montants CHF',
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```
## Montants des subventions payées {.unnumbered}
```{r}
df_paiements_montants_temp <- stats_pb$PAIEMENT$mesures_total |>
filter(TYPE == "Subventions_Montants") |>
mutate(Type = "Montants payés") |>
select(-TYPE) |>
rename(Année = ANNEE_PAIEMENT) |>
# changer les montants en millions de francs
# mutate(across(where(is.numeric), ~ ./1e6)) |>
arrange(Année) |>
relocate(Type, Année)
df_paiements_montants_long <- df_paiements_montants_temp |>
pivot_longer(
cols = -c(Type, Année),
names_to = "Domaine",
values_to = "Montants CHF"
)
datatable(
df_paiements_montants_long,
extensions = 'Buttons',
rownames = FALSE,
options = list(
autoWidth = TRUE,
dom = '<"top"fB>rt<"bottom"ip>',
buttons = c('csv'),
filename = paste0(selected_metadata['Identifiant'], "_conso_ae_année_", Sys.Date()),
searching = FALSE,
pageLength = 5,
language = list(url = "https://cdn.datatables.net/plug-ins/1.13.6/i18n/fr-FR.json")
)
) |>
formatRound(
columns = 'Montants CHF',
digits = 0,
mark = "'",
dec.mark = ","
) |>
htmltools::div(style = "width: 70%; margin-left: 0;")
```