--- title: "Dynamique et état du logement en France 2016-2025" subtitle: "Vers une reprise après la correction post-covid ? · DVF 2016-2025 · SITADEL 2016-2025" author: "Vincent R." date: last-modified date-format: "D MMMM YYYY" categories: ["Note de synthèse", "Logement"] number-sections: false execute: freeze: auto format: html: grid: body-width: 950px sidebar-width: 250px margin-width: 200px gutter-width: 2rem --- ```{r} #| label: setup #| include: false # &s _aaMAIN - Setup note flash conjoncture logement # &s CONFIG PROJECT_ROOT <- "C:/Users/vince/hh/pq/PDS/ptod-ttrajObserDev" PDVF_ROOT <- "C:/Users/vince/hh/pq/PDS/pdvf-BatnatDvf" source(file.path(PROJECT_ROOT, "reports/_setup-common.R")) library(sf) library(gridExtra) library(ggrepel) library(htmltools) source("C:/Users/vince/hh/pq/PDS/mutils/jrr/jcn-ggmapstatic.R") source("C:/Users/vince/hh/pq/PDS/mutils/jrr/jcn-ddict.R") dd <- load_ddict() claude_log_init("rpt-plog-flash-conjoncture", output_dir = file.path(PROJECT_ROOT, "reports/outputs")) BASE_YEAR <- 2016 # &e CONFIG # &s LOAD_DATA # DVF séries communes (pipe pdvf, 2014-2025) dvf_comm <- read.csv(file.path(PDVF_ROOT, "data/exports/agg_commune_annuel.csv"), stringsAsFactors = FALSE, fileEncoding = "UTF-8") %>% mutate(code_commune = stringr::str_pad(code_commune, 5, pad = "0")) # DVF séries ZE (pipe pdvf, 2014-2025) dvf_ze <- read.csv(file.path(PDVF_ROOT, "data/exports/agg_ze_annuel.csv"), stringsAsFactors = FALSE, fileEncoding = "UTF-8") %>% mutate(code_ze = as.character(code_ze)) # TDC LIGHT avec typologies custom TDC_TYPO_PATH <- "C:/Users/vince/DBD-datab/TDC-ref/fr/geo-tdc/ptypo-dens-rural" tdc <- read.csv(file.path(TDC_TYPO_PATH, "tdc_geo_dim_commune_TYPO_LIGHT_2025.csv"), sep = ";", stringsAsFactors = FALSE, fileEncoding = "UTF-8-BOM", colClasses = c(CODGEO = "character", ZE2020 = "character", AAV2020 = "character", DEP = "character", REG = "character", TAAV2017 = "character")) %>% filter(TYPECOM %in% c("COM", "ARM")) %>% mutate(CODGEO = stringr::str_pad(CODGEO, 5, pad = "0")) %>% select(CODGEO, LIBGEO, DEP, REG, ZE2020, AAV2020, TAAV2017, CATEAAV2020, DENS, DENS_AAV, PMUN22, TYPO4p, TYPO5fs, TYPO3p, TYPO9fs) # Paris + Petite Couronne (périmètre pgent) paris_pc <- read.csv(file.path(PROJECT_ROOT, "data/ref/ref_perimetres_pgent.csv"), sep = ";", stringsAsFactors = FALSE, fileEncoding = "UTF-8") # Shapes ZE pour cartes shp_ze <- sf::st_read( "C:/Users/vince/DBD-datab/TDC-ref/fr/geo-shape-ok/nodom_zones-emploi_2025.geojson", quiet = TRUE) %>% rename(ZE2020 = ze2020) %>% mutate(ZE2020 = sub("^0+", "", ZE2020)) # Libellés ZE lib_ze <- read.csv(file.path(PROJECT_ROOT, "dashboard/observable/src/data/tdc_sat3col_ze.csv"), sep = ";", stringsAsFactors = FALSE, fileEncoding = "UTF-8-BOM", colClasses = c(ZE2020 = "character")) %>% select(ZE2020, ZE2020lib) # SITADEL construction résidentielle par commune (2011-2025) sitadel_comm <- read.csv(file.path(PROJECT_ROOT, "data/processed/sitadel/sitadel_residentiel_annuel_communes.csv"), stringsAsFactors = FALSE) %>% filter(TYPE_LGT == "Tous Logements") %>% mutate(COMM = stringr::str_pad(COMM, 5, pad = "0")) # &e LOAD_DATA # &s PREP_TYPO - Jointure communes x TDC + labels dvf_typo <- dvf_comm %>% inner_join(tdc, by = c("code_commune" = "CODGEO")) LABELS_T4P <- c("1" = "Pôles", "2" = "Couronnes urbaines", "3" = "Rural périurbain", "4" = "Rural autonome") ORD_T4P <- c("Pôles", "Couronnes urbaines", "Rural périurbain", "Rural autonome") LABELS_T9F <- c( "1a" = "Pôle Paris", "1b" = "Couronne Paris", "2a" = "Pôle grandes aires", "2b" = "Couronne grandes aires", "3a" = "Pôle aires moyennes", "3b" = "Couronne aires moyennes", "4a" = "Pôle petites aires", "4b" = "Couronne petites aires", "5" = "Hors AAV" ) ORD_T9F <- c("Pôle Paris", "Couronne Paris", "Pôle grandes aires", "Couronne grandes aires", "Pôle aires moyennes", "Couronne aires moyennes", "Pôle petites aires", "Couronne petites aires", "Hors AAV") GRP_T9F <- c( "Pôle Paris" = "Paris", "Couronne Paris" = "Paris", "Pôle grandes aires" = "Grandes aires", "Couronne grandes aires" = "Grandes aires", "Pôle aires moyennes" = "Aires moyennes", "Couronne aires moyennes" = "Aires moyennes", "Pôle petites aires" = "Petites aires", "Couronne petites aires" = "Petites aires", "Hors AAV" = "Hors AAV" ) dvf_typo <- dvf_typo %>% mutate( typo4p = factor(LABELS_T4P[as.character(TYPO4p)], levels = ORD_T4P), typo9fs = factor(LABELS_T9F[as.character(TYPO9fs)], levels = ORD_T9F), zone_paris = case_when( code_commune %in% paris_pc$code_commune[paris_pc$sous_zone == "paris"] ~ "Paris intra-muros", code_commune %in% paris_pc$code_commune[paris_pc$sous_zone == "couronne"] ~ "Petite couronne", TRUE ~ NA_character_ ) ) # &e PREP_TYPO # &s HELPERS_AGG agg_serie <- function(df, group_var, type_filter = NULL) { d <- df if (!is.null(type_filter)) d <- d %>% filter(type_bien == type_filter) d %>% filter(!is.na(.data[[group_var]]), !is.na(prix_m2_median), nb_mutations >= 5) %>% group_by(grp = .data[[group_var]], annee) %>% summarise( px_m2 = weighted.mean(prix_m2_median, nb_mutations, na.rm = TRUE), nb_trans = sum(nb_mutations, na.rm = TRUE), n_comm = n(), .groups = "drop" ) } add_indice100 <- function(df, value_col = "px_m2", group_col = "grp", base_year = BASE_YEAR) { df %>% group_by(.data[[group_col]]) %>% mutate( base_val = .data[[value_col]][annee == base_year][1], indice = ifelse(!is.na(base_val) & base_val > 0, .data[[value_col]] / base_val * 100, NA_real_) ) %>% ungroup() %>% select(-base_val) } # &e HELPERS_AGG # &s PREP_FRANCE - Série nationale (vraies médianes) dvf_france_raw <- read.csv(file.path(PDVF_ROOT, "data/exports/agg_france_annuel.csv"), stringsAsFactors = FALSE, fileEncoding = "UTF-8") dvf_france_type <- dvf_france_raw %>% filter(annee >= 2014) %>% select(annee, type_bien, px_m2 = prix_m2_median, nb_trans = nb_mutations, mois_max) dvf_france <- dvf_france_type %>% filter(type_bien == "Global") %>% select(annee, px_m2, nb_trans, mois_max) dvf_trans_total <- dvf_france_type %>% filter(type_bien %in% c("Maison", "Appartement")) %>% group_by(annee) %>% summarise(nb_trans_total = sum(nb_trans), mois_max = first(mois_max), .groups = "drop") # SITADEL national sitadel_france <- sitadel_comm %>% group_by(annee = as.integer(ANNEE)) %>% summarise(log_com = sum(LOG_COM, na.rm = TRUE), .groups = "drop") # Indices 100 prix par type idx_france_type <- dvf_france_type %>% filter(annee >= BASE_YEAR, type_bien %in% c("Maison", "Appartement")) %>% group_by(type_bien) %>% mutate( idx_prix = px_m2 / px_m2[annee == BASE_YEAR] * 100, idx_trans = nb_trans / nb_trans[annee == BASE_YEAR] * 100 ) %>% ungroup() # Indices 100 volumes (transactions + construction) idx_volumes <- dvf_trans_total %>% filter(annee >= BASE_YEAR) %>% mutate(idx_trans = nb_trans_total / nb_trans_total[annee == BASE_YEAR] * 100) %>% left_join( sitadel_france %>% filter(annee >= BASE_YEAR) %>% mutate(idx_constr = log_com / log_com[annee == BASE_YEAR] * 100), by = "annee" ) idx_france <- dvf_france %>% filter(annee >= BASE_YEAR) %>% mutate( idx_prix = px_m2 / px_m2[annee == BASE_YEAR] * 100, idx_trans = nb_trans / nb_trans[annee == BASE_YEAR] * 100 ) # KPIs fr_px_2024 <- dvf_france %>% filter(annee == 2024) %>% pull(px_m2) %>% round(0) fr_px_2022 <- dvf_france %>% filter(annee == 2022) %>% pull(px_m2) %>% round(0) fr_px_2016 <- dvf_france %>% filter(annee == 2016) %>% pull(px_m2) %>% round(0) fr_trans_2024 <- dvf_trans_total %>% filter(annee == 2024) %>% pull(nb_trans_total) fr_trans_2022 <- dvf_trans_total %>% filter(annee == 2022) %>% pull(nb_trans_total) fr_evol_px_2224 <- round((fr_px_2024 / fr_px_2022 - 1) * 100, 1) fr_evol_px_1624 <- round((fr_px_2024 / fr_px_2016 - 1) * 100, 1) fr_evol_trans_2224 <- round((fr_trans_2024 / fr_trans_2022 - 1) * 100, 0) sit_2025 <- sitadel_france %>% filter(annee == 2025) %>% pull(log_com) sit_2022 <- sitadel_france %>% filter(annee == 2022) %>% pull(log_com) sit_evol_2225 <- round((sit_2025 / sit_2022 - 1) * 100, 0) pic_idx_prix <- idx_france %>% slice_max(idx_prix, n = 1) log_step("SETUP", n_communes_dvf = nrow(dvf_typo), n_ze = nrow(dvf_ze), fr_px_2024 = fr_px_2024, fr_evol_px_2224 = fr_evol_px_2224, fr_evol_trans_2224 = fr_evol_trans_2224, sit_evol_2225 = sit_evol_2225) # &e PREP_FRANCE # &s PREP_SERIES_TYPO serie_t4p <- agg_serie(dvf_typo, "typo4p") %>% filter(annee >= BASE_YEAR) %>% add_indice100("px_m2", "grp", BASE_YEAR) serie_t9f <- agg_serie(dvf_typo, "typo9fs") %>% filter(annee >= BASE_YEAR) %>% add_indice100("px_m2", "grp", BASE_YEAR) serie_paris <- dvf_typo %>% filter(!is.na(zone_paris), annee >= BASE_YEAR, !is.na(prix_m2_median), nb_mutations >= 5) %>% group_by(grp = zone_paris, annee) %>% summarise( px_m2 = weighted.mean(prix_m2_median, nb_mutations, na.rm = TRUE), nb_trans = sum(nb_mutations, na.rm = TRUE), .groups = "drop" ) %>% add_indice100("px_m2", "grp", BASE_YEAR) serie_paris_ref <- dvf_france %>% filter(annee >= BASE_YEAR) %>% mutate(grp = "France") %>% add_indice100("px_m2", "grp", BASE_YEAR) %>% bind_rows(serie_paris) # Paris KPIs pour .insight (avant chunk) paris_idx_pre <- serie_paris_ref %>% filter(annee == 2024) idx_paris_v <- round(paris_idx_pre$indice[paris_idx_pre$grp == "Paris intra-muros"], 1) idx_pc_v <- round(paris_idx_pre$indice[paris_idx_pre$grp == "Petite couronne"], 1) idx_fr_v <- round(paris_idx_pre$indice[paris_idx_pre$grp == "France"], 1) # &e PREP_SERIES_TYPO # &s PREP_ZE_CARTES - Prix/trans ZE 2016-2024 pour cartes ze_evol <- dvf_ze %>% filter(type_bien == "Maison", !is.na(prix_m2_median), annee %in% c(2016, 2019, 2022, 2024)) %>% select(code_ze, annee, prix_m2_median, nb_mutations) %>% tidyr::pivot_wider(id_cols = code_ze, names_from = annee, values_from = c(prix_m2_median, nb_mutations), names_sep = "_") %>% mutate( evol_px_p1 = ifelse(prix_m2_median_2016 > 0, (prix_m2_median_2019 - prix_m2_median_2016) / prix_m2_median_2016 * 100, NA), evol_px_p2 = ifelse(prix_m2_median_2019 > 0, (prix_m2_median_2022 - prix_m2_median_2019) / prix_m2_median_2019 * 100, NA), evol_px_p3 = ifelse(prix_m2_median_2022 > 0, (prix_m2_median_2024 - prix_m2_median_2022) / prix_m2_median_2022 * 100, NA), evol_glob = ifelse(prix_m2_median_2016 > 0, (prix_m2_median_2024 - prix_m2_median_2016) / prix_m2_median_2016 * 100, NA), evol_tr_p1 = ifelse(nb_mutations_2016 > 0, (nb_mutations_2019 - nb_mutations_2016) / nb_mutations_2016 * 100, NA), evol_tr_p2 = ifelse(nb_mutations_2019 > 0, (nb_mutations_2022 - nb_mutations_2019) / nb_mutations_2019 * 100, NA), evol_tr_p3 = ifelse(nb_mutations_2022 > 0, (nb_mutations_2024 - nb_mutations_2022) / nb_mutations_2022 * 100, NA) ) # SITADEL par ZE — construction 2022-2025 (SITADEL complet) sitadel_ze <- sitadel_comm %>% inner_join(tdc %>% select(CODGEO, ZE2020, PMUN22), by = c("COMM" = "CODGEO")) %>% group_by(code_ze = ZE2020, annee = as.integer(ANNEE)) %>% summarise( log_com = sum(LOG_COM, na.rm = TRUE), pop = sum(PMUN22, na.rm = TRUE), .groups = "drop" ) %>% mutate(log_com_tx1000 = log_com / pop * 1000) sitadel_ze_moy <- sitadel_ze %>% filter(annee >= 2022, annee <= 2025) %>% group_by(code_ze) %>% summarise( log_com_moy = mean(log_com, na.rm = TRUE), log_com_tx1000_moy = mean(log_com_tx1000, na.rm = TRUE), .groups = "drop" ) # SITADEL ZE evolution par période (point-to-point) sitadel_ze_pts <- sitadel_ze %>% filter(annee %in% c(2016, 2019, 2022, 2024)) %>% select(code_ze, annee, log_com) %>% tidyr::pivot_wider(names_from = annee, values_from = log_com, names_prefix = "sit_") %>% mutate( evol_constr_p1 = ifelse(!is.na(sit_2016) & sit_2016 > 20, (sit_2019 - sit_2016) / sit_2016 * 100, NA), evol_constr_p2 = ifelse(!is.na(sit_2019) & sit_2019 > 20, (sit_2022 - sit_2019) / sit_2019 * 100, NA), evol_constr_p3 = ifelse(!is.na(sit_2022) & sit_2022 > 20, (sit_2024 - sit_2022) / sit_2022 * 100, NA), evol_constr_glob = ifelse(!is.na(sit_2016) & sit_2016 > 20, (sit_2024 - sit_2016) / sit_2016 * 100, NA) ) # Prix appartements par ZE (2024) ze_appt <- dvf_ze %>% filter(type_bien == "Appartement", !is.na(prix_m2_median), annee == 2024) %>% select(code_ze, prix_appt_2024 = prix_m2_median) shp_ze_data <- shp_ze %>% left_join(ze_evol, by = c("ZE2020" = "code_ze")) %>% left_join(sitadel_ze_moy, by = c("ZE2020" = "code_ze")) %>% left_join(sitadel_ze_pts, by = c("ZE2020" = "code_ze")) %>% left_join(ze_appt, by = c("ZE2020" = "code_ze")) %>% left_join(lib_ze, by = "ZE2020") # Stats ZE pour KPI et narratifs (avant les chunks graphiques) med_px <- round(median(shp_ze_data$prix_m2_median_2024, na.rm = TRUE), 0) q1_px <- round(quantile(shp_ze_data$prix_m2_median_2024, 0.25, na.rm = TRUE), 0) q3_px <- round(quantile(shp_ze_data$prix_m2_median_2024, 0.75, na.rm = TRUE), 0) med_constr <- round(median(shp_ze_data$log_com_tx1000_moy, na.rm = TRUE), 2) # Stats construction evolution (pour .insight avant chunk) n_ze_baisse_c <- sum(shp_ze_data$evol_constr_p3 < -10, na.rm = TRUE) n_ze_hausse_c <- sum(shp_ze_data$evol_constr_p3 > 10, na.rm = TRUE) med_constr_p3 <- round(median(shp_ze_data$evol_constr_p3, na.rm = TRUE), 0) # Stats prix evolution (pour .insight avant chunk) n_ze_baisse <- sum(ze_evol$evol_px_p3 < -2, na.rm = TRUE) n_ze_hausse <- sum(ze_evol$evol_px_p3 > 2, na.rm = TRUE) n_ze_stable <- sum(abs(ze_evol$evol_px_p3) <= 2, na.rm = TRUE) med_evol_px_p3 <- round(median(ze_evol$evol_px_p3, na.rm = TRUE), 1) med_evol_px_p2 <- round(median(ze_evol$evol_px_p2, na.rm = TRUE), 1) # Top/bottom ZE pour KPI et narratifs top3_ze_px <- ze_evol %>% left_join(lib_ze, by = c("code_ze" = "ZE2020")) %>% filter(!is.na(evol_px_p3)) %>% slice_max(evol_px_p3, n = 3) bot3_ze_px <- ze_evol %>% left_join(lib_ze, by = c("code_ze" = "ZE2020")) %>% filter(!is.na(evol_px_p3)) %>% slice_min(evol_px_p3, n = 3) # &e PREP_ZE_CARTES # &s PREP_TOP_ZE top_codes <- dvf_ze %>% filter(annee == 2024) %>% group_by(code_ze) %>% summarise(tot = sum(nb_mutations, na.rm = TRUE), .groups = "drop") %>% slice_max(tot, n = 30) %>% pull(code_ze) tbl_ze <- ze_evol %>% filter(code_ze %in% top_codes) %>% left_join(lib_ze, by = c("code_ze" = "ZE2020")) %>% arrange(evol_px_p3) # &e PREP_TOP_ZE # &s GGPLOT_HELPERS - Helper choroplèthe (th_map importé de jcn-ggmapstatic.R) gg_carte <- function(data, var, palette, breaks, title = NULL, legend_title = NULL, show_legend = TRUE, digits = 0, sign_prefix = FALSE) { data$bin <- cut(data[[var]], breaks = breaks, include.lowest = TRUE) lvls <- levels(data$bin) counts <- as.integer(table(data$bin)) uppers <- round(breaks[-1], digits) lowers <- round(breaks[-length(breaks)], digits) labels <- vapply(seq_along(lvls), function(i) { lo <- lowers[i]; hi <- uppers[i] fmt_v <- function(x) { s <- formatC(x, format = "f", digits = digits, big.mark = " ") if (sign_prefix && x > 0) s <- paste0("+", s) s } if (is.infinite(lo)) { txt <- paste0("< ", fmt_v(hi)) } else if (is.infinite(hi)) { txt <- paste0("> ", fmt_v(lo)) } else { txt <- fmt_v(hi) } paste0(txt, "\n(", counts[i], ")") }, character(1)) names(labels) <- lvls pal <- setNames(palette[seq_len(length(lvls))], lvls) p <- ggplot(data) + geom_sf(aes(fill = bin), color = "grey85", linewidth = 0.12) + scale_fill_manual(values = pal, labels = labels, name = legend_title, na.value = "#e8e8e8", drop = FALSE, guide = if (show_legend) { guide_legend(nrow = 1, override.aes = list(color = NA), label.position = "bottom") } else "none") + th_map + theme(plot.title = element_text(size = 9, hjust = 0.5), legend.text = element_text(size = 7, lineheight = 1.1)) if (!is.null(title)) p <- p + labs(title = title) p } # Annotations top/bottom ZE sur cartes add_map_annot <- function(p, data, var, n_top = 3, n_bot = 3, sign_prefix = FALSE, digits = 0, suffix = "") { d <- data[!is.na(data[[var]]),] parts <- list() if (n_top > 0) parts[[length(parts) + 1]] <- d[order(-d[[var]]),][1:min(n_top, nrow(d)),] if (n_bot > 0) parts[[length(parts) + 1]] <- d[order(d[[var]]),][1:min(n_bot, nrow(d)),] pts <- do.call(rbind, parts) pts_c <- sf::st_centroid(pts) vals <- round(pts_c[[var]], digits) fmt <- if (sign_prefix) sprintf("%+.*f%s", digits, vals, suffix) else paste0(formatC(vals, format = "f", digits = digits, big.mark = " "), suffix) pts_c$lbl <- paste0(pts_c$ZE2020lib, "\n", fmt) p + ggrepel::geom_label_repel( data = pts_c, aes(geometry = geometry, label = lbl), stat = "sf_coordinates", size = 2, family = .font_family, fontface = "bold", fill = alpha("white", 0.85), label.size = 0.2, color = "#333", segment.color = "#999", segment.size = 0.3, force = 8, force_pull = 0.2, min.segment.length = 0, seed = 42, box.padding = 0.3, lineheight = 0.85, max.overlaps = 12, inherit.aes = FALSE) } # &e GGPLOT_HELPERS # Bandes périodes (réutilisées dans plusieurs graphiques) rect_periods <- data.frame( xmin = c(2016, 2019, 2022), xmax = c(2019, 2022, 2025), fill = c("Reprise", "Boom", "Retournement") ) period_colors <- c("Reprise" = "#d4e8f0", "Boom" = "#d5edd0", "Retournement" = "#f5d5d5") # &e _aaMAIN ``` ```{r} #| label: chapeau-kpi #| results: asis #| echo: false mk <- function(text, detail = "") { d <- if (nzchar(detail)) paste0('
', detail, '
') else "" paste0('
', text, '
', d, '
') } css <- '' col_left <- sprintf('

Après huit années de hausse quasi continue, le marché immobilier français a basculé en 2022 dans une phase de correction brutale. Les transactions se sont effondrées de %s %%, la construction neuve a reculé de %s %% depuis 2022, mais les prix ne corrigent que de %s %%. Un marché visqueux qui ajuste par les quantités, pas par les prix.

Cette note synthétise neuf années de dynamique immobilière à partir des Demandes de Valeurs Foncières (DVF 2016-2025) et de SITADEL (2016-2025), pour 278 zones d\'emploi déclinées selon les typologies urbaines France Stratégie.

', fmt_sign(fr_evol_trans_2224, 0), fmt_sign(sit_evol_2225, 0), fmt_sign(fr_evol_px_2224, 1)) col_right <- sprintf('

Questions clés

Principaux résultats : l\'effondrement des transactions est généralisé (279 ZE en baisse, médiane −%s %%), mais la correction des prix est inégale — les métropoles corrigent, le littoral et le rural résistent. Les couronnes surperforment les pôles à toutes les échelles.

', abs(round(median(ze_evol$evol_tr_p3, na.rm = TRUE), 0))) top1 <- top3_ze_px[1,] bot1 <- bot3_ze_px[1,] c1 <- paste0('
Marché 2024
', mk(sprintf('%s €/m²', fmt_fr(fr_px_2024, 0)), 'Prix médian France · tous biens'), mk(sprintf('%s k transactions', round(fr_trans_2024/1000, 0)), 'Maisons + appartements'), mk(sprintf('%s k logements commencés', round(sit_2025/1000, 0)), 'SITADEL 2025 · point bas historique'), '
') c2 <- paste0('
', '
Correction 2022 → 2024
', mk(sprintf('%s %% prix au m²', fmt_sign(fr_evol_px_2224, 1)), 'Ajustement modéré'), mk(sprintf('%s %% transactions', fmt_sign(fr_evol_trans_2224, 0)), 'Effondrement généralisé'), mk(sprintf('%s %% construction', fmt_sign(sit_evol_2225, 0)), 'SITADEL 2022 → 2025'), '
') c3 <- paste0('
Disparités territoriales
', mk(sprintf('%s ZE en baisse / %s en hausse', n_ze_baisse, n_ze_hausse), 'Prix 2022 → 2024'), mk(sprintf('↑ %s %s %%', top1$ZE2020lib, fmt_sign(round(top1$evol_px_p3, 1), 1)), 'Plus forte hausse prix'), mk(sprintf('↓ %s %s %%', bot1$ZE2020lib, fmt_sign(round(bot1$evol_px_p3, 1), 1)), 'Plus forte baisse prix'), '
') html <- paste0(css, '
', '

En synthèse

', '
', col_left, col_right, '
', '
Chiffres clés
', '
', c1, c2, c3, '
', '
') cat(gsub(">\\s+<", "><", html)) ``` ::: {.callout-note collapse="true" title="Périmètre et sources"} - **DVF** : Demandes de Valeurs Foncières (SIRENE), mutations à titre onéreux 2014-2025, pipeline pdvf-BatnatDvf (DuckDB). Vraies médianes nationales (9,5 M mutations). - **SITADEL** : Logements commencés, mises en chantier résidentielles 2011-2025 (SDES). Année 2025 complète. - **Typologies** : TYPO4 périurb (4 classes), TYPO9fs France Stratégie pôle/couronne × taille (9 classes), Paris + PC (47 communes). - **Périodes** : 2016-2019 (reprise), 2019-2022 (boom), 2022-2024/2025 (retournement). DVF 2025 = S1 provisoire, utilisé seulement pour l'indice 100. ::: ## Cadrage national [**Prix en correction modérée (`r fmt_sign(fr_evol_px_2224, 1)` % depuis 2022), mais effondrement des volumes : transactions `r fmt_sign(fr_evol_trans_2224, 0)` %, construction `r fmt_sign(sit_evol_2225, 0)` %. Le marché ajuste par les quantités, pas par les prix.**]{.insight} ```{r} #| label: plt-national-side-by-side #| fig-width: 14 #| fig-height: 5.5 #| echo: false #| column: page # --- Indice 100 (gauche) --- idx_all <- bind_rows( idx_france_type %>% filter(type_bien == "Maison") %>% transmute(annee, serie = "Prix maisons", indice = idx_prix, mois_max), idx_france_type %>% filter(type_bien == "Appartement") %>% transmute(annee, serie = "Prix appartements", indice = idx_prix, mois_max), idx_volumes %>% filter(annee <= 2024) %>% transmute(annee, serie = "Transactions (mai.+apt.)", indice = idx_trans, mois_max = 12L), idx_volumes %>% filter(!is.na(idx_constr)) %>% transmute(annee, serie = "Construction SITADEL", indice = idx_constr, mois_max = 12L) ) serie_colors <- c( "Prix maisons" = col_cyan, "Prix appartements" = col_cyan, "Transactions (mai.+apt.)" = col_orange, "Construction SITADEL" = col_green ) serie_ltys <- c( "Prix maisons" = "solid", "Prix appartements" = "dashed", "Transactions (mai.+apt.)" = "solid", "Construction SITADEL" = "solid" ) idx_solid <- idx_all %>% filter(annee < 2025 | (annee == 2025 & mois_max == 12)) idx_dot <- idx_all %>% filter(annee >= 2024, mois_max < 12 | annee == 2024) idx_labels <- idx_all %>% group_by(serie) %>% filter(annee == max(annee)) %>% ungroup() p_idx <- ggplot() + geom_rect(data = rect_periods, aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = fill), alpha = 0.25) + scale_fill_manual(values = period_colors, name = NULL) + geom_hline(yintercept = 100, linetype = "dashed", color = col_gray, linewidth = 0.3) + geom_line(data = idx_solid, aes(x = annee, y = indice, color = serie, linetype = serie), linewidth = 0.8) + geom_point(data = idx_solid, aes(x = annee, y = indice, color = serie), size = 1.5) + geom_line(data = idx_dot, aes(x = annee, y = indice, color = serie, group = serie), linetype = "dotted", linewidth = 0.8) + geom_point(data = idx_all %>% filter(annee == 2025, mois_max < 12), aes(x = annee, y = indice, color = serie), size = 2, shape = 1) + ggrepel::geom_text_repel( data = idx_labels, aes(x = annee, y = indice, label = paste0(serie, " : ", round(indice, 0)), color = serie), hjust = 0, nudge_x = 0.2, size = 2.5, direction = "y", segment.color = "grey70", show.legend = FALSE) + annotate("text", x = 2025, y = min(idx_all$indice, na.rm = TRUE) - 3, label = "2025 : S1 provisoire (DVF)", size = 2.3, fontface = "italic", color = "#888888", hjust = 0.5) + scale_color_manual(values = serie_colors, name = NULL) + scale_linetype_manual(values = serie_ltys, name = NULL) + scale_x_continuous(breaks = BASE_YEAR:2025, limits = c(BASE_YEAR, 2026.5)) + labs(title = "Indice 100 — prix, transactions et construction", subtitle = "Base 2016 · DVF + SITADEL", x = NULL, y = "Indice (base 100 = 2016)") + guides(fill = guide_legend(order = 1), color = guide_legend(order = 2), linetype = guide_legend(order = 2)) + theme(legend.position = "top", legend.box = "horizontal", legend.text = element_text(size = 7.5), plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) # --- Volumes (droite) --- vol_dvf <- dvf_trans_total %>% filter(annee >= BASE_YEAR, annee <= 2024) %>% transmute(annee, type = "Transactions DVF", volume = nb_trans_total / 1000) vol_sit <- sitadel_france %>% filter(annee >= BASE_YEAR) %>% transmute(annee, type = "Logements commencés", volume = log_com / 1000) vol_all <- bind_rows(vol_dvf, vol_sit) type_colors <- c("Transactions DVF" = col_cyan, "Logements commencés" = col_orange) p_vol <- ggplot(vol_all, aes(x = annee, y = volume, fill = type)) + geom_col(position = position_dodge(width = 0.7), width = 0.6, alpha = 0.9) + geom_text(aes(label = round(volume, 0)), position = position_dodge(width = 0.7), vjust = -0.4, size = 2.3, fontface = "bold") + scale_fill_manual(values = type_colors, name = NULL) + scale_x_continuous(breaks = BASE_YEAR:2025) + scale_y_continuous(expand = expansion(mult = c(0, 0.12))) + labs(title = "Volumes — transactions et construction", subtitle = "Milliers · France entière", x = NULL, y = "Milliers", caption = make_source("DVF 2016-2024", "SITADEL 2016-2025")) + theme(legend.position = "top", legend.text = element_text(size = 7.5), plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) gridExtra::grid.arrange( p_idx + theme(plot.margin = margin(5, 25, 5, 5)), p_vol + theme(plot.margin = margin(5, 5, 5, 25)), ncol = 2) # Logging pic_mai <- idx_france_type %>% filter(type_bien == "Maison") %>% slice_max(idx_prix, n = 1) pic_apt <- idx_france_type %>% filter(type_bien == "Appartement") %>% slice_max(idx_prix, n = 1) fin_mai <- idx_france_type %>% filter(type_bien == "Maison", annee == 2024) fin_apt <- idx_france_type %>% filter(type_bien == "Appartement", annee == 2024) log_step("P1_INDICE100", pic_maison_annee = pic_mai$annee, pic_maison_idx = round(pic_mai$idx_prix, 1), pic_appart_annee = pic_apt$annee, pic_appart_idx = round(pic_apt$idx_prix, 1), fin_maison_idx_2024 = round(fin_mai$idx_prix, 1), fin_appart_idx_2024 = round(fin_apt$idx_prix, 1), idx_constr_2025 = round(idx_volumes$idx_constr[idx_volumes$annee == 2025], 1)) log_step("P1_VOLUMES", trans_2022 = round(vol_dvf$volume[vol_dvf$annee == 2022], 0), trans_2024 = round(vol_dvf$volume[vol_dvf$annee == 2024], 0), constr_2022 = round(vol_sit$volume[vol_sit$annee == 2022], 0), constr_2025 = round(vol_sit$volume[vol_sit$annee == 2025], 0)) ``` La déconnexion entre prix et volumes est le fait saillant de cette période. Les prix ont atteint leur pic en 2022 (indice `r round(pic_mai$idx_prix, 0)` pour les maisons, `r round(pic_apt$idx_prix, 0)` pour les appartements, base 100 en 2016) et ne corrigent que modérément depuis : maisons à `r round(fin_mai$idx_prix, 0)`, appartements à `r round(fin_apt$idx_prix, 0)` en 2024. L’ajustement se fait intégralement par les quantités : les transactions passent de `r round(vol_dvf$volume[vol_dvf$annee == 2022], 0)` 000 en 2022 à `r round(vol_dvf$volume[vol_dvf$annee == 2024], 0)` 000 en 2024 (`r fmt_sign(fr_evol_trans_2224, 0)` %), et la construction neuve s’effondre à un indice de `r round(idx_volumes$idx_constr[idx_volumes$annee == 2025], 0)` en 2025 — un point bas historique. Ce schéma classique de *marché visqueux*, où la rigidité à la baisse des prix immobiliers contraint l’ajustement à passer par les volumes, est commun aux retournements immobiliers français. ## Géographie du retournement [**Les 278 zones d’emploi ne vivent pas le même retournement. L’héliotropisme, la taille de l’aire urbaine et la position pôle/couronne dessinent des trajectoires contrastées : prix médian de `r fmt_fr(q1_px, 0)` €/m² dans le Grand Est à `r fmt_fr(q3_px, 0)` €/m² sur le littoral.**]{.insight} ### Un marché à deux vitesses : prix élevés, construction au plancher ```{r} #| label: plt-carte-ze-niveaux #| fig-width: 20 #| fig-height: 6.5 #| echo: false #| column: page n_ze <- sum(!is.na(shp_ze_data$prix_m2_median_2024)) n_ze_appt <- sum(!is.na(shp_ze_data$prix_appt_2024)) brks_px <- c(-Inf, make_seq_breaks(shp_ze_data$prix_m2_median_2024), Inf) c1 <- gg_carte(shp_ze_data, "prix_m2_median_2024", pal_seq7_byrv, brks_px, "Prix m² maisons 2024", paste0("€/m² — ", n_ze, " ZE"), digits = 0) c1 <- add_map_annot(c1, shp_ze_data, "prix_m2_median_2024", 3, 3, suffix = " €") brks_appt <- c(-Inf, make_seq_breaks(shp_ze_data$prix_appt_2024), Inf) c2 <- gg_carte(shp_ze_data, "prix_appt_2024", pal_seq7_byrv, brks_appt, "Prix m² appartements 2024", paste0("€/m² — ", n_ze_appt, " ZE"), digits = 0) c2 <- add_map_annot(c2, shp_ze_data, "prix_appt_2024", 3, 3, suffix = " €") brks_sit <- c(-Inf, make_seq_breaks(shp_ze_data$log_com_tx1000_moy), Inf) c3 <- gg_carte(shp_ze_data, "log_com_tx1000_moy", pal_seq7_byrv, brks_sit, "Construction moy. 2022-2025", paste0("log./1000 hab — ", n_ze, " ZE"), digits = 1) c3 <- add_map_annot(c3, shp_ze_data, "log_com_tx1000_moy", 3, 3, digits = 1, suffix = "‰") gridExtra::grid.arrange(c1, c2, c3, ncol = 3) med_px <- round(median(shp_ze_data$prix_m2_median_2024, na.rm = TRUE), 0) med_constr <- round(median(shp_ze_data$log_com_tx1000_moy, na.rm = TRUE), 2) q1_px <- round(quantile(shp_ze_data$prix_m2_median_2024, 0.25, na.rm = TRUE), 0) q3_px <- round(quantile(shp_ze_data$prix_m2_median_2024, 0.75, na.rm = TRUE), 0) log_step("P2_CARTES_NIVEAUX", n_ze = n_ze, med_prix_ze_2024 = med_px, q1_prix = q1_px, q3_prix = q3_px, med_constr_tx1000 = med_constr) log_result("carte_niveaux_prix", value = list(mediane = med_px, Q1 = q1_px, Q3 = q3_px, n = n_ze), interpret = sprintf("Prix médian ZE = %s €/m², IQR [%s ; %s]", fmt_fr(med_px, 0), fmt_fr(q1_px, 0), fmt_fr(q3_px, 0))) ``` Le gradient géographique est net : au sud de la Loire et sur le littoral atlantique, les prix maisons dépassent `r fmt_fr(q3_px, 0)` €/m² ; dans le Grand Est, le Centre et les Hauts-de-France, ils restent sous `r fmt_fr(q1_px, 0)` €/m² (prix médian ZE = `r fmt_fr(med_px, 0)` €/m², écart interquartile [ `r fmt_fr(q1_px, 0)` ; `r fmt_fr(q3_px, 0)` ]). La construction neuve est plus soutenue dans les zones sous tension démographique — arc atlantique, Occitanie, vallée du Rhône — avec une médiane de `r med_constr` logements pour 1 000 habitants. ### Construction : un effondrement généralisé et sans précédent [**`r n_ze_baisse_c` zones d’emploi en recul de plus de 10 % sur 2022-2024. Médiane : `r fmt_sign(med_constr_p3, 0)` %. L’effondrement est quasi généralisé, porté par la hausse des coûts de construction et le durcissement du crédit.**]{.insight} ```{r} #| label: plt-triptyque-constr #| fig-width: 20 #| fig-height: 7.5 #| echo: false #| column: page # Légende unique : mêmes breaks pour les 4 cartes = même couleur = même réalité brks_constr <- c(-Inf, -50, -25, -10, -2, 2, 10, 25, 50, Inf) cc1 <- gg_carte(shp_ze_data, "evol_constr_p1", pal_div_rdbu, brks_constr, "2016 → 2019 (3 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cc2 <- gg_carte(shp_ze_data, "evol_constr_p2", pal_div_rdbu, brks_constr, "2019 → 2022 (3 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cc3 <- gg_carte(shp_ze_data, "evol_constr_p3", pal_div_rdbu, brks_constr, "2022 → 2024 (2 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cc4 <- gg_carte(shp_ze_data, "evol_constr_glob", pal_div_rdbu, brks_constr, "2016 → 2024 (8 ans)", "Évol. construction (%)", show_legend = TRUE, digits = 0, sign_prefix = TRUE) + theme(plot.background = element_rect(fill = "#f8f7f4", color = "#bbbbbb", linewidth = 0.5), plot.margin = margin(8, 5, 5, 5)) cc1 <- add_map_annot(cc1, shp_ze_data, "evol_constr_p1", 2, 2, sign_prefix = TRUE, suffix = "%") cc2 <- add_map_annot(cc2, shp_ze_data, "evol_constr_p2", 2, 2, sign_prefix = TRUE, suffix = "%") cc3 <- add_map_annot(cc3, shp_ze_data, "evol_constr_p3", 2, 2, sign_prefix = TRUE, suffix = "%") cc4 <- add_map_annot(cc4, shp_ze_data, "evol_constr_glob", 3, 3, sign_prefix = TRUE, suffix = "%") gridExtra::grid.arrange( gridExtra::arrangeGrob(grobs = list(cc1, cc2, cc3, cc4), ncol = 4, top = grid::textGrob("Évolution de la construction (logements commencés, SITADEL)", gp = grid::gpar(fontsize = 11, fontface = "bold", col = "#666666", fontfamily = .font_family)), bottom = grid::textGrob("Note : périodes de 3 ans, 3 ans, 2 ans et 8 ans. Évolutions non annualisées. Légende commune aux 4 cartes.", gp = grid::gpar(fontsize = 8, fontface = "italic", col = "#999999", fontfamily = .font_family)))) n_ze_baisse_c <- sum(shp_ze_data$evol_constr_p3 < -10, na.rm = TRUE) n_ze_hausse_c <- sum(shp_ze_data$evol_constr_p3 > 10, na.rm = TRUE) med_constr_p3 <- round(median(shp_ze_data$evol_constr_p3, na.rm = TRUE), 0) ``` Le retournement de la construction neuve précède celui des prix : dès 2019-2022, la majorité des ZE recule, avant un effondrement généralisé en 2022-2024 (médiane `r fmt_sign(med_constr_p3, 0)` %). Sur 278 ZE, `r n_ze_baisse_c` affichent un recul supérieur à 10 %. La 4ème carte (2016→2024) montre que le bilan global reste négatif pour l’essentiel du territoire : la combinaison de la hausse des coûts de construction (+30 % sur les matériaux), du durcissement des conditions de crédit et du ralentissement des permis explique cette contraction sans précédent depuis 2008. ### Prix : la correction post-2022 épargne le littoral et le rural [**Médiane +`r med_evol_px_p2` % pendant le boom 2019-2022, mais seulement `r med_evol_px_p3` % en 2022-2024. `r n_ze_baisse` ZE en baisse vs `r n_ze_hausse` en hausse — le littoral et le rural résistent là où les métropoles corrigent.**]{.insight} ```{r} #| label: plt-triptyque-prix #| fig-width: 20 #| fig-height: 7.5 #| echo: false #| column: page # Légende unique : mêmes breaks pour les 4 cartes = comparabilité visuelle brks_prix <- c(-Inf, -15, -8, -3, 0, 3, 8, 15, 30, Inf) cp1 <- gg_carte(shp_ze_data, "evol_px_p1", pal_div_rdbu, brks_prix, "2016 → 2019 (3 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cp2 <- gg_carte(shp_ze_data, "evol_px_p2", pal_div_rdbu, brks_prix, "2019 → 2022 (3 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cp3 <- gg_carte(shp_ze_data, "evol_px_p3", pal_div_rdbu, brks_prix, "2022 → 2024 (2 ans)", NULL, show_legend = FALSE, digits = 0, sign_prefix = TRUE) cp4 <- gg_carte(shp_ze_data, "evol_glob", pal_div_rdbu, brks_prix, "2016 → 2024 (8 ans)", "Évol. prix (%)", show_legend = TRUE, digits = 0, sign_prefix = TRUE) + theme(plot.background = element_rect(fill = "#f8f7f4", color = "#bbbbbb", linewidth = 0.5), plot.margin = margin(8, 5, 5, 5)) cp1 <- add_map_annot(cp1, shp_ze_data, "evol_px_p1", 2, 2, sign_prefix = TRUE, suffix = "%") cp2 <- add_map_annot(cp2, shp_ze_data, "evol_px_p2", 2, 2, sign_prefix = TRUE, suffix = "%") cp3 <- add_map_annot(cp3, shp_ze_data, "evol_px_p3", 2, 2, sign_prefix = TRUE, suffix = "%") cp4 <- add_map_annot(cp4, shp_ze_data, "evol_glob", 3, 3, sign_prefix = TRUE, suffix = "%") gridExtra::grid.arrange( gridExtra::arrangeGrob(grobs = list(cp1, cp2, cp3, cp4), ncol = 4, top = grid::textGrob("Évolution des prix m² maisons (DVF)", gp = grid::gpar(fontsize = 11, fontface = "bold", col = "#666666", fontfamily = .font_family)), bottom = grid::textGrob("Note : périodes de 3 ans, 3 ans, 2 ans et 8 ans. Évolutions non annualisées. Légende commune aux 4 cartes.", gp = grid::gpar(fontsize = 8, fontface = "italic", col = "#999999", fontfamily = .font_family)))) n_ze_baisse <- sum(ze_evol$evol_px_p3 < -2, na.rm = TRUE) n_ze_hausse <- sum(ze_evol$evol_px_p3 > 2, na.rm = TRUE) n_ze_stable <- sum(abs(ze_evol$evol_px_p3) <= 2, na.rm = TRUE) med_evol_px_p3 <- round(median(ze_evol$evol_px_p3, na.rm = TRUE), 1) med_evol_px_p2 <- round(median(ze_evol$evol_px_p2, na.rm = TRUE), 1) log_step("P2_CARTES_EVOL_PRIX", n_ze_baisse_p3 = n_ze_baisse, n_ze_hausse_p3 = n_ze_hausse, n_ze_stable_p3 = n_ze_stable, mediane_evol_px_p3 = med_evol_px_p3, mediane_evol_px_p2 = med_evol_px_p2) log_result("evol_prix_territorial", value = list(baisse = n_ze_baisse, hausse = n_ze_hausse, stable = n_ze_stable, med_p2 = med_evol_px_p2, med_p3 = med_evol_px_p3), interpret = sprintf("Retournement asymétrique : %d ZE en baisse vs %d en hausse (médiane %+.1f%%)", n_ze_baisse, n_ze_hausse, med_evol_px_p3)) n_ze_baisse_tr <- sum(ze_evol$evol_tr_p3 < -2, na.rm = TRUE) n_ze_hausse_tr <- sum(ze_evol$evol_tr_p3 > 2, na.rm = TRUE) med_evol_tr_p3 <- round(median(ze_evol$evol_tr_p3, na.rm = TRUE), 1) log_step("P2_CARTES_EVOL_TRANS", n_ze_baisse_trans_p3 = n_ze_baisse_tr, n_ze_hausse_trans_p3 = n_ze_hausse_tr, mediane_evol_tr_p3 = med_evol_tr_p3) log_result("evol_trans_territorial", value = list(baisse = n_ze_baisse_tr, hausse = n_ze_hausse_tr, med_p3 = med_evol_tr_p3), interpret = sprintf("Effondrement généralisé : %d/%d ZE en baisse (médiane %+.1f%%)", n_ze_baisse_tr, n_ze, med_evol_tr_p3)) ``` Le contraste entre les quatre cartes est saisissant. Pendant le boom 2019-2022, la quasi-totalité des ZE vire au bleu (hausse), avec une médiane de +`r med_evol_px_p2` %. En 2022-2024, le retournement touche d’abord les grandes métropoles et l’Île-de-France (`r n_ze_baisse` ZE en baisse, médiane `r ifelse(med_evol_px_p3 > 0, "+", "")``r med_evol_px_p3` %), tandis que le littoral méditerranéen et l’arc atlantique conservent des prix stables ou en légère hausse. La 4ème carte (bilan 2016-2024) révèle que malgré la correction récente, la quasi-totalité des territoires affiche un bilan positif sur l’ensemble de la période. L’effondrement des transactions, lui, est quasi universel (`r n_ze_baisse_tr` ZE en recul, médiane `r ifelse(med_evol_tr_p3 > 0, "+", "")``r med_evol_tr_p3` %) : le resserrement du crédit agit comme un choc commun. ## Gradient urbain et typologies [**Le clivage pôles/couronnes est le fait structurant de la période. À chaque échelle de la hiérarchie urbaine, la couronne surperforme son pôle — signe que l’effet télétravail et la recherche de surface continuent de structurer les choix résidentiels.**]{.insight} ### Depuis 2020, les couronnes surperforment systématiquement les pôles ```{r} #| label: plt-indice100-typo4p #| fig-width: 10 #| fig-height: 5.5 #| echo: false pal_t4p <- c( "Pôles" = col_cyan, "Couronnes urbaines" = col_orange, "Rural périurbain" = col_green, "Rural autonome" = col_red ) france_ref <- idx_france %>% filter(annee >= BASE_YEAR, annee <= 2024) %>% select(annee, indice = idx_prix) %>% mutate(grp = "France") p_t4p <- ggplot() + geom_rect(data = rect_periods, aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = fill), alpha = 0.15) + scale_fill_manual(values = period_colors, name = NULL) + geom_line(data = france_ref, aes(x = annee, y = indice), linetype = "dashed", color = col_gray, linewidth = 0.8) + annotate("text", x = max(france_ref$annee) + 0.2, y = tail(france_ref$indice, 1), label = "France", color = col_gray, size = 3, hjust = 0) + geom_line(data = serie_t4p %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp), linewidth = 0.9) + geom_point(data = serie_t4p %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp), size = 1.5) + geom_text_repel( data = serie_t4p %>% filter(annee == 2024), aes(x = annee, y = indice, label = paste0(grp, " (", round(indice, 0), ")"), color = grp), hjust = -0.1, nudge_x = 0.3, size = 2.8, direction = "y", show.legend = FALSE ) + geom_hline(yintercept = 100, linetype = "dotted", color = col_gray, linewidth = 0.3) + scale_color_manual(values = pal_t4p, name = NULL) + scale_x_continuous(breaks = BASE_YEAR:2024) + labs( title = "Le rural poursuit sa hausse, les pôles corrigent", subtitle = "Indice 100, base 2016 · TYPO4 Périurb", x = NULL, y = "Indice (base 100 = 2016)", caption = make_source("DVF SIRENE 2016-2024", "TDC INSEE 2025") ) + theme(legend.position = "top", plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) p_t4p ``` ```{r} #| label: plt-bar-horiz-typo4p #| fig-width: 10 #| fig-height: 4.5 #| echo: false evol_t4p <- serie_t4p %>% filter(annee %in% c(2016, 2019, 2022, 2024)) %>% select(grp, annee, px_m2) %>% tidyr::pivot_wider(names_from = annee, values_from = px_m2, names_prefix = "y") %>% mutate( `2016-2019` = (y2019 - y2016) / y2016 * 100, `2019-2022` = (y2022 - y2019) / y2019 * 100, `2022-2024` = (y2024 - y2022) / y2022 * 100 ) %>% select(grp, `2016-2019`, `2019-2022`, `2022-2024`) %>% tidyr::pivot_longer(-grp, names_to = "periode", values_to = "evol") %>% mutate( grp = factor(grp, levels = rev(ORD_T4P)), periode = factor(periode, levels = c("2016-2019", "2019-2022", "2022-2024")) ) ggplot(evol_t4p, aes(x = evol, y = grp, fill = periode)) + geom_col(position = position_dodge(width = 0.7), width = 0.6) + geom_vline(xintercept = 0, color = col_spacegray, linewidth = 0.3) + geom_text(aes(label = paste0(ifelse(evol > 0, "+", ""), round(evol, 1), "%"), hjust = ifelse(evol >= 0, -0.1, 1.1)), position = position_dodge(width = 0.7), size = 2.8) + scale_fill_manual( values = c("2016-2019" = col_cyan, "2019-2022" = col_green, "2022-2024" = col_red), name = NULL ) + labs( title = "Évolution des prix par type de territoire", subtitle = "TYPO4 Périurb · prix m²", x = "Évolution (%)", y = NULL, caption = make_source("DVF SIRENE 2016-2024", "TDC INSEE 2025") ) + theme(legend.position = "top", plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) ``` Le gradient urbain-rural est net : les pôles, après avoir porté la hausse 2016-2019, sont les premiers à corriger en 2022-2024. À l'inverse, le rural autonome continue de s'apprécier, porté par un effet de rattrapage et l'essor du télétravail. Les couronnes urbaines ont capté l'essentiel de la surperformance pendant le boom 2019-2022 (+20 % en médiane), signe d'un report massif des acquéreurs vers le périurbain. ### Un gradient universel : la couronne bat le pôle à toutes les échelles ```{r} #| label: plt-indice100-typo9fs #| fig-width: 11 #| fig-height: 6 #| echo: false pal_t9f <- c( "Pôle Paris" = "#0a4c6a", "Couronne Paris" = "#73bfe2", "Pôle grandes aires" = "#8b1a5c", "Couronne grandes aires" = "#e88fc0", "Pôle aires moyennes" = "#2d7d2d", "Couronne aires moyennes" = "#8fd18f", "Pôle petites aires" = "#b85c1a", "Couronne petites aires" = "#f0b87a", "Hors AAV" = "#888888" ) p_t9f <- ggplot() + geom_rect(data = rect_periods, aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = fill), alpha = 0.15) + scale_fill_manual(values = period_colors, name = NULL) + geom_line(data = france_ref, aes(x = annee, y = indice), linetype = "dashed", color = col_gray, linewidth = 0.8) + annotate("text", x = max(france_ref$annee) + 0.2, y = tail(france_ref$indice, 1), label = "France", color = col_gray, size = 3, hjust = 0) + geom_line(data = serie_t9f %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp), linewidth = 0.8) + geom_point(data = serie_t9f %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp), size = 1.3) + geom_text_repel( data = serie_t9f %>% filter(annee == 2024), aes(x = annee, y = indice, label = paste0(grp, " (", round(indice, 0), ")"), color = grp), hjust = -0.1, nudge_x = 0.3, size = 2.5, direction = "y", max.overlaps = 15, show.legend = FALSE ) + geom_hline(yintercept = 100, linetype = "dotted", color = col_gray, linewidth = 0.3) + scale_color_manual(values = pal_t9f, name = NULL) + scale_x_continuous(breaks = BASE_YEAR:2024) + labs( title = "Couronnes vs pôles — 9 niveaux France Stratégie", subtitle = "Indice 100, base 2016", x = NULL, y = "Indice (base 100 = 2016)", caption = make_source("DVF SIRENE 2016-2024", "TDC INSEE 2025") ) + guides(color = guide_legend(nrow = 3, byrow = TRUE)) + theme(legend.position = "top", legend.text = element_text(size = 7.5), plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) p_t9f ``` ```{r} #| label: plt-bar-horiz-typo9fs #| fig-width: 11 #| fig-height: 7 #| echo: false evol_t9f <- serie_t9f %>% filter(annee %in% c(2016, 2019, 2022, 2024)) %>% select(grp, annee, px_m2) %>% tidyr::pivot_wider(names_from = annee, values_from = px_m2, names_prefix = "y") %>% mutate( `2016-2019` = (y2019 - y2016) / y2016 * 100, `2019-2022` = (y2022 - y2019) / y2019 * 100, `2022-2024` = (y2024 - y2022) / y2022 * 100 ) %>% select(grp, `2016-2019`, `2019-2022`, `2022-2024`) %>% tidyr::pivot_longer(-grp, names_to = "periode", values_to = "evol") %>% mutate( groupe = GRP_T9F[as.character(grp)], groupe = factor(groupe, levels = c("Paris", "Grandes aires", "Aires moyennes", "Petites aires", "Hors AAV")), grp = factor(grp, levels = rev(ORD_T9F)), periode = factor(periode, levels = c("2016-2019", "2019-2022", "2022-2024")) ) ggplot(evol_t9f, aes(x = evol, y = grp, fill = periode)) + geom_col(position = position_dodge(width = 0.7), width = 0.6) + geom_vline(xintercept = 0, color = col_spacegray, linewidth = 0.3) + geom_text(aes(label = paste0(ifelse(evol > 0, "+", ""), round(evol, 1), "%"), hjust = ifelse(evol >= 0, -0.1, 1.1)), position = position_dodge(width = 0.7), size = 2.5) + facet_grid(groupe ~ ., scales = "free_y", space = "free_y", switch = "y") + scale_fill_manual( values = c("2016-2019" = col_cyan, "2019-2022" = col_green, "2022-2024" = col_red), name = NULL ) + labs( title = "Évolution des prix par hiérarchie urbaine", subtitle = "TYPO9fs France Stratégie", x = "Évolution (%)", y = NULL, caption = make_source("DVF SIRENE 2016-2024", "TDC INSEE 2025") ) + theme( legend.position = "top", strip.placement = "outside", strip.text.y.left = element_text(angle = 0, face = "bold", size = 9, hjust = 1), strip.background = element_rect(fill = "#f5f5f5", color = NA), panel.spacing = unit(0.3, "lines"), plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9) ) ``` ### Hors AAV en tête, couronnes de Paris en queue : 9 profils contrastés ```{r} #| label: tbl-profils-typo9fs #| echo: false tbl_t9f <- serie_t9f %>% filter(annee %in% c(2016, 2019, 2022, 2024)) %>% select(grp, annee, px_m2, nb_trans) %>% tidyr::pivot_wider(names_from = annee, values_from = c(px_m2, nb_trans), names_sep = "_") %>% mutate( groupe = GRP_T9F[as.character(grp)], evol_1619 = (px_m2_2019 - px_m2_2016) / px_m2_2016 * 100, evol_1922 = (px_m2_2022 - px_m2_2019) / px_m2_2019 * 100, evol_2224 = (px_m2_2024 - px_m2_2022) / px_m2_2022 * 100, evol_trans = (nb_trans_2024 - nb_trans_2022) / nb_trans_2022 * 100, is_pole = grepl("^Pôle", grp), grp = factor(grp, levels = ORD_T9F) ) %>% arrange(grp) gs <- list(background = "#e0e0e0", fontSize = "9px", color = "#444", fontWeight = "700", textTransform = "uppercase", letterSpacing = "0.5px", padding = "2px 4px") tbl_t9f_react <- reactable( tbl_t9f %>% select(grp, px_m2_2016, px_m2_2024, evol_1619, evol_1922, evol_2224, nb_trans_2024, evol_trans), compact = TRUE, pagination = FALSE, highlight = TRUE, bordered = FALSE, searchable = FALSE, height = 380, defaultColDef = colDef(align = "center", headerStyle = list(background = "#f0f0f0", fontSize = "10px", color = "#555", fontWeight = "600")), columnGroups = list( colGroup(name = "PRIX M² MÉDIAN", columns = c("px_m2_2016", "px_m2_2024"), headerStyle = gs), colGroup(name = "ÉVOLUTION PRIX (%)", columns = c("evol_1619", "evol_1922", "evol_2224"), headerStyle = c(gs, list(borderLeft = "2px solid #ccc"))), colGroup(name = "TRANSACTIONS", columns = c("nb_trans_2024", "evol_trans"), headerStyle = c(gs, list(borderLeft = "2px solid #ccc"))) ), columns = list( grp = colDef(name = "Type", minWidth = 170, align = "left", style = function(val, index) { s <- list(fontWeight = "500", fontSize = "11px", position = "sticky", left = "0", zIndex = "1", background = "white") if (grepl("^Pôle", val)) s$fontWeight <- "700" s }), px_m2_2016 = col_num("2016", digits = 0), px_m2_2024 = col_num("2024", digits = 0), nb_trans_2024 = col_num("Vol. 2024", digits = 0), evol_1619 = col_variation(tbl_t9f, "evol_1619", "16-19", "%"), evol_1922 = col_variation(tbl_t9f, "evol_1922", "19-22", "%"), evol_2224 = col_variation(tbl_t9f, "evol_2224", "22-24", "%"), evol_trans = col_variation(tbl_t9f, "evol_trans", "Δ trans.", "%") ), rowStyle = function(index) { if (tbl_t9f$is_pole[index]) list(fontWeight = "bold", background = "#fafafa") } ) browsable(tagList( tags$div(style = "font-size:12px; font-weight:700; color:#333; margin-bottom:4px;", "Profil par hiérarchie urbaine France Stratégie (9 niveaux)"), tbl_t9f_react, tags$div(style = "font-size:8px; color:#999; font-style:italic; margin-top:2px;", make_source("DVF SIRENE 2016-2024", "TDC INSEE 2025")) )) max_hausse_t9 <- tbl_t9f %>% slice_max(evol_2224, n = 1) max_baisse_t9 <- tbl_t9f %>% slice_min(evol_2224, n = 1) log_step("P2_TYPO9FS", max_hausse_grp = as.character(max_hausse_t9$grp), max_hausse_evol = round(max_hausse_t9$evol_2224, 1), max_baisse_grp = as.character(max_baisse_t9$grp), max_baisse_evol = round(max_baisse_t9$evol_2224, 1) ) ``` La lecture par hiérarchie urbaine confirme le schéma : sur 2022-2024, la plus forte correction est observée en `r as.character(max_baisse_t9$grp)` (`r fmt_sign(round(max_baisse_t9$evol_2224, 1), 1)` %), tandis que la plus forte hausse résiduelle concerne les territoires `r as.character(max_hausse_t9$grp)` (`r fmt_sign(round(max_hausse_t9$evol_2224, 1), 1)` %). À chaque échelle, la couronne surperforme son pôle, signe que l'effet télétravail et la recherche de surface continuent de structurer les choix résidentiels des ménages. ## Focus grandes villes et Paris [**Les 30 plus grandes zones d’emploi concentrent l’essentiel des volumes transactionnels et révèlent des trajectoires très différenciées : de `r fmt_sign(round(bot3_ze_px$evol_px_p3[1], 1), 1)` % pour `r bot3_ze_px$ZE2020lib[1]` à +`r round(top3_ze_px$evol_px_p3[1], 1)` % pour `r top3_ze_px$ZE2020lib[1]`.**]{.insight} ### Les 30 ZE les plus chères : littoral et métropoles dominent ```{r} #| label: tbl-grandes-ze #| echo: false gs_ze <- list(background = "#e0e0e0", fontSize = "9px", color = "#444", fontWeight = "700", textTransform = "uppercase", letterSpacing = "0.5px", padding = "2px 4px") tbl_ze_show <- tbl_ze %>% select(ZE2020lib, prix_m2_median_2016, prix_m2_median_2024, nb_mutations_2024, evol_px_p1, evol_px_p2, evol_px_p3, evol_glob) tbl_ze_react <- reactable( tbl_ze_show, compact = TRUE, pagination = FALSE, highlight = TRUE, bordered = FALSE, searchable = TRUE, height = 550, defaultSorted = list(evol_px_p3 = "asc"), defaultColDef = colDef(align = "center", headerStyle = list(background = "#f0f0f0", fontSize = "10px", color = "#555", fontWeight = "600")), columnGroups = list( colGroup(name = "PRIX M²", columns = c("prix_m2_median_2016", "prix_m2_median_2024"), headerStyle = gs_ze), colGroup(name = "ÉVOLUTION (%)", columns = c("evol_px_p1", "evol_px_p2", "evol_px_p3", "evol_glob"), headerStyle = c(gs_ze, list(borderLeft = "2px solid #ccc"))) ), columns = list( ZE2020lib = colDef(name = "Zone d'emploi", minWidth = 160, align = "left", style = list(fontWeight = "500", fontSize = "11px", position = "sticky", left = "0", zIndex = "1", background = "white")), prix_m2_median_2016 = col_num("2016", digits = 0), prix_m2_median_2024 = col_num("2024", digits = 0), nb_mutations_2024 = col_num("Trans.", digits = 0), evol_px_p1 = col_variation(tbl_ze, "evol_px_p1", "16-19", "%"), evol_px_p2 = col_variation(tbl_ze, "evol_px_p2", "19-22", "%"), evol_px_p3 = col_variation(tbl_ze, "evol_px_p3", "22-24", "%"), evol_glob = col_variation(tbl_ze, "evol_glob", "16-24", "%") ), language = reactableLang(searchPlaceholder = "Filtrer...") ) browsable(tagList( tags$div(style = "font-size:12px; font-weight:700; color:#333; margin-bottom:4px;", "Top 30 zones d'emploi — évolution des prix maisons"), tbl_ze_react, tags$div(style = "font-size:8px; color:#999; font-style:italic; margin-top:2px;", make_source("DVF SIRENE 2016-2024")) )) ``` ### Paris décroche durablement, la petite couronne résiste mieux [**Paris intra-muros a décroché dès 2020 (indice `r idx_paris_v` vs `r idx_pc_v` pour la PC et `r idx_fr_v` France). L’effet télétravail réduit la prime de centralité, la petite couronne capte le report des acquéreurs franciliens.**]{.insight} ```{r} #| label: plt-indice100-paris-pc #| fig-width: 10 #| fig-height: 5.5 #| echo: false pal_paris <- c( "Paris intra-muros" = col_cyan, "Petite couronne" = col_orange, "France" = col_gray ) p_paris <- ggplot() + geom_rect(data = rect_periods, aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = fill), alpha = 0.15) + scale_fill_manual(values = period_colors, name = NULL) + geom_line(data = serie_paris_ref %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp, linetype = grp), linewidth = 1) + geom_point(data = serie_paris_ref %>% filter(annee <= 2024), aes(x = annee, y = indice, color = grp), size = 2) + geom_text_repel( data = serie_paris_ref %>% filter(annee == 2024), aes(x = annee, y = indice, label = paste0(grp, " (", round(indice, 0), ")"), color = grp), hjust = -0.1, nudge_x = 0.3, size = 3, direction = "y", show.legend = FALSE ) + geom_hline(yintercept = 100, linetype = "dotted", color = col_gray, linewidth = 0.3) + scale_color_manual(values = pal_paris, name = NULL) + scale_linetype_manual(values = c("Paris intra-muros" = "solid", "Petite couronne" = "solid", "France" = "dashed"), guide = "none") + scale_x_continuous(breaks = BASE_YEAR:2024) + labs( title = "Paris décroche dès 2020, la PC résiste", subtitle = "Indice 100, base 2016 · 47 communes", x = NULL, y = "Indice (base 100 = 2016)", caption = make_source("DVF SIRENE 2016-2024", "périmètre pgent") ) + theme(legend.position = "top", plot.title = element_text(size = 11), plot.subtitle = element_text(size = 9)) p_paris paris_idx <- serie_paris_ref %>% filter(annee == 2024) idx_paris_v <- round(paris_idx$indice[paris_idx$grp == "Paris intra-muros"], 1) idx_pc_v <- round(paris_idx$indice[paris_idx$grp == "Petite couronne"], 1) idx_fr_v <- round(paris_idx$indice[paris_idx$grp == "France"], 1) log_step("P3_PARIS", paris_idx_2024 = idx_paris_v, pc_idx_2024 = idx_pc_v, france_idx_2024 = idx_fr_v ) ``` En 2024, Paris intra-muros affiche un indice de `r idx_paris_v` (base 100 en 2016) contre `r idx_pc_v` pour la petite couronne et `r idx_fr_v` pour la France. Le décrochage parisien, amorcé dès 2020, s'explique par un ajustement après la surchauffe des années 2017-2019 et un effet télétravail qui réduit la prime de centralité. La petite couronne résiste mieux, bénéficiant du report des acquéreurs franciliens. ```{r} #| label: tbl-paris-detail #| echo: false paris_detail <- dvf_typo %>% filter(!is.na(zone_paris), !is.na(prix_m2_median), nb_mutations >= 5, annee %in% c(2022, 2024)) %>% group_by(code_commune, LIBGEO, zone_paris, annee) %>% summarise( px_m2 = weighted.mean(prix_m2_median, nb_mutations, na.rm = TRUE), nb_trans = sum(nb_mutations, na.rm = TRUE), .groups = "drop" ) %>% tidyr::pivot_wider(names_from = annee, values_from = c(px_m2, nb_trans), names_sep = "_") %>% mutate( evol_2224 = ifelse(px_m2_2022 > 0, (px_m2_2024 - px_m2_2022) / px_m2_2022 * 100, NA) ) %>% arrange(evol_2224) gs_par <- list(background = "#e0e0e0", fontSize = "9px", color = "#444", fontWeight = "700", textTransform = "uppercase", letterSpacing = "0.5px", padding = "2px 4px") paris_show <- paris_detail %>% select(LIBGEO, zone_paris, px_m2_2022, px_m2_2024, nb_trans_2024, evol_2224) tbl_par_react <- reactable( paris_show, compact = TRUE, pagination = FALSE, highlight = TRUE, bordered = FALSE, searchable = TRUE, height = 550, defaultSorted = list(evol_2224 = "asc"), defaultColDef = colDef(align = "center", headerStyle = list(background = "#f0f0f0", fontSize = "10px", color = "#555", fontWeight = "600")), columnGroups = list( colGroup(name = "PRIX M²", columns = c("px_m2_2022", "px_m2_2024"), headerStyle = gs_par), colGroup(name = "VOLUME / ÉVOL.", columns = c("nb_trans_2024", "evol_2224"), headerStyle = c(gs_par, list(borderLeft = "2px solid #ccc"))) ), columns = list( LIBGEO = colDef(name = "Commune / Arr.", minWidth = 170, align = "left", style = list(fontWeight = "500", fontSize = "11px", position = "sticky", left = "0", zIndex = "1", background = "white")), zone_paris = colDef(name = "Zone", minWidth = 90), px_m2_2022 = col_num("2022", digits = 0), px_m2_2024 = col_num("2024", digits = 0), nb_trans_2024 = col_num("Trans.", digits = 0), evol_2224 = col_variation(paris_detail, "evol_2224", "Évol. 22-24", "%") ), language = reactableLang(searchPlaceholder = "Filtrer...") ) browsable(tagList( tags$div(style = "font-size:12px; font-weight:700; color:#333; margin-bottom:4px;", "Paris + Petite Couronne — évolution 2022-2024"), tbl_par_react, tags$div(style = "font-size:8px; color:#999; font-style:italic; margin-top:2px;", make_source("DVF SIRENE 2022-2024", "périmètre pgent")) )) ``` ## Annexe méthodologique {.appendix} ::: {.encadre}
Sources et méthode
- **DVF SIRENE** : Pipeline pdvf-BatnatDvf (DuckDB), ~12M mutations 2014-2025. Prix nationaux = vraies médianes (sur toutes les mutations), pas moyennes pondérées de médianes communales. DVF 2025 = S1 provisoire (janvier-juin), utilisé seulement pour l'indice 100 (pointillé). - **SITADEL** : Logements commencés, mises en chantier résidentielles 2011-2025, série complète y compris 2025. Source SDES. - **Typologies** : TYPO4 Périurb (gradient urbain-rural, 4 classes) et TYPO9fs France Stratégie (pôle/couronne × taille, 9 classes), source TDC-ref custom. - **Paris+PC** : 20 arrondissements + 27 communes limitrophes (périmètre pgent). - **Seuil** : Communes < 5 mutations/an exclues des agrégations. ::: ```{r} #| label: log-save #| include: false claude_log_save() ```