Inventaire et cartographie des dispositifs encadrant les marchés immobiliers

1 Éléments de présentation

Ce markdown vise à retracer les étapes de l’élaboration et du traitement puis la cartographie des bases sur les zonages A/B/C et 1/2/3 pour la France entière. Celles-ci permettent d’appréhender l’évolution du classement des communes. Elles sont complétées dans l’analyse par l’étude des conditions d’éligibilité aux dispositifs qui leur sont adossés : les aides fiscales à l’investissement locatif (type Pinel), les PTZ, les APL accession.

A noter : la situation renseignée pour une année donnée correspond à celle en vigueur au 31 décembre. Par exemple, la cartographie du zonage A/B/C à Lyon en 2009 est celle au 31 décembre 2009, donc intégrant l’ensemble des changements survenus au cours de l’année 2009. Pour cette raison, la dernière année renseignée est 2019.

1.1 Le zonage A/B/C : l’aide à l’investissement locatif et le PTZ

Les dispositifs de défiscalisation des revenus locatifs sont inaugurés au début des années 1980. Les dispositifs Quilès (1985-1986), Quilès-Méhaignerie (1987-1997), Quilès-Méhaignerie intermédiaire (1993-1997) et Périssol (1997-1999) n’étaient adossés à aucun zonage. Les dispositifs Besson (1999-2002),Robien (2003-2006) et Robien recentré (2006-2008), qui conditionnent les réductions d’impôt à des loyers abordables, en modulent les plafonds selon les zones du territoire français.

Depuis le Robien, ces dispositifs s’appuient sur le zonage dit “A/B/C”, créé en 2003, découpant la France en trois (A, B, C), puis quatre (A, B1, B2, C) et enfin cinq zones (A bis, A, B1, B2, C) selon le nombre d’habitant des agglomérations et le niveau de tension de leur marché immobilier résidentiel. Les catégories B1 et B2 apparaissent en 2006, la catégorie A bis en 2010.

A partir de 2009, certaines communes deviennent inéligibles :

• Le dispositif Scellier (2009-2012) exclut d’abord les communes de la zone C avant de leur donner la possibilité, à partir de 2010, d’obtenir leur éligibilité par agrément préfectoral.

• Le dispositif Duflot (2013-2014) exclut les communes des zones C et B2 en offrant la possibilité des agréments au second groupe.

• Avec le dispositif Pinel (2015-2021), les zones C et B2 sont d’abord éligibles sous condition d’agrément préfectoral et deviennent inéligibles le 1 er janvier 2018 (article 39 du PLF 2018).

Le zonage A/B/C sert également de référence au prêt à taux zéro. Instauré en 1995, le PTZ (devenu PTZ+ en 2011) est associé à des plafonds susceptibles de varier selon la zone de localisation du logement. Créé en 2005, supprimé en 2011 et réinstauré sous des conditions plus restrictives en 2012, le PTZ dans l’ancien est définitivement supprimé des zones A et B1 depuis janvier 2018. Le PTZ neuf reste accessible sans condition de localisation (en dépit du projet initial de le limiter aux zones A bis, A et B1).

1.2 Le zonage 1/2/3 : les APL

Le zonage 1/2/3 est plus ancien que le A/B/C. Il est initié par l’arrêté du 17 mars 1978 instaurant deux zones géographiques dans lesquelles sont classées une partie des communes du territoire. Ce premier découpage sert de fondement au classement 1/2/3 à proprement parler, instauré par l’arrêté du 29 mars 1999. Il s’agit d’un zonage relativement stable : ses dernières modifications remontent au début des années 2000.

Il a servi de support aux aides fiscales à l’investissement locatif du dispositif Besson (1999-2002). Il est également utilisé par la CAF pour le calcul des APL (et, depuis 2018, l’éligibilité aux APL accession).

1.3 Note sur l’organisation du dossier R project

Les tables figurant en output ont été réalisés en alternant traitement sous R et manipulation alla mano de tables sous Excel. A des fins de reproductibilité, l’ensemble des tables intermédiaires ont été enregistrées dans le dossier “Intermediate”. Pour chacune des étapes Excel, je précise dans ce markdown les traitements effectués.

1.4 Composition du document

1. Ce document retrace d’abord l’élaboration d’une base retraçant l’historique des classements A/B/C depuis la création du zonage en 2003 jusqu’en 2019 pour la France entière. Cette partie aboutit à la production de deux types de bases sur la France entière (disponibles dans le dossier “Output/France”) :

• Une base détail (“ABC_detail.xlsx”) construite comme suit : 1/En ligne : chaque commune qui a existé entre 2003 et 2019, renseignée par son code INSEE et son libellé pour chaque année sur cet intervalle de temps. Conséquence de ce choix de traitement : pour une année donnée, la liste des communes renseignées comprend des doublons (les communes qui ont connu des fusions ou des divisions sur la période) ; 2/ En colonne : pour chaque année le code INSEE et le libellé de la commune, leur zone A/B/C, leur éligibilité (“Oui” / “Non”) aux dispositifs d’aide fiscale à l’investissement locatif.

• Une base présentant certains résultats agrégés (“ABC_agrege.xlsx”) composée de deux feuilles 1/ Une feuille récapitulant, pour chaque année, le nombre de communes classées dans chaque zone. 2/ Une feuille récapitulant, pour chaque année, le nombre de communes éligibles à l’aide à l’investissement locatif.

2. Une seconde partie, plus modeste, est consacrée à la construction d’un base historique du classement 1/2/3. Celui-ci, plus ancien que le A/B/C, constitue notamment le zonage de référence de la CAF. Crée en 1978, il est très stable depuis le milieu des années 2000 (la dernière modification, modeste par rapport au zonage précédent, remontant à 2005). Cette partie aboutit à la production d’une base détail sur la France entière rangée dans “Output/France” sous le nom “123_detail.xlsx”.

3. Il présente dans un troisième temps la cartographie des dispositifs sur les trois territoires d’étude.

4. Une quatrième partie donne à voir des premiers éléments d’analyse statistique.

2 Construction d’un historique des classements ABC pour la France entière

2.1 Sources

Les sources utilisées sont toutes en libre accès et diffusées par les services publics. Elles sont de quatre types :

• Des textes de loi disponibles en ligne sur legifrance.gouv.fr

• Du zonage A/B/C pour l’année 2019 disponible sur le site du ministère de la Cohésion territoriale.

• Des données disponibles sur les agréments préfectoraux - sur le site data.gouv.fr

• Une base des communes par année compilée par l’INSEE et disponible sur son site.

2.1.1 Textes de loi

Le zonage A/B/C, créé en 2003, a depuis été réformée à 5 reprises. Chaque changement est l’occasion de changer certaines communes de catégorie. Ces modifications successives sont établies par arrêtés, disponibles en ligne sur le site Legifrance. Je récapitule ci-dessous les textes utilisés ainsi que les modifications spécifiques qu’ils introduisent lorsque c’est le cas. Ils sont disponibles en version PDF dans le fichier “raw-data/LEGIFRANCE/ZONAGE_ABC” au format “Annee_mois_jour” :

Date	Classes	Format	Lien
19/12/2003	A, B, C	Texte	Arrêté du 19 décembre 2003
10/08/2006	A, B1, B2, C	Texte	Arrêté du 10 août 2006
29/04/2009	A, B1, B2, C	Texte	Arrêté du 10 août 2006 modifié par l’arrêté du 29 avril 2009
22/12/2010	A, A bis, B1; B2, C	Texte	Arrêté du 22 décembre 2010
01/08/2014	A, A bis, B1; B2, C	Table	Arrêté du 1er août 2014
04/07/2019	A, A bis, B1; B2, C	Table	Arrêté du 1er août 2014 modifié par l’arrêté du 4 juillet 2019

Ces arrêtés se limitent à lister les communes classées dans les catégories A et B. Les communes non mentionnées appartiennent à la zone C.

2.1.2 Zonage A/B/C pour l’année 2019

Le ministère de la Cohésion territoriale met en accès gratuit le classement des communes selon le zonage A/B/C (consulté le 19 mars 2020). Au moment de l’élaboration de ce travail, la table disponible correspond aux communes de l’année 2019.

2.1.3 Données sur les agréments

De 2010 à 2017, l’éligibilité aux dispositifs Scellier, Duflot et Pinel ne dépend pas uniquement du classement des communes. Il est également possible, pour les communes qui n’appartiendraient pas aux zones éligibles, d’obtenir un agrément afin d’accéder à l’éligibilité.

2.1.3.1 Les agréments ministériels du Scellier (2010-2012)

L’arrêté du 23 septembre 2010 relatif à l’instruction des demandes de l’agrément prévu au X de l’article 199 septvicies du code général des impôts instaure la possibilité pour une commune de zone C d’accéder au dispositif Scellier sous condition d’agrément ministériel.

Ces agréments, lorsqu’ils ont lieu, sont publiés dans le Journal officiel. S’il n’existe pas de répertoire des agréments accordés, il est en revanche possible d’en recomposer une liste par recherche sur le site legifrance.gouv.fr en effectuant une recherche sur l’expression exacte “au X de l article 199 septvicies” sur (option “rechercher ces mots parmi les mots du texte”). On trouve ainsi 27 arrêtés d’agrément. Je dois cette idée à Béatrice Boutchenik, adjointe à la cheffe du bureau des études économiques du DGALN.

La liste des 27 agréments a été entrée à la main dans un tableur que j’ai fait figurer dans “raw-data/LEGIFRANCE/Agrements_Scellier”.

2.1.3.2 Les agréments préfectoraux Duflot et Pinel (2013-2017)

Pour la période 2013-2017, le site data.gouv propose une base au format .xls téléchargeable ici (consultation le 18 mars 2020).

Il s’agit d’une base au format 1 ligne = 1 commune. Pour chacune, identifiée à son code INSEE, est notamment indiqué la date de l’entrée en vigueur de l’arrêté d’agrément.

2.1.4 Données sur le découpage des communes

L’INSEE propose un historique des tables de passage des communes, dans une rubrique “Découpage communal” disponible ici (consultation le 18 février 2020, visiblement supprimée depuis, mais néanmoins disponible ici

Cette table a été utilisée afin d’établir la continuité des différents découpages et des différents classements.

2.2 Etapes de traitement

Le traitement des données a suivi plusieurs étapes comme suit :

• Etape 1 : élaboration de tables exploitables à partir des documents législatifs disponibles en ligne. Le produit de cette première étape sont les tables rangées dans le fichier “Intermediate/ABC/1_step”

• Etape 2 : nettoyage de ces tables et de la constitution de tables harmonisées, nettoyées des erreurs et des problèmes de codage, indiquant le code INSEE de la commune, donc directement exploitables. Ces tables sont rangées dans le fichier “Intermediate/ABC/2_step”

• Etape 3 : constitution d’une base unifiée répertoriant l’ensemble des communes de chaque année et les associant à leur zone A/B/C. Cette table est disponible à : “Output/France/ABC_detail.xlsx”.

• Etape 4 : constitution de bases exposant des résultats agrégés directement exploitables, disponibles à : “Output/France/ABC_agrege.xlsx”.

2.2.1 Etape 1 : mise en table des arrêtés

Les arrêtés ont été traités comme suit :

• Les arrêtés en format texte (2003, 2006 et 2009) ont été scrapés et convertis, pour chacun, en une table au format .csv. Ces tables ne sont pas directement exploitables et doivent avant tout traitement R être retraitées à la main selon les étapes décrites infra.

• L’arrêté de 2010 n’étant qu’un texte de petite taille listant les 69 communes classées en A bis, son traitement a été fait alla mano.

• L’arrêté de 2014 figurant la liste des communes sous forme de tables, celle-ci a simplement été copiée et collée dans un document au format Excel dans une mise en page exploitable.

• L’arrêté de 2019 ne tenant pas compte d’un certain nombre de fusions de commune, il s’est avéré plus pertinent d’utiliser le classement A/B/C des communes de France par le ministère de la Cohésion territoriale.

2.2.1.1 Les tables 2003, 2006 et 2009 : scraping et nettoyage à la main

2.2.1.1.1 Scraping

La méthode du scraping permet d’aller chercher les données directement en ligne. Néanmoins, une version PDF des textes utilisés est disponible sur dans le fichier raw-data, même si le script de scraping n’y fait pas référence.

Le script proposé ci-dessous répète un même schéma de traitement pour chaque texte de loi scrapé. Pour des raisons de bon fonctionnement, il peut être bon de redémarrer R entre chaque boucle. Note également : le scraping s’exécute assez mal sous Mac.

J’indique ci-dessous les scripts utilisés pour scraper les données. Je détaille davantage le script utilisé pour aspirer le texte de 2003, les autres ont été réalisés sur le même modèle, avec quelques variations selon la façon dont se structurait la page.

Le résultat de cette étape préliminaire à tout nettoyage, et spécifique aux tables de 2003, 2006 et 2009, est enregistré dans le dossier “Intermediate/ABC/0_Scraping”.

# Chargement des packages
library(stringr)
library(RSelenium)


#############
# Base 2003 #
#############


# Connexion

## Connexion à un navigateur web
rD <- rsDriver(port = 4444L, browser =  "firefox")
remDr <- rD[["client"]]

## Connection à l'url ciblée
url <- "https://www.legifrance.gouv.fr/affichTexte.do;jsessionid=1F7C67CA4C1B397C62B03EE74E06438D.tplgfr26s_1?cidTexte=JORFTEXT000000600609&idArticle=&categorieLien=id#JORFARTI000002239435"
remDr$navigate(url)

webElem <- remDr$findElement(using = 'xpath' , "//div[@class='article'][6]")
NAME <- webElem$getElementText()


# Nettoyage data

## Mise en tableau
result <- as.data.frame(str_split(NAME, "\n"))

## Supression lignes vides
result2 <- as.data.frame(result[result[1]!="",])

## Ventilation des commune par ligne à partir du symbol ", "
result3 <- as.data.frame(unlist(str_split(result2[,1], ", ")))


# Export de la table
write.csv2(result3,file = "Intermediate/ABC/0-scrapping/ABC_2003.csv")


# Cloture session
remDr$close()
rD[["server"]]$stop()


#############
# Base 2006 #
#############

# Connexion
rD <- rsDriver(port = 4444L, browser =  "firefox")
remDr <- rD[["client"]]
url <- "https://www.legifrance.gouv.fr/affichTexteArticle.do;jsessionid=1F7C67CA4C1B397C62B03EE74E06438D.tplgfr26s_1?idArticle=LEGIARTI000020571467&cidTexte=JORFTEXT000000427351&categorieLien=id&dateTexte=20090503"
remDr$navigate(url)
webElem <- remDr$findElement(using = 'xpath' , "//div[@class='corpsArt']")
NAME <- webElem$getElementText()

# Nettoyage data
result <- as.data.frame(str_split(NAME, "\n"))
result2 <- as.data.frame(unlist(str_split(result[,1], ", ")))

# Export
write.csv2(result2,file = "Intermediate/ABC/0-scrapping/ABC_2006.csv")

# Cloture session
remDr$close()
rD[["server"]]$stop()



#############
# Base 2009 #
#############


# Connexion
rD <- rsDriver(port = 4444L, browser =  "firefox")
remDr <- rD[["client"]]
url <- "https://www.legifrance.gouv.fr/affichTexteArticle.do;jsessionid=1F7C67CA4C1B397C62B03EE74E06438D.tplgfr26s_1?idArticle=LEGIARTI000020573740&cidTexte=JORFTEXT000000427351&categorieLien=id&dateTexte=20140806"
remDr$navigate(url)
webElem <- remDr$findElement(using = 'xpath' , "//div[@class='corpsArt']")
NAME <- webElem$getElementText()


# Nettoyage
result <- as.data.frame(str_split(NAME, "\n"))
result2 <- as.data.frame(result[result[1]!="",])
result3 <- as.data.frame(unlist(str_split(result2[,1], ", ")))

# Export
write.csv2(result3,file = "Intermediate/ABC/0-scrapping/ABC_2010.csv")

# Cloture session
remDr$close()
rD[["server"]]$stop()

Les tables ainsi créées comportent une seule colonne qui rassemble l’ensemble des informations pertinentes : zone, département et nom de la commune, sous la forme suivante :

;unlist(str_split(result2[, 1], “,”))
1;Annexe
2;A N N E X E
3;Zone A
4;01 - Ain
5;Cessy
6;Challex
7;Chevry
8;Collonges

2.2.1.1.2 Nettoyage à la main

Ces tables sont traitées à la main de façon à produire une table .xlsx au format 3 colonnes figurant respectivement : le nom de la commune (NOM_[année]), son département (DEP) et sa zone (ZONE_[année]).

Ce premier nettoyage a permis de régler une première série de problèmes qui rendaient ces tables inexploitables.

• Les textes des arrêtés séparent les noms des communes d’une virgule, règle qui a guidé l’élaboration du script de scrapping. Néanmoins, ces virgules sont parfois omises : deux noms de communes cohabitent alors dans la même cellule du tableur. Ce problème a été réglé par une recherche du symbole " ". Dans l’essentiel des cas, un espace sépare un nom de commune de son déterminant (exemple : Le Bouscat). Dans les autres cas, qui correspondent à des oublis de virgule, les deux noms de communes ont été séparés.

• La dernière commune de chaque zone est suivie d’un point (“.”) susceptible de gêner la bonne reconnaissance du nom de la commune. Ce problème est résolu très simplement en supprimant le caractère “.” de la table Excel.

• Le nom d’un département est parfois suivi de la mention : “L’ensemble des communes du département” ou “L’ensemble des communes du département, hors communes en zone A”. Dans le premier cas, j’ai collé dans la base Excel la liste des communes répertoriées cette année là par l’INSEE. Dans le second j’ai ensuite déduit de cette liste les communes mentionnées en zone A.

Les tables finales, enregistrées dans le dossier “Intermediate/ABC/1s_step”, se présentent sous l’aspect suivant :

NOM_2003	DEP	ZONE_2003
Cessy	01	A
Challex	01	A
Chevry	01	A
Collonges	01	A

2.2.1.2 Les arrêtés de 2010 et 2014 : traitement directement à la main

Les trois autres arrêtés sont directement transcrits sous forme de table .xlsx à la main.

• Pour l’arrêté de 2010, la table Excel a été constituée en changeant à la main la zone des communes nommées dans le texte de loi. L’arrêté de 2010 se limite à crééer la catégorie A bis à partir de la catégorie A sans toucher aux catégories B1, B2 et C.

• Pour l’arrêté de 2014, le texte de loi présente la liste des communes selon une table susceptible d’être directement copiée / collée dans Excel.

Dans les deux cas, les tables ainsi produites ont été stockées dans le dosser “Intermediate/ABC/1_step”

2.2.1.3 L’arrêté de 2019 : contourné au profit des données du ministère

La précision relativement mauvaise de la liste des communes présentées dans cet arrêté (les fusions des années précédentes étant très imparfaitement prises en compte) a motivé l’utilisation de la table proposée par le ministère de la Cohésion territoriale (raw-data/MCT/ZONAGE_ABC)

2.2.2 Etape 2 : nettoyage des bases issues des arrêtés

L’objectif de cette deuxième étape est de construire, pour chaque année, une base associant à chaque commune de France sa zone. Elle a pour but de rendre les tables annuelles pleinement exploitables en réglant les problèmes de mention des communes :

• Les communes sont renseignées par leur nom et leur département d’appartenance et non par leur code INSEE.

• Certains noms de communes sont mal transcrits (mal orthographiés, tronqués, oubli d’accents, etc.). Par exemple, l’arrêté de 2003 mentionne la commune de Chanteloup-en-Chelles (77), qui n’a jamais existé. L’étude des communes aux noms proches m’a mené à supposer qu’il s’agissait de la communes de Chanteloup-en-Brie (77).

• Certains noms de communes sont anachroniques (figurent des noms de communes qui ont déjà fusionnées à la date de l’arrêté).

Pour cela, j’ai réalisé un appariemment entre chaque table issue d’un arrêté et la liste des communes établie par l’INSEE l’année de publication de l’arrêté. L’appariemment a été réalisé sur la base d’une variable composée du nom de la commune accolé au numéro de son département (NOM_DEP). Les erreurs de transcription et les anachronismes ont eu pour effet de gêner l’appariemment. J’ai réglé ce problème en réalisant un second appariemment sur les résidus du premier au moyen de la distance de Levenshtein : celle-ci permet d’associer à chaque commune de la table issue de l’arrêté celle de la table INSEE pour laquelle la variable NOM_DEP présentait le plus grand degré de similitude. Le résultat de ce second appariemment a été contrôlé et, en cas de besoin, corrigé manuellement, avant d’être réinséré dans la table finale. Le cas des communes des DROM a également posé problème (créer la variable NOM_DEP sur la base issue de l’INSEE supposait de prendre les deux premiers numéros, ce qui créait des doublons pour les communes des DROM). Dans la mesure où toutes ces communes ont toujours été classées en B puis en B1, j’ai choisi de simplifier le traitement en créant une table à part que j’ai réinséré dans la table finale en fin de script.

La table des communes mal appariées (Miss_[annee]) est enregistrée pour chaque année dans le dossier “Intermediate/ABC/2b_missmatch”. La base créée sous R est signalée par le suffixe _brut ; celle corrigée à la main avant d’être réimportée dans R par le suffixe _corrige.

Le script ci-dessous détaille le procédé utilisé pour traiter la table correspondant à l’arrêté de 2003. Les scripts correspondant aux autres tables sont indiqués dans le fichier .Rmd mais masqués dans le .html à des fins de concision.

# Chargement des packages
library(readxl) # Pour importer en xlsx
library(openxlsx) # Pour exporter en xlsx
library(stringdist) # Pour les distances de Levenshtein


##############
## ABC 2003 ##
##############


# Ouverture des bases

## La base produite à l'étape 1
ABC_2003 <- read_excel("Intermediate/ABC/1_step/ABC_2003.xlsx")

## La base INSEE des communes en 2003
INSEE_passage <- read_excel("raw-data/INSEE/INSEE_DATA/Passage_communes_2003_2019.xls") # On s'appuie sur la base INSEE retraçant l'historique des communes de 2003 à 2019.
INSEE_passage <- subset(INSEE_passage, NIVGEO == "COM") # On enlève les arrondissements
INSEE_passage <- INSEE_passage[,2:35] # On enlève le champ NIVGEO qui ne sert plus à rien
INSEE_2003 <- INSEE_passage[, c("CODGEO_2019", "CODGEO_2003", "LIBGEO_2003")]
INSEE_2003 <- subset(INSEE_2003, !is.na(INSEE_2003$CODGEO_2003)) # On enlève les doublons


# Appariemment des deux bases

## Création du champ DEPARTEMENT sur lequel faire la jointure
INSEE_2003$DEPARTEMENT <- substr(INSEE_2003$CODGEO_2003, 0,2)
ABC_2003$DEPARTEMENT <- substr(ABC_2003$DEP, 0,2)

## Traitement des DROM
DROM_2003 <- subset(INSEE_2003, DEPARTEMENT == "97") # On crée la base DROM issue de la base INSEE
DROM_2003$ZONE_2003 <- "B" # On les met en zone B
DROM_2003 <- DROM_2003[3:114,c(2,5)] # On écarte les communes de St Barthélémy et St Martin
colnames(DROM_2003) <- c("CODGEO_2003", "ZONE_ABC_2003")

## Preparation des tables en vue de faire la jointure
ABC_2003 <- subset(ABC_2003, DEPARTEMENT != "97") # On enlève les DROM des bases ABC et INSEE
INSEE_2003$NOM_DEP <- paste0(INSEE_2003$LIBGEO_2003, INSEE_2003$DEPARTEMENT) # On crée notre champ NOM_DEP qui va nous servir à faire la jointure
ABC_2003$NOM_DEP <- paste0(ABC_2003$NOM_2003, ABC_2003$DEPARTEMENT)
table(duplicated(ABC_2003$NOM_DEP)) # On vérifie l'absence de doublons 


# Appariemment
ABC_2003 <- merge(ABC_2003, INSEE_2003, by = "NOM_DEP", all.x = TRUE)


# Gestion du miss matching

## Création d'une base des communes non appariée
Miss_2003 <- subset(ABC_2003, is.na(ABC_2003$CODGEO_2003)) # On crée une base à part
ABC_2003 <- subset(ABC_2003, !is.na(ABC_2003$CODGEO_2003)) # On enlève les communes mal appariées de la table principale
Miss_2003 <- Miss_2003[,c(1:4)]
colnames(Miss_2003) <- c("NOM_DEP", "NOM", "DEP", "ZONE")

## On associe à chaque commune non appariée une commune de la base INSEE selon la distance de Levenshtein

mat_dist <- stringdistmatrix(Miss_2003$NOM_DEP, INSEE_2003$NOM_DEP)

Miss_2003$nom_co <- unlist(apply(
  X = mat_dist, 
  MARGIN = 1, 
  FUN = function(x) INSEE_2003[which.min(x), "NOM_DEP"]
))

Miss_2003$cod_co <- unlist(apply(
  X = mat_dist, 
  MARGIN = 1, 
  FUN = function(x) INSEE_2003[which.min(x), "CODGEO_2003"]
))

## On exporte cette table pour la corriger à la main
write.xlsx(Miss_2003, "Intermediate/ABC/2b_missmatch/ABC_2003_brut.xlsx")
remove(mat_dist)

## On corrige la table à la main, hors R donc.

## On importe la table corrigée à la main
Miss_2003 <- read_excel("Intermediate/ABC/2b_missmatch/ABC_2003_corrige.xlsx")
Miss_2003 <- Miss_2003[,c(6,4)]
colnames(Miss_2003) <- c("CODGEO_2003", "ZONE_ABC_2003")


# Assemblage de la table finalisée

## On allège la table principale ABC
ABC_2003 <- ABC_2003[,c("CODGEO_2003", "ZONE_2003")]
colnames(ABC_2003) <- c("CODGEO_2003", "ZONE_ABC_2003")

## On y insère les tables sur les DROM et celle sur les erreurs d'appariement
ABC_2003 <- rbind(ABC_2003, DROM_2003)
ABC_2003 <- rbind(ABC_2003, Miss_2003)
remove(DROM_2003)
remove(Miss_2003)

## On ajoute les communes de la zone C par matching avec la table INSEE (toute commune qui n'est pas dans la table nettoyée est zone C)
ABC_2003 <- merge(ABC_2003, INSEE_2003, by = "CODGEO_2003", all.y = T)
ABC_2003$ZONE_ABC_2003[ABC_2003$CODGEO_2003 == "06114"] <- "A" # On corrige une erreur aussi isolée qu'incompréhensible
ABC_2003 <- ABC_2003[,1:4]

## On classe en zone C toutes les communes qui renvoient NA pour la zone
ABC_2003$ZONE_ABC_2003[is.na(ABC_2003$ZONE_ABC_2003)] <- "C"

## On enlève les doublons
ABC_2003 <- subset(ABC_2003, !duplicated(ABC_2003))
write.xlsx(ABC_2003, "Intermediate/ABC/2_step/ABC_2003.xlsx") 
remove(INSEE_2003)

Le traitement de la base proposée par le ministère de la Cohésion territoriale différant légèrement des précédents, je l’indique également. Cette table nécessite moins de traitement que les précédentes du fait qu’elle indique directement le code INSEE des communes. Je me suis donc limité à vérifier que les communes de la table sont bien les mêmes que celles répertoriées par l’INSEE à la même date.

##############
## ABC 2019 ##
##############

# Ouverture des bases

## La base téléchargée sur data.gouv
ABC_2019 <- read_xls("raw-data/MCT/ZONAGE_ABC/Zonage_ABC_2019.xls")
colnames(ABC_2019) <- c("CODGEO_2019", "LIBGEO_2019", "ZONE_ABC_2019")


## La base INSEE des communes en 2019
INSEE_2019 <- INSEE_passage[, c("CODGEO_2019", "LIBGEO_2019")]

## On fait la jointure avec la table INSEE
ABC_2019 <- merge(ABC_2019, INSEE_2019, by = "CODGEO_2019", all.y = T)
table(is.na(ABC_2019$ZONE_ABC_2019)) # Seul missmatch : deux lignes de NA
ABC_2019 <- subset(ABC_2019, !is.na(ABC_2019$ZONE_ABC_2019))

## On enlève le champ "NOM"
ABC_2019 <- ABC_2019[,c(1, 3, 4)]
colnames(ABC_2019) <- c("CODGEO_2019", "ZONE_ABC_2019", "LIBGEO_2019")
ABC_2019$ZONE_ABC_2019[ABC_2019$ZONE_ABC_2019 == "Abis"] <- "A bis" # Correction d'une erreur mineure de codification
ABC_2019 <- subset(ABC_2019, !duplicated(ABC_2019$CODGEO_2019))
write.xlsx(ABC_2019, "Intermediate/ABC/2_step/ABC_2019.xlsx") 

remove(INSEE_2019)

2.2.3 Etape 3 : constitution d’une base historique des classements A/B/C des communes

Cette étape comprend deux temps :

• La jointure entre les tables produites à l’étape 2 et la table de passage des communes produite par l’INSEE.

• Le classement des communes dans les zones A/B/C pour les années “manquantes”, c’est-à-dire les années où il n’y a pas eu d’arrêté.

2.2.3.1 La construction d’une table unifiée

Cette table unifiée est le produit de la jointure des tables de l’étape 2 et de la table de passage de l’INSEE 2003-2019 :

# Ouverture de la table de passage des communes de l'INSEE
INSEE_passage <- read_excel("raw-data/INSEE/INSEE_DATA/Passage_communes_2003_2019.xls") 
INSEE_passage <- subset(INSEE_passage, NIVGEO == "COM") # On enlève les arrondissements
INSEE_passage <- INSEE_passage[,2:35] # On enlève la première colonne


# Jointure des tables ABC successives

## Importation des tables ABC dont on ne conserve que le code et le nom pour l'année de référence
ABC_2003 <- read_excel("Intermediate/ABC/2_step/ABC_2003.xlsx")
ABC_2003 <- ABC_2003[,1:2]
ABC_2003 <- subset(ABC_2003, !is.na(ABC_2003$CODGEO_2003))

ABC_2006 <- read_excel("Intermediate/ABC/2_step/ABC_2006.xlsx")
ABC_2006 <- ABC_2006[,1:2]
ABC_2006 <- subset(ABC_2006, !is.na(ABC_2006$CODGEO_2006))

ABC_2009 <- read_excel("Intermediate/ABC/2_step/ABC_2009.xlsx")
ABC_2009 <- ABC_2009[,1:2]
ABC_2009 <- subset(ABC_2009, !is.na(ABC_2009$CODGEO_2009))

ABC_2010 <- read_excel("Intermediate/ABC/2_step/ABC_2010.xlsx")
ABC_2010 <- ABC_2010[,1:2]
ABC_2010 <- subset(ABC_2010, !is.na(ABC_2010$CODGEO_2010))

ABC_2014 <- read_excel("Intermediate/ABC/2_step/ABC_2014.xlsx")
ABC_2014 <- ABC_2014[,1:2]
ABC_2014 <- subset(ABC_2014, !is.na(ABC_2014$CODGEO_2014))

ABC_2019 <- read_excel("Intermediate/ABC/2_step/ABC_2019.xlsx")
ABC_2019 <- ABC_2019[,1:2]
ABC_2019 <- subset(ABC_2019, !is.na(ABC_2019$CODGEO_2019))

## On joint les tables successivement dans une nouvelle table ABC
ABC <- merge(INSEE_passage, ABC_2003, by = "CODGEO_2003", all.x = T) 
ABC <- merge(ABC, ABC_2006, by = "CODGEO_2006", all.x = T)
ABC <- merge(ABC, ABC_2009, by = "CODGEO_2009", all.x = T)
ABC <- merge(ABC, ABC_2010, by = "CODGEO_2010", all.x = T)
ABC <- merge(ABC, ABC_2014, by = "CODGEO_2014", all.x = T)
ABC <- merge(ABC, ABC_2019, by = "CODGEO_2019", all.x = T) # Des doublons apparaissent uniquement à cette dernière étape, d'une façon un peu inexplicable. On les enlève :
ABC <- subset(ABC, !duplicated(ABC))

## Réorganisation de la table
ABC <- ABC[, c("CODGEO_2019", "LIBGEO_2019", "CODGEO_2018", "LIBGEO_2018","CODGEO_2017", "LIBGEO_2017","CODGEO_2016", "LIBGEO_2016", "CODGEO_2015", "LIBGEO_2015", "CODGEO_2014", "LIBGEO_2014", "CODGEO_2013", "LIBGEO_2013","CODGEO_2012", "LIBGEO_2012","CODGEO_2011", "LIBGEO_2011","CODGEO_2010", "LIBGEO_2010","CODGEO_2009", "LIBGEO_2009","CODGEO_2008", "LIBGEO_2008","CODGEO_2007", "LIBGEO_2007","CODGEO_2006", "LIBGEO_2006","CODGEO_2005", "LIBGEO_2005","CODGEO_2004", "LIBGEO_2004","CODGEO_2003", "LIBGEO_2003", "ZONE_ABC_2003","ZONE_ABC_2006","ZONE_ABC_2009","ZONE_ABC_2010","ZONE_ABC_2014","ZONE_ABC_2019")]

2.2.3.2 Remplissage des années manquantes

Le but est ici de tenir compte des fusions et divisions communales afin que le classement A/B/C corresponde bien au découpage communal de chaque année.

• Lorsque deux communes fusionnent, la nouvelle commune garde le code INSEE d’une des communes fusionnées. J’attribue alors à la nouvelle commune la zone de la commune dont le code INSEE a été conservé.

• Lorsque deux communes se divisent, je place chaque commune filles dans la zone dans laquelle les place le classement qui suit immédiatement. Par exemeple, si en 2004 la commune codée A se divise en une commune codée A et une commune codée B : la nouvelle commune A est classée dans la même zone l’ancienne commune A et la commune B est classée dans la zone dans laquelle la classe l’arrêté de 2006.

Je procède donc de la façon suivante. Pour construire le classement des communes d’une année n :

• Je charge le classement de l’année n-1.

• J’effectue une jointure entre ce classement et la liste des communes établie par l’INSEE pour l’année n.

• Je règle les missmatchs au cas par cas.

Les erreurs d’appariement ne concernent que les cas de divisions de communes, c’est-à-dire d’apparition de codes INSEE qui n’existaient pas l’année précédente. Dans ces cas là, je classe manuellement la nouvelle commune dans la zone dans laquelle elle est classée lors su classement postérieur. Il s’agit généralement de communes de zone C mais pas uniquement.

Les cas de fusions, donc de disparition de codes INSEE, ne posent pas de problème : la commune fusionnée est directement classée dans la zone de son chef-lieu dont elle conserve le code INSEE.

A des fins de concision, je ne rends visible dans le fichier .html que le script correspondant à l’élaboration de la table de 2004, les autres sont indiquées dans le fichier .Rmd.

##########
## 2004 ##
##########


# On ouvre la table ABC de 2003
ABC_2003 <- read_excel("Intermediate/ABC/2_step/ABC_2003.xlsx")
ABC_2003 <- ABC_2003[,1:2]

# On produit la liste des communes françaises de 2004 à partir de la table ABC complète
INSEE_2004 <- ABC[, c("CODGEO_2004", "LIBGEO_2004")]
INSEE_2004 <- subset(INSEE_2004, !duplicated(INSEE_2004$CODGEO_2004))
INSEE_2004 <- subset(INSEE_2004, !is.na(INSEE_2004$CODGEO_2004))

# On fusionne les deux
ABC_2004 <- merge(ABC_2003, INSEE_2004, by.x = "CODGEO_2003", by.y = "CODGEO_2004", all.y = T)

# On analyse les erreurs d'appariemment :
table(is.na(ABC_2004$CODGEO_2003)) 
table(is.na(ABC_2004$ZONE_ABC_2003)) # 4 NA. Donc, 4 codes communes qui existaient en 2004 n'existaient pas en 2003.
table(is.na(ABC_2004$LIBGEO_2004)) # 0 NA. Donc, 0 codes communes qui existaient en 2003 n'existaient plus en 2004.

# Les codes INSEE des nouvelles communes sont : 55068 ;     55082 ;     47163 ; 89288. 

# On regarde dans la matrice passage les lignes pour lesquelles le CODGEO_2004 est 55068 ;  55082 ;     47163 ; 89288
NV_COM_2004 <- subset(ABC, ABC$CODGEO_2004 == "55068" | ABC$CODGEO_2004 == "55082" | ABC$CODGEO_2004 == "47163" | ABC$CODGEO_2004 == "89288") # On observe que les quatre communes sont classées en zone C en 2006.
remove(NV_COM_2004)

# On produit la table ABC 2004
colnames(ABC_2004) <- c("CODGEO_2004", "ZONE_ABC_2004", "LIBGEO_2004")
ABC_2004$ZONE_ABC_2004[is.na(ABC_2004$ZONE_ABC_2004)] <- "C"

# On la sauvegarde
write.xlsx(ABC_2004, "Intermediate/ABC/2_step/ABC_2004.xlsx")

# On l'incorpore à la base ABC générale
ABC_2004 <- ABC_2004[,1:2]
ABC <- merge(ABC, ABC_2004, by = "CODGEO_2004", all.x = T)

Une fois créées une table pour chaque année, on assemble la table finale, qu’on enregistre en Output :

ABC <- ABC[, c("CODGEO_2019", "LIBGEO_2019", "CODGEO_2018", "LIBGEO_2018","CODGEO_2017", "LIBGEO_2017","CODGEO_2016", "LIBGEO_2016", "CODGEO_2015", "LIBGEO_2015", "CODGEO_2014", "LIBGEO_2014", "CODGEO_2013", "LIBGEO_2013","CODGEO_2012", "LIBGEO_2012","CODGEO_2011", "LIBGEO_2011","CODGEO_2010", "LIBGEO_2010","CODGEO_2009", "LIBGEO_2009","CODGEO_2008", "LIBGEO_2008","CODGEO_2007", "LIBGEO_2007","CODGEO_2006", "LIBGEO_2006","CODGEO_2005", "LIBGEO_2005","CODGEO_2004", "LIBGEO_2004","CODGEO_2003", "LIBGEO_2003", "ZONE_ABC_2003", "ZONE_ABC_2004", "ZONE_ABC_2005","ZONE_ABC_2006", "ZONE_ABC_2007", "ZONE_ABC_2008","ZONE_ABC_2009","ZONE_ABC_2010", "ZONE_ABC_2011", "ZONE_ABC_2012", "ZONE_ABC_2013","ZONE_ABC_2014", "ZONE_ABC_2015", "ZONE_ABC_2016", "ZONE_ABC_2017", "ZONE_ABC_2018","ZONE_ABC_2019")]

write.xlsx(ABC, "Output/France/ABC_detail.xlsx")

2.2.4 Etape 4 : agrégation des données

Je construis deux tables synthétiques de mes résultats :

• Une table récpitulant le nombre de communes classées dans chaque zone par année.

• Une table récapitulant le nombre de communes éligibles (en tenant compte des agréments) par année.

2.2.4.1 Table d’effectifs par zone

Pour construire cette table, il n’est pas possible de simplement faire des sommes sur la table ABC unifiée en raison des nombreux doublons qui y figurent. J’ai donc élaboré cette table synthétique à partir des tables annuelles stockées en “Intermediate/ABC/2_step”.

# Calcul pour 2003
ABC_03 <- read_excel("Intermediate/ABC/2_step/ABC_2003.xlsx")
a03 <- sum(ABC_03$ZONE_ABC_2003 == "A")
ab03 <- NA
b03 <- sum(ABC_03$ZONE_ABC_2003 == "B")
b103 <- NA
b203 <- NA
c03 <- sum(ABC_03$ZONE_ABC_2003 == "C")
t03 <- nrow(ABC_03)

# Calcul pour 2004
ABC_04 <- read_excel("Intermediate/ABC/2_step/ABC_2004.xlsx")
a04 <- sum(ABC_04$ZONE_ABC_2004 == "A")
ab04 <- NA
b04 <- sum(ABC_04$ZONE_ABC_2004 == "B")
b104 <- NA
b204 <- NA
c04 <- sum(ABC_04$ZONE_ABC_2004 == "C")
t04 <- nrow(ABC_04)

# Calcul pour 2005
ABC_05 <- read_excel("Intermediate/ABC/2_step/ABC_2005.xlsx")
a05 <- sum(ABC_05$ZONE_ABC_2005 == "A")
ab05 <- NA
b05 <- sum(ABC_05$ZONE_ABC_2005 == "B")
b105 <- NA
b205 <- NA
c05 <- sum(ABC_05$ZONE_ABC_2005 == "C")
t05 <- nrow(ABC_05)

# Calcul pour 2006
ABC_06 <- read_excel("Intermediate/ABC/2_step/ABC_2006.xlsx")
a06 <- sum(ABC_06$ZONE_ABC_2006 == "A")
ab06 <- NA
b106 <- sum(ABC_06$ZONE_ABC_2006 == "B1")
b206 <- sum(ABC_06$ZONE_ABC_2006 == "B2")
b06 <- b106 + b206
c06 <- sum(ABC_06$ZONE_ABC_2006 == "C")
t06 <- nrow(ABC_06)

# Calcul pour 2007
ABC_07 <- read_excel("Intermediate/ABC/2_step/ABC_2007.xlsx")
a07 <- sum(ABC_07$ZONE_ABC_2007 == "A")
ab07 <- NA
b107 <- sum(ABC_07$ZONE_ABC_2007 == "B1")
b207 <- sum(ABC_07$ZONE_ABC_2007 == "B2")
b07 <- b107 + b207
c07 <- sum(ABC_07$ZONE_ABC_2007 == "C")
t07 <- nrow(ABC_07)

# Calcul pour 2008
ABC_08 <- read_excel("Intermediate/ABC/2_step/ABC_2008.xlsx")
a08 <- sum(ABC_08$ZONE_ABC_2008 == "A")
ab08 <- NA
b108 <- sum(ABC_08$ZONE_ABC_2008 == "B1")
b208 <- sum(ABC_08$ZONE_ABC_2008 == "B2")
b08 <- b108 + b208
c08 <- sum(ABC_08$ZONE_ABC_2008 == "C")
t08 <- nrow(ABC_08)

# Calcul pour 2009
ABC_09 <- read_excel("Intermediate/ABC/2_step/ABC_2009.xlsx")
a09 <- sum(ABC_09$ZONE_ABC_2009 == "A")
ab09 <- NA
b109 <- sum(ABC_09$ZONE_ABC_2009 == "B1")
b209 <- sum(ABC_09$ZONE_ABC_2009 == "B2")
b09 <- b109 + b209
c09 <- sum(ABC_09$ZONE_ABC_2009 == "C")
t09 <- nrow(ABC_09)

# Calcul pour 2010
ABC_10 <- read_excel("Intermediate/ABC/2_step/ABC_2010.xlsx")
ab10 <- sum(ABC_10$ZONE_ABC_2010 == "A bis")
a10 <- sum(ABC_10$ZONE_ABC_2010 == "A") + ab10
b110 <- sum(ABC_10$ZONE_ABC_2010 == "B1")
b210 <- sum(ABC_10$ZONE_ABC_2010 == "B2")
b10 <- b110 + b210
c10 <- sum(ABC_10$ZONE_ABC_2010 == "C")
t10 <- nrow(ABC_10)

# Calcul pour 2011
ABC_11 <- read_excel("Intermediate/ABC/2_step/ABC_2011.xlsx")
ab11 <- sum(ABC_11$ZONE_ABC_2011 == "A bis")
a11 <- sum(ABC_11$ZONE_ABC_2011 == "A") + ab11
b111 <- sum(ABC_11$ZONE_ABC_2011 == "B1")
b211 <- sum(ABC_11$ZONE_ABC_2011 == "B2")
b11 <- b111 + b211
c11 <- sum(ABC_11$ZONE_ABC_2011 == "C")
t11 <- nrow(ABC_11)

# Calcul pour 2012
ABC_12 <- read_excel("Intermediate/ABC/2_step/ABC_2012.xlsx")
ab12 <- sum(ABC_12$ZONE_ABC_2012 == "A bis")
a12 <- sum(ABC_12$ZONE_ABC_2012 == "A") + ab12
b112 <- sum(ABC_12$ZONE_ABC_2012 == "B1")
b212 <- sum(ABC_12$ZONE_ABC_2012 == "B2")
b12 <- b112 + b212
c12 <- sum(ABC_12$ZONE_ABC_2012 == "C")
t12 <- nrow(ABC_12)

# Calcul pour 2013
ABC_13 <- read_excel("Intermediate/ABC/2_step/ABC_2013.xlsx")
ab13 <- sum(ABC_13$ZONE_ABC_2013 == "A bis")
a13 <- sum(ABC_13$ZONE_ABC_2013 == "A") + ab13
b113 <- sum(ABC_13$ZONE_ABC_2013 == "B1")
b213 <- sum(ABC_13$ZONE_ABC_2013 == "B2")
b13 <- b113 + b213
c13 <- sum(ABC_13$ZONE_ABC_2013 == "C")
t13 <- nrow(ABC_13)

# Calcul pour 2014
ABC_14 <- read_excel("Intermediate/ABC/2_step/ABC_2014.xlsx")
ab14 <- sum(ABC_14$ZONE_ABC_2014 == "A bis")
a14 <- sum(ABC_14$ZONE_ABC_2014 == "A") + ab14
b114 <- sum(ABC_14$ZONE_ABC_2014 == "B1")
b214 <- sum(ABC_14$ZONE_ABC_2014 == "B2")
b14 <- b114 + b214
c14 <- sum(ABC_14$ZONE_ABC_2014 == "C")
t14 <- nrow(ABC_14)

# Calcul pour 2015
ABC_15 <- read_excel("Intermediate/ABC/2_step/ABC_2015.xlsx")
ab15 <- sum(ABC_15$ZONE_ABC_2015 == "A bis")
a15 <- sum(ABC_15$ZONE_ABC_2015 == "A") + ab15
b115 <- sum(ABC_15$ZONE_ABC_2015 == "B1")
b215 <- sum(ABC_15$ZONE_ABC_2015 == "B2")
b15 <- b115 + b215
c15 <- sum(ABC_15$ZONE_ABC_2015 == "C")
t15 <- nrow(ABC_15)

# Calcul pour 2016
ABC_16 <- read_excel("Intermediate/ABC/2_step/ABC_2016.xlsx")
ab16 <- sum(ABC_16$ZONE_ABC_2016 == "A bis")
a16 <- sum(ABC_16$ZONE_ABC_2016 == "A") + ab16
b116 <- sum(ABC_16$ZONE_ABC_2016 == "B1")
b216 <- sum(ABC_16$ZONE_ABC_2016 == "B2")
b16 <- b116 + b216
c16 <- sum(ABC_16$ZONE_ABC_2016 == "C")
t16 <- nrow(ABC_16)

# Calcul pour 2017
ABC_17 <- read_excel("Intermediate/ABC/2_step/ABC_2017.xlsx")
ab17 <- sum(ABC_17$ZONE_ABC_2017 == "A bis")
a17 <- sum(ABC_17$ZONE_ABC_2017 == "A") + ab17
b117 <- sum(ABC_17$ZONE_ABC_2017 == "B1")
b217 <- sum(ABC_17$ZONE_ABC_2017 == "B2")
b17 <- b117 + b217
c17 <- sum(ABC_17$ZONE_ABC_2017 == "C")
t17 <- nrow(ABC_17)

# Calcul pour 2018
ABC_18 <- read_excel("Intermediate/ABC/2_step/ABC_2018.xlsx")
ab18 <- sum(ABC_18$ZONE_ABC_2018 == "A bis")
a18 <- sum(ABC_18$ZONE_ABC_2018 == "A") + ab18
b118 <- sum(ABC_18$ZONE_ABC_2018 == "B1")
b218 <- sum(ABC_18$ZONE_ABC_2018 == "B2")
b18 <- b118 + b218
c18 <- sum(ABC_18$ZONE_ABC_2018 == "C")
t18 <- nrow(ABC_18)

# Calcul pour 2019
ABC_19 <- read_excel("Intermediate/ABC/2_step/ABC_2019.xlsx")
ab19 <- sum(ABC_19$ZONE_ABC_2019 == "A bis")
a19 <- sum(ABC_19$ZONE_ABC_2019 == "A") + ab19
b119 <- sum(ABC_19$ZONE_ABC_2019 == "B1")
b219 <- sum(ABC_19$ZONE_ABC_2019 == "B2")
b19 <- b119 + b219
c19 <- sum(ABC_19$ZONE_ABC_2019 == "C")
t19 <- nrow(ABC_19)


Tab1 <- data.frame(Année = c(2003:2019),
                  A = c(a03, a04, a05, a06, a07, a08, a09, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19),
                  Abis = c(ab03, ab04, ab05, ab06, ab07, ab08, ab09, ab10, ab11, ab12, ab13, ab14, ab15, ab16, ab17, ab18, ab19),
                  B = c(b03, b04, b05, b06, b07, b08, b09, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19),
                  B1 = c(b103, b104, b105, b106, b107, b108, b109, b110, b111, b112, b113, b114, b115, b116, b117, b118, b119),
                  B2 = c(b203, b204, b205, b206, b207, b208, b209, b210, b211, b212, b213, b214, b215, b216, b217, b218, b219),
                  C = c(c03, c04, c05, c06, c07, c08, c09, c10, c11, c12, c13, c14, c15, c16, c17, c18, c19),
                  Total = c(t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19))

knitr::kable(Tab1)

Année	A	Abis	B	B1	B2	C	Total
2003	592	NA	4174	NA	NA	31912	36678
2004	592	NA	4174	NA	NA	31916	36682
2005	592	NA	4174	NA	NA	31918	36684
2006	593	NA	4177	1942	2235	31946	36716
2007	593	NA	4177	1942	2235	31913	36683
2008	593	NA	4178	1942	2236	31910	36681
2009	591	NA	4940	1748	3192	31177	36708
2010	591	69	4940	1748	3192	31177	36708
2011	591	69	4938	1748	3190	31151	36680
2012	591	69	4953	1764	3189	31156	36700
2013	591	69	4953	1764	3189	31137	36681
2014	727	77	5447	1547	3900	30510	36684
2015	727	77	5442	1546	3896	30489	36658
2016	727	77	5404	1545	3859	29754	35885
2017	727	77	5385	1535	3850	29304	35416
2018	727	77	5378	1534	3844	29252	35357
2019	724	76	5363	1535	3828	28883	34970

2.2.4.2 Table d’effectifs d’éligibilité au dispositif

Cette table a été élaborée en combinant le classement par zone des communes et les agréments préfectoraux. Les conditions d’éligibilité aux dispositifs d’aides fiscales ont varié au fil des arrêtés selon les modalités présentées en 1.1 de ce document.

Point important : cette table pâtit d’une absence de données sur les agréments sur la période 2010-2012. Pour ces trois années, les effectifs d’éligibilité sont donc sous-évalués.

library(dplyr)

# Ouverture
ABC <- read_excel("Output/France/ABC_detail.xlsx")
ABC <- ABC[,c(1,3,5,7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35:51)]


# Définition de l'éligibilité selon la zone année par année

## Pour la période 2003-2008

ABC$ELIG_2003 <- "Oui"
ABC$ELIG_2004 <- "Oui"
ABC$ELIG_2005 <- "Oui"
ABC$ELIG_2006 <- "Oui"
ABC$ELIG_2007 <- "Oui"
ABC$ELIG_2008 <- "Oui"

## Pour la période 2009-2012
ABC$ELIG_2009 <- "Oui"
ABC$ELIG_2009[ABC$ZONE_ABC_2009 == "C"] <- "Non"

ABC$ELIG_2010 <- "Oui"
ABC$ELIG_2010[ABC$ZONE_ABC_2010 == "C"] <- "Non"

ABC$ELIG_2011 <- "Oui"
ABC$ELIG_2011[ABC$ZONE_ABC_2011 == "C"] <- "Non"

ABC$ELIG_2012 <- "Oui"
ABC$ELIG_2012[ABC$ZONE_ABC_2012 == "C"] <- "Non"


## Pour la période 2013-2017

ABC$ELIG_2013 <- "Oui"
ABC$ELIG_2013[ABC$ZONE_ABC_2013 == "C" | ABC$ZONE_ABC_2013 == "B2"] <- "Non"

ABC$ELIG_2014 <- "Oui"
ABC$ELIG_2014[ABC$ZONE_ABC_2014 == "C" | ABC$ZONE_ABC_2014 == "B2"] <- "Non"

ABC$ELIG_2015 <- "Oui"
ABC$ELIG_2015[ABC$ZONE_ABC_2015 == "C" | ABC$ZONE_ABC_2015 == "B2"] <- "Non"

ABC$ELIG_2016 <- "Oui"
ABC$ELIG_2016[ABC$ZONE_ABC_2016 == "C" | ABC$ZONE_ABC_2016 == "B2"] <- "Non"

ABC$ELIG_2017 <- "Oui"
ABC$ELIG_2017[ABC$ZONE_ABC_2017 == "C" | ABC$ZONE_ABC_2017 == "B2"] <- "Non"

ABC$ELIG_2018 <- "Oui"
ABC$ELIG_2018[ABC$ZONE_ABC_2018 == "C" | ABC$ZONE_ABC_2018 == "B2"] <- "Non"

ABC$ELIG_2019 <- "Oui"
ABC$ELIG_2019[ABC$ZONE_ABC_2019 == "C" | ABC$ZONE_ABC_2019 == "B2"] <- "Non"



# Ajout des agréments 

## Sur la période 2010-2012

# Agrements_Scellier <- read_excel("raw-data/LEGIFRANCE/Agrements_Scellier.xlsx")
# Agrements_Scellier <- Agrements_Scellier[,c(1,5)]
# colnames(Agrements_Scellier)[2] <- "DATE_AGREM_SC"
# 
# ABC <- merge(ABC, Agrements_Scellier[Agrements_Scellier$DATE_AGREM_SC == "2011",], by.x = "CODGEO_2011", by.y = "CODGEO", all.x = T)
# ABC <- merge(ABC, Agrements_Scellier[Agrements_Scellier$DATE_AGREM_SC == "2012",], by.x = "CODGEO_2012", by.y = "CODGEO", all.x = T)
# ABC$DATE_AGREM_SC.x <- ifelse(is.na(ABC$DATE_AGREM_SC.x), ABC$DATE_AGREM_SC.y, ABC$DATE_AGREM_SC.x)
# ABC <- ABC[,c(1:52)]
# colnames(ABC)[52] <- "DATE_AGREM_SC"


## Sur la période 2013-2017

## Ouverture de la table sur les agréments Duflot et Pinel
Agrements <- read_excel("raw-data/MCT/ZONAGE_ABC/Agrements.xls")
Agrements <- Agrements[,c(4,6,7)]
colnames(Agrements) <- c("CODGEO", "DATE_AGREM", "TYPE_MODIF")

## Préparation en vue de son intégration à la base ABC
Agrements$DATE_AGREM <- substr(Agrements$DATE_AGREM, 1, 4)

## Gestion des NA
# En étudiant la table originale, il apparaît que les cas où la date de publication de l'agrément n'est pas renseignée, celle de la signature l'est en commentaire. Pour l'ensemble des cas, la signature est intervenue en 2015 ; on inscrit donc "2015".
Agrements$DATE_AGREM[is.na(Agrements$DATE_AGREM)] <- "2015"

## Création d'une table recensant les agréments pour chaque  année

Agrements_12 <- subset(Agrements, Agrements$DATE_AGREM == "2012")
colnames(Agrements_12) <- c("CODGEO_2012", "DATE_AGREM")

Agrements_13 <- subset(Agrements, Agrements$DATE_AGREM == "2013")
colnames(Agrements_13) <- c("CODGEO_2013", "DATE_AGREM")

Agrements_14 <- subset(Agrements, Agrements$DATE_AGREM == "2014")
colnames(Agrements_14) <- c("CODGEO_2014", "DATE_AGREM")

Agrements_15 <- subset(Agrements, Agrements$DATE_AGREM == "2015")
colnames(Agrements_15) <- c("CODGEO_2015", "DATE_AGREM")

Agrements_16 <- subset(Agrements, Agrements$DATE_AGREM == "2016")
colnames(Agrements_16) <- c("CODGEO_2016", "DATE_AGREM")

Agrements_17 <- subset(Agrements, Agrements$DATE_AGREM == "2017")
colnames(Agrements_17) <- c("CODGEO_2017", "DATE_AGREM")

## Jointure des tables sur les agréments à la table ABC unifiée
# Note : à chaque jointure, on "perd" quelques communes. Certaines ont en effet reçus plusieurs fois un agrément (doublons dans la base originale Agrements), ce qui tient au fait qu'elles ont fusionné (il n'y a donc pas de perte d'agrément, simplement réaffirmation). 
# La méthode suivie ci-dessous permet de ne retenir que le premier agrément : on considère une commune éligible à partir de cette première date.

# 2012
ABC <- merge(ABC, Agrements_12, by = "CODGEO_2012", all.x = T)

# 2013
ABC <- merge(ABC, Agrements_13, by = "CODGEO_2013", all.x = T)
ABC$DATE_AGREM.x <- ifelse(is.na(ABC$DATE_AGREM.x), ABC$DATE_AGREM.y, ABC$DATE_AGREM.x)
ABC <- ABC[,c(1:53)]

# 2014
ABC <- merge(ABC, Agrements_14, by = "CODGEO_2014", all.x = T)
ABC$DATE_AGREM.x <- ifelse(is.na(ABC$DATE_AGREM.x), ABC$DATE_AGREM, ABC$DATE_AGREM.x)
ABC <- ABC[,c(1:53)]

# 2015
ABC <- merge(ABC, Agrements_15, by = "CODGEO_2015", all.x = T)
ABC$DATE_AGREM.x <- ifelse(is.na(ABC$DATE_AGREM.x), ABC$DATE_AGREM, ABC$DATE_AGREM.x)
ABC <- ABC[,c(1:53)]

# 2016
ABC <- merge(ABC, Agrements_16, by = "CODGEO_2016", all.x = T) # La fusion crée étrangement 10 doublons, qu'on enlève
ABC <- subset(ABC, !duplicated(ABC))
ABC$DATE_AGREM.x <- ifelse(is.na(ABC$DATE_AGREM.x), ABC$DATE_AGREM, ABC$DATE_AGREM.x)
ABC <- ABC[,c(1:53)]

# 2017
ABC <- merge(ABC, Agrements_17, by = "CODGEO_2017", all.x = T)
ABC$DATE_AGREM.x <- ifelse(is.na(ABC$DATE_AGREM.x), ABC$DATE_AGREM, ABC$DATE_AGREM.x)
ABC <- ABC[,c(1:53)]

# On renomme la dernière colonne
colnames(ABC)[53] <- "DATE_AGREM_DP"


# Production de la table synthétique

# Calcul pour 2003
ABC_03 = ABC %>%
  select(CODGEO_2003) %>%
  filter(!duplicated(CODGEO_2003) & !is.na(CODGEO_2003)) 
a03 <- nrow(ABC_03)
b03 <- NA
c03 <- NA

# Calcul pour 2004
ABC_04 = ABC %>%
  select(CODGEO_2004) %>%
  filter(!duplicated(CODGEO_2004) & !is.na(CODGEO_2004)) 
a04 <- nrow(ABC_04)
b04 <- NA
c04 <- NA

# Calcul pour 2005
ABC_05 = ABC %>%
  select(CODGEO_2005) %>%
  filter(!duplicated(CODGEO_2005) & !is.na(CODGEO_2005)) 
a05 <- nrow(ABC_05)
b05 <- NA
c05 <- NA

# Calcul pour 2006
ABC_06 = ABC %>%
  select(CODGEO_2006) %>%
  filter(!duplicated(CODGEO_2006) & !is.na(CODGEO_2006)) 
a06 <- nrow(ABC_06)
b06 <- NA
c06 <- NA

# Calcul pour 2007
ABC_07 = ABC %>%
  select(CODGEO_2007) %>%
  filter(!duplicated(CODGEO_2007) & !is.na(CODGEO_2007)) 
a07 <- nrow(ABC_07)
b07 <- NA
c07 <- NA

# Calcul pour 2008
ABC_08 = ABC %>%
  select(CODGEO_2008) %>%
  filter(!duplicated(CODGEO_2008) & !is.na(CODGEO_2008)) 
a08 <- nrow(ABC_08)
b08 <- NA
c08 <- NA

# Calcul pour 2009
ABC_09 = ABC %>%
  select(CODGEO_2009, ELIG_2009) %>%
  filter(!duplicated(CODGEO_2009) & !is.na(CODGEO_2009)) 
a09 <- sum(ABC_09$ELIG_2009 == "Oui")
b09 <- a09
c09 <- NA

# Calcul pour 2010
ABC_10 = ABC %>%
  select(CODGEO_2010, ELIG_2010) %>%
  filter(!duplicated(CODGEO_2010) & !is.na(CODGEO_2010)) 
a10 <- sum(ABC_10$ELIG_2010 == "Oui")
b10 <- a10
c10 <- 0

# Calcul pour 2011
ABC_11 = ABC %>%
  select(CODGEO_2011, ELIG_2011, DATE_AGREM_SC) %>%
  filter(!duplicated(CODGEO_2011) & !is.na(CODGEO_2011)) 
a11 <- sum(ABC_11$ELIG_2011 == "Oui")
b11 <- a11
c11 <- sum(ABC_11$DATE_AGREM_SC == "2011", na.rm = T)

# Calcul pour 2012
ABC_12 = ABC %>%
  select(CODGEO_2012, ELIG_2012, DATE_AGREM_SC) %>%
  filter(!duplicated(CODGEO_2012) & !is.na(CODGEO_2012)) 
a12 <- sum(ABC_12$ELIG_2012 == "Oui")
b12 <- a12
c12 <- c11 + sum(ABC_12$DATE_AGREM_SC == "2012", na.rm = T)

# Calcul pour 2013
ABC_13 = ABC %>%
  select(CODGEO_2013, ELIG_2013, DATE_AGREM_DP) %>%
  filter(!duplicated(CODGEO_2013) & !is.na(CODGEO_2013)) 
b13 <- sum(ABC_13$ELIG_2013 == "Oui")
c13 <- sum(ABC_13$DATE_AGREM_DP == "2013", na.rm = T)
a13 = b13 + c13

# Calcul pour 2014 (on passe à dplyr, vraiment plus simple)
ABC_14 = ABC %>%
  select(CODGEO_2014, ELIG_2014, DATE_AGREM_DP, ZONE_ABC_2014) %>%
  filter(!duplicated(CODGEO_2014) & !is.na(CODGEO_2014)) 
b14 <- sum(ABC_14$ELIG_2014 == "Oui")
c14 <- sum(ABC_14$DATE_AGREM_DP == "2014", na.rm = T) + sum(ABC_14$DATE_AGREM_DP == "2013" & ABC_14$ZONE_ABC_2014 == "B2", na.rm = T)
a14 = b14 + c14

# Calcul pour 2015
ABC_15 = ABC %>%
  select(CODGEO_2015, ELIG_2015, DATE_AGREM_DP, ZONE_ABC_2015) %>%
  filter(!duplicated(CODGEO_2015) & !is.na(CODGEO_2015)) 
b15 <- sum(ABC_15$ELIG_2015 == "Oui")
c15 <- sum(ABC_15$DATE_AGREM_DP == "2015", na.rm = T) + sum(ABC_14$DATE_AGREM_DP == "2014", na.rm = T) + sum(ABC_15$DATE_AGREM_DP == "2013" & ABC_15$ZONE_ABC_2015 == "B2", na.rm = T)
a15 = b15 + c15

# Calcul pour 2016
ABC_16 = ABC %>%
  select(CODGEO_2016, ELIG_2016, DATE_AGREM_DP, ZONE_ABC_2016) %>%
  filter(!duplicated(CODGEO_2016) & !is.na(CODGEO_2016)) 
b16 <- sum(ABC_16$ELIG_2016 == "Oui")
c16 <- sum(ABC_16$DATE_AGREM_DP == "2016", na.rm = T) + sum(ABC_16$DATE_AGREM_DP == "2015", na.rm = T)+ sum(ABC_16$DATE_AGREM_DP == "2014", na.rm = T)+ sum(ABC_16$DATE_AGREM_DP == "2013" & ABC_16$ZONE_ABC_2016 == "B2", na.rm = T)
a16 = b16 + c16

# Calcul pour 2017
ABC_17 = ABC %>%
  select(CODGEO_2017, ELIG_2017, DATE_AGREM_DP, ZONE_ABC_2017) %>%
  filter(!duplicated(CODGEO_2017) & !is.na(CODGEO_2017)) 
b17 <- sum(ABC_17$ELIG_2017 == "Oui")
c17 <- sum(ABC_17$DATE_AGREM_DP == "2017", na.rm = T)+ sum(ABC_17$DATE_AGREM_DP == "2016", na.rm = T) + sum(ABC_17$DATE_AGREM_DP == "2015", na.rm = T)+ sum(ABC_17$DATE_AGREM_DP == "2014", na.rm = T) + sum(ABC_17$DATE_AGREM_DP == "2013" & ABC_17$ZONE_ABC_2017 == "B2", na.rm = T)
a17 = b17 + c17

# Calcul pour 2018
ABC_18 = ABC %>%
  select(CODGEO_2018, ELIG_2018) %>%
  filter(!duplicated(CODGEO_2018) & !is.na(CODGEO_2018)) 
a18 <- sum(ABC_18$ELIG_2018 == "Oui")
b18 <- a18
c18 <- NA


# Calcul pour 2019
ABC_19 = ABC %>%
  select(CODGEO_2019, ELIG_2019) %>%
  filter(!duplicated(CODGEO_2019) & !is.na(CODGEO_2019)) 
a19 <- sum(ABC_19$ELIG_2019 == "Oui")
b19 <- a19
c19 <- NA

ABC_19 <- read_excel("Intermediate/ABC/2_step/ABC_2019.xlsx")
ABC_19$ELIG_2019 <- "Oui"
ABC_19$ELIG_2019[ABC_19$ZONE_ABC_2019 == "C" | ABC_19$ZONE_ABC_2019 == "B2"] <- "Non"
a19 <- sum(ABC_19$ELIG_2019 == "Oui")
b19 <- a19
c19 <- NA

Tab2 <- data.frame(Annee = c(2003:2019),
                  Elig = c(a03, a04, a05, a06, a07, a08, a09, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19),
                  Zone = c(b03, b04, b05, b06, b07, b08, b09, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19),
                  Agrem = c(c03, c04, c05, c06, c07, c08, c09, c10, c11, c12, c13, c14, c15, c16, c17, c18, c19),
                  Total = c(t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19))

knitr::kable(Tab2)

On enregistre les deux tables synthétiques dans le dossier “Output/France” :

Tab1 <- t(Tab1)
Tab1 <- as.data.frame(Tab1)
colnames(Tab1) <- Tab1[1,]
Tab1 <- Tab1[-1,]
rownames(Tab1) <- c("A", "dont A bis", "B", "dont B1", "dont B2", "C", "Total")

Tab2 <- t(Tab2)
Tab2 <- as.data.frame(Tab2)
colnames(Tab2) <- c(2003:2019)
Tab2 <- Tab2[-1,]
rownames(Tab2) <- c("Eligibilite", "dont zone", "dont agrément", "Total")

list_of_datasets <- list("Zones" = Tab1, "Eligibilite" = Tab2)
write.xlsx(list_of_datasets, file = "Output/France/ABC_agrege.xlsx", row.names = T)

3 Construction d’un historique des classements 123 pour la France entière à partir de 2003

La reconstitution du zonage 1/2/3 ne présente pas exactement les mêmes difficultés que le zonage A/B/C. Les textes de loi sont d’une part moins bien organisés que ceux du zonage A/B/C, et d’autre part se réfèrent presque tous au classement originel de 1978, qui se réfère à une géographie des communes indisponible. En effet, l’essentiel des textes se limitent à une liste des reclassements par rapport au classement antérieur. En outre, le classement originel n’est disponible en fac-similé : la version numérique proposée en ligne par Legifrance en constituant la version modifiée.

En revanche, le ministère de la Cohésion des territoires met à disposition un classement des communes selon le zonage 1/2/3 qui correspond au découpage communal de 2014. L’essentiel du travail a donc consisté en un rétro-classement des communes à partir de cette référence. Pour les années 2005 à 2019, il s’est agi simplement d’adapter le classement aux fusions et divisions communales. Les zonages de 2003 et 2004 ont été reconstitués à la main à partir des modifications instaurées par les textes de loi.

La limite chronologique de la matrice de passage des communes proposée par l’INSEE a imposé 2003 comme date de début du classement des communes.

3.1 Sources

Les sources utilisées sont les mêmes que pour le zonage A/B/C, seuls changeant les textes de loi mobilisés. Je les rappelle ici :

• Des textes de loi disponibles en ligne sur beta.legifrance.gouv.fr

• Du zonage 1/2/3 pour l’année 2014 (l’identification de l’année de référence a nécessité une recherche exposée ci-après) disponible sur le site du ministère de la Cohésion territoriale.

• Une base des communes par année compilée par l’INSEE et disponible sur son site, telle que décrite en 2.1.4 de ce document.

3.1.1 Textes de loi

La définition du zonage 1/2/3 a été modifié à deux reprises seulement depuis 2003 : en 2004 puis en 2005, par arrêté. Les textes sont disponibles en ligne sur le site Legifrance. Comme pour A/B/C, une version est disponible en version PDF dans le fichier “raw-data/LEGIFRANCE/ZONAGE_123” au format “Annee_mois_jour”.

Date	Lien
29/11/2004	Arrêté du 29 novembre 2004 modifiant l’arrêté du 17 mars 1978
28/11/2005	Arrêté du 28 novembre 2005 modifiant l’arrêté du 17 mars 1978

3.1.2 Zonage 1/2/3 pour l’année 2014

Le ministère de la Cohésion territoriale met en accès gratuit le classement des communes selon le zonage 1/2/3 (consulté le 1er avril 2020). Au moment de l’élaboration de ce travail, la table disponible correspond aux communes de l’année 2014.

L’année de référence n’étant pas indiquée dans le document lui-même, son identification a fait l’objet d’un travail en soi. La méthode a été celle du tâtonnement : pour une année donnée, la liste des communes mentionnées dans le classement 1/2/3 a été comparée par appariemment sur le code commune INSEE à celle des communes recensées cette année là par l’INSEE. L’année 2014 est celle pour laquelle les deux listes correspondent parfaitement.

Le script ci-dessous illustre le tâtonnement pour les années 2005 et 2014 :

# Chargement des packages
require(readxl) # Pour importer en xls
require(openxlsx) # Pour exporter en format .xlsx

# Ouverture de la base 123 à identifier
DB_123 <- read_excel("raw-data/MCT/ZONAGE_123/Zonage_123.xls")
colnames(DB_123) <- c("CODGEO", "LIBGEO", "ZONE_123")

# Ouverture de la base INSEE servant de référence
INSEE_passage <- read_excel("raw-data/INSEE/INSEE_DATA/Passage_communes_2003_2019.xls")
INSEE_passage <- subset(INSEE_passage, NIVGEO == "COM") # On enlève les arrondissements
INSEE_passage <- INSEE_passage[,2:35] # On enlève la variable qui distinguait les arrondissements


# Comparaison de la base 123 avec les communes INSEE de 2005

## Construction de la base communes de 2005
INSEE_2005 <- INSEE_passage[,c("CODGEO_2005", "LIBGEO_2005")]
INSEE_2005 <- subset(INSEE_2005, !duplicated(INSEE_2005)) # On enlève les doublons

## Appariemment 
INSEE_2005$INSEE <- "INSEE" # Création d'un champ qui permette d'identifier les communes issues de la base INSEE ; pour la base 123 on utilise la variable "ZONE_123". 
Test <- merge(DB_123, INSEE_2005, by.x = "CODGEO", by.y = "CODGEO_2005", all = T)

## Analyse du résultat
### Identification des communes de la base INSEE qui ne sont pas dans la base 123
table(is.na(Test$ZONE_123)) # 33 communes existent dans la base à tester qui n'existent pas en 2005.
table(is.na(Test$INSEE)) # 29 communes existent en 2005 et n'existent pas dans la base à tester.

# On note que parmi les communes de la DB_123 qui n'existent pas en 2005 se trouvent les communes de Mayotte (départementalisé en 2011) et celle de Verquigneul (dont la fusion a été annulée en 2008)


# Comparaison de la base 123 avec les communes INSEE de 2014

## Construction de la base communes de 2014
INSEE_2014 <- INSEE_passage[,c("CODGEO_2014", "LIBGEO_2014")]
INSEE_2014 <- subset(INSEE_2014, !duplicated(INSEE_2014)) # On enlève les doublons

## Appariemment 
INSEE_2014$INSEE <- "INSEE" # Création d'un champ qui permette d'identifier les communes issues de la base INSEE ; pour la base 123 on utilise la variable "ZONE_123". 
Test <- merge(DB_123, INSEE_2014, by.x = "CODGEO", by.y = "CODGEO_2014", all = T)

## Analyse du résultat
### Identification des communes de la base INSEE qui ne sont pas dans la base 123
table(is.na(Test$ZONE_123)) # 1 seul NA, qui correspond à une ligne de NA...
table(is.na(Test$INSEE)) # 0 NA

# On considère donc que la DB_123 correspond au millésime 2014.

colnames(DB_123) <- c("CODGEO_2014", "LIBGEO_2014", "ZONE_123_2014")
DB_123$ZONE_123_2014 <- substr(DB_123$ZONE_123_2014, 2,2)
write.xlsx(DB_123, "Intermediate/123/2_step/123_2014.xlsx")

3.2 Etapes de traitement

La construction de la base détaillée s’est faite en deux étapes :

• Etape 1.Constitution d’une base unifiée répertoriant l’ensemble des communes de chaque année et les associant à leur zone 1/2/3. Cette table est disponible à : “Output/France/123_detail.xlsx”.

• Etape 2. constitution de bases exposant des résultats agrégés directement exploitables, disponibles à : “Output/France/123_agrege.xlsx”.

3.2.1 Etape 1. Constitution d’une base historique des classements 1/2/3 des communes

Cette étape s’est elle-même divisée en deux sous étapes :

• Etape 1a. Reconstitution du classement 1/2/3 pour les années 2005 à 2019 à partir de la base de 2014. L’enjeu étant l’adaptation du classement aux fusions et divisions communales, ce travail a été mené selon une méthode analogue à celle utilisée en 2.2.3.2.

• Etape 1b. Reconstitution des classements des années 2004 puis 2003 à partir de celle disponible pour l’année 2005 et des textes de loi.

3.2.1.1 Etape 1a. Reconstitution du classement 1/2/3 pour les années 2005 à 2019

3.2.1.1.1 Années 2015-2019

Ont d’abord été classées les communes des années 2015 à 2019 selon un procédé proche de celui utilisé en 2.2.3.2 :

• Lorsque deux communes fusionnent, la nouvelle commune garde le code INSEE d’une des communes fusionnées. On attribue alors à la nouvelle commune la zone de la commune dont le code INSEE a été conservé.

• Lorsque deux communes se divisent, je me réfère aux zones proposées par le simulateur disponible en ligne sur le site service-public.fr. Dans les cas de divisions, une des communes filles garde le code, donc le classement, de la commune mère.

J’indique dans le document .html le script correspond à l’année 2015. Les scripts correspondant aux années 2016 à 2019 sont visibles dans le document .Rmd.

##########
## 2015 ##
##########


# Ouverture de la base 123 de 2014
DB_123_2014 <- read_excel("Intermediate/123/2_step/123_2014.xlsx")
DB_123_2014 <- DB_123_2014[,c(1,3)]

# Ouverture de la base INSEE
INSEE_passage <- read_excel("raw-data/INSEE/INSEE_DATA/Passage_communes_2003_2019.xls")
INSEE_passage <- subset(INSEE_passage, NIVGEO == "COM") # On enlève les arrondissements
INSEE_passage <- INSEE_passage[,2:35] # On enlève la variable qui distinguait les arrondissements

# On produit la liste des communes françaises de 2004 à partir de la table ABC complète
INSEE_2015 <- INSEE_passage[, c("CODGEO_2015", "LIBGEO_2015")]
INSEE_2015 <- subset(INSEE_2015, !duplicated(INSEE_2015$CODGEO_2015))
INSEE_2015 <- subset(INSEE_2015, !is.na(INSEE_2015$CODGEO_2015))

# On fusionne les deux
DB_123_2015 <- merge(DB_123_2014, INSEE_2015, by.x = "CODGEO_2014", by.y = "CODGEO_2015", all.y = T)

# On analyse les erreurs d'appariemment :
table(is.na(DB_123_2015$CODGEO_2014)) 
table(is.na(DB_123_2015$ZONE_123_2014)) # 1 NA, qui correspond à la commune de Culey (55138).
table(is.na(DB_123_2015$LIBGEO_2015)) # 0 NA.

# D'après le simulateur du site service-public.fr, la commune de Culey est située en zone 3.

# On produit la table 123 2015
colnames(DB_123_2015) <- c("CODGEO_2015", "ZONE_123_2015", "LIBGEO_2015")
DB_123_2015$ZONE_123_2015[is.na(DB_123_2015$ZONE_123_2015)] <- "3"

# On la sauvegarde
write.xlsx(DB_123_2015, "Intermediate/123/2_step/123_2015.xlsx")

3.2.1.1.2 Années 2005-2013

Ont d’ensuite été classées les communes des années 2005 à 2013 selon un procédé inverse.

• Lorsque deux communes ont fusionné, c’est-à-dire qu’une commune qui existait en n n’existe pas en n-1, on vérifie son classement directement sur la version modifiée du classement 1/2/3 présentée sur le site Legifrance par recherche d’expression. Lorsque la commune n’est pas indiquée dans l’annexe de l’article, c’est-à-dire qu’elle est placée en zone 3, on vérifie le nom de la commune fille et son classement sur la table INSEE. Dans ces situations, la commune fille était toujours également classée en zone 3.

• Le cas des divisions communales est éliminé par construction. Dans l’assemblage final, les communes qui n’existent pas en n-i et existent en n seront simplement indentifiée “NA”.

J’indique dans le document .html le script correspond à l’année 2013. Les scripts correspondant aux années 2005 à 2012 sont visibles dans le document .Rmd.

##########
## 2013 ##
##########


DB_123_2014 <- DB_123_2014[,c("CODGEO_2014", "ZONE_123_2014")]

# On produit la liste des communes françaises de 2004 à partir de la table ABC complète
INSEE_2013 <- INSEE_passage[, c("CODGEO_2013", "LIBGEO_2013")]
INSEE_2013 <- subset(INSEE_2013, !duplicated(INSEE_2013$CODGEO_2013))
INSEE_2013 <- subset(INSEE_2013, !is.na(INSEE_2013$CODGEO_2013))

# On fusionne les deux
DB_123_2013 <- merge(DB_123_2014, INSEE_2013, by.x = "CODGEO_2014", by.y = "CODGEO_2013", all.y = T)

# On analyse les erreurs d'appariemment :
table(is.na(DB_123_2013$CODGEO_2014)) 
table(is.na(DB_123_2013$ZONE_123_2014)) # 1 NA : 1 fusion communale entre 2013 et 2014 :    Pautaines-Augeville (52379), qui n'apparaît pas dans le texte de loi Legifrance, ce qui la place par défaut dans la zone 3
table(is.na(DB_123_2013$LIBGEO_2013)) # 0 NA par construction

# On produit la table 123 2013
colnames(DB_123_2013) <- c("CODGEO_2013", "ZONE_123_2013", "LIBGEO_2013")
DB_123_2013$ZONE_123_2013[is.na(DB_123_2013$ZONE_123_2013)] <- "3"

# On la sauvegarde
write.xlsx(DB_123_2013, "Intermediate/123/2_step/123_2013.xlsx")

3.2.1.2 Etape 1b. Reconstitution des classements des années 2004 puis 2003

Pour les années 2004 et 2003, on procède par rétro-classification à partir de la liste des communes reclassées détaillée dans les arrêtés de 2005 et 2004.

• L’arrêté de 2005 reclasse des communes de zone 2 en zone 1. La table de 2004 a donc été élaborée en passant les communes listées par l’arrêté de la zone 1 à la zone 2 à partir de la table de 2005. Ces communes se situent toutes dans les départements de la Seine-et-Marne (77), des Yvelines (78), de l’Essonne (91), du Val d’Oise (95).

• L’arrêté de 2004 reclasse des communes de zone 3 en zone 2. De même, la table de 2003 a été élaborée en passant les communes listées de la zone 2 à la zone 3 à partir de la table de 2004. Ces communes se situent seulement dans les départements de l’Ain (01) et de Haute-Savoie (74).

Ces reclassements ont été effectués à la main à partir de la table fournie sur le site du ministère de la Cohésion des territoires. Ces tables ainsi produites ont été adaptées au découpage communal des deux années de référence selon les scripts suivants :

##########
## 2004 ##
##########


# Ouverture de la base corrigée à la main des communes de 2004
DB_123_2004 <- read_excel("Intermediate/123/1_step/123_2004.xls")
DB_123_2004 <- DB_123_2004[,c(1, 3)]
colnames(DB_123_2004) <- c("CODGEO_2004", "ZONE_123_2004")
DB_123_2004$ZONE_123_2004 <- substr(DB_123_2004$ZONE_123_2004, 2,2)

# On produit la liste des communes françaises de 2004 à partir de la table ABC complète
INSEE_2004 <- INSEE_passage[, c("CODGEO_2004", "LIBGEO_2004")]
INSEE_2004 <- subset(INSEE_2004, !duplicated(INSEE_2004$CODGEO_2004))
INSEE_2004 <- subset(INSEE_2004, !is.na(INSEE_2004$CODGEO_2004))

DB_123_2004 <- merge(DB_123_2004, INSEE_2004, by = "CODGEO_2004", all.y = T)

table(is.na(DB_123_2004$ZONE_123_2004)) # 32 NA qui correspondent aux communes fusionnées entre 2004 et 2014

# 2013 [1] : 52379 (zone 3)
# 2012 [19] : 05002 (zone 3)    ; 05020 (zone 3)    ; 05042 (zone 3) ;  05067 (zone 3)  ;   05138 (zone 3)  ;   49199 (zone 3)  ;   49213 (zone 3)  ; 49245 (zone 3)    ;   49303 (zone 3)  ;   49372 (zone 3)  ;   49380 (zone 3)  ;   69025 (zone 3)  ; 69041 (zone 3)    ;   69128 (zone 3)  ;   69129 (zone 3)  ;   69144 (zone 3)  ;   79353 (zone 3)  ;   79356 (zone 3)  ;   88282 (zone 3)
# 2011 [2] : 76095 (zone 2) ; 28042 (zone 3)
# 2010 [2] : 59248 (zone 2) et 59540 (zone 2)
# 2009 [0]
# 2008 [1] : 21551  (zone 3)
# 2007 [4] : 50216 (zone 3) 81107 (zone 3)  ;   97123 (zone 3)  ; 97127 (zone 3) 
# 2006 [4] : 39524 (zone 3) ;   79037 (zone 3)  ;   79305 (zone 3)  ;   80370 (zone 3)
# 2005 [0]
# On a donc 33 fusions, dont il faut déduire le cas de Bihorel (76095), qui a disparu entre 2012 et 2013 seulement. Le compte est donc bon, on corrige les zones manuellement :
DB_123_2004$ZONE_123_2004[DB_123_2004$CODGEO_2004 == "59248" | DB_123_2004$CODGEO_2004 == "59540"] <- "2"
DB_123_2004$ZONE_123_2004[is.na(DB_123_2004$ZONE_123_2004)] <- "3"

# On la sauvegarde
write.xlsx(DB_123_2004, "Intermediate/123/2_step/123_2004.xlsx")

DB_123_2004 <- DB_123_2004[,c(1:2)]


##########
## 2003 ##
##########


# Ouverture de la base corrigée à la main des communes de 2003
DB_123_2003 <- read_excel("Intermediate/123/1_step/123_2003.xls")
DB_123_2003 <- DB_123_2003[,c(1, 3)]
colnames(DB_123_2003) <- c("CODGEO_2003", "ZONE_123_2003")
DB_123_2003$ZONE_123_2003 <- substr(DB_123_2003$ZONE_123_2003, 2,2)

# On produit la liste des communes françaises de 2003 à partir de la table ABC complète
INSEE_2003 <- INSEE_passage[, c("CODGEO_2003", "LIBGEO_2003")]
INSEE_2003 <- subset(INSEE_2003, !duplicated(INSEE_2003$CODGEO_2003))
INSEE_2003 <- subset(INSEE_2003, !is.na(INSEE_2003$CODGEO_2003))

DB_123_2003 <- merge(DB_123_2003, INSEE_2003, by = "CODGEO_2003", all.y = T)

table(is.na(DB_123_2003$ZONE_123_2003)) # 32 NA qui correspondent aux communes fusionnées entre 2003 et 2014

# 2013 [1] : 52379 (zone 3)
# 2012 [19] : 05002 (zone 3)    ; 05020 (zone 3)    ; 05042 (zone 3) ;  05067 (zone 3)  ;   05138 (zone 3)  ;   49199 (zone 3)  ;   49213 (zone 3)  ; 49245 (zone 3)    ;   49303 (zone 3)  ;   49372 (zone 3)  ;   49380 (zone 3)  ;   69025 (zone 3)  ; 69041 (zone 3)    ;   69128 (zone 3)  ;   69129 (zone 3)  ;   69144 (zone 3)  ;   79353 (zone 3)  ;   79356 (zone 3)  ;   88282 (zone 3)
# 2011 [2] : 76095 (zone 2) ; 28042 (zone 3)
# 2010 [2] : 59248 (zone 2) et 59540 (zone 2)
# 2009 [0]
# 2008 [1] : 21551  (zone 3)
# 2007 [4] : 50216 (zone 3) 81107 (zone 3)  ;   97123 (zone 3)  ; 97127 (zone 3) 
# 2006 [4] : 39524 (zone 3) ;   79037 (zone 3)  ;   79305 (zone 3)  ;   80370 (zone 3)
# 2005 [0]
# On a donc 33 fusions, dont il faut déduire le cas de Bihorel (76095), qui a disparu entre 2012 et 2013 seulement. Le compte est donc bon, on corrige les zones manuellement :
DB_123_2003$ZONE_123_2003[DB_123_2003$CODGEO_2003 == "59248" | DB_123_2003$CODGEO_2003 == "59540"] <- "2"
DB_123_2003$ZONE_123_2003[is.na(DB_123_2003$ZONE_123_2003)] <- "3"

# On la sauvegarde
write.xlsx(DB_123_2003, "Intermediate/123/2_step/123_2003.xlsx")

DB_123_2003 <- DB_123_2003[,c(1:2)]

Une fois créées les tables annuelles, on produit une base unifiée à partir de la base INSEE passage

# Jointure des tables annuelles

DB_123 <- merge(INSEE_passage, DB_123_2003, by = "CODGEO_2003", all.x = T)
DB_123 <- merge(DB_123, DB_123_2004, by = "CODGEO_2004", all.x = T)
DB_123 <- merge(DB_123, DB_123_2005, by = "CODGEO_2005", all.x = T)
DB_123 <- merge(DB_123, DB_123_2006, by = "CODGEO_2006", all.x = T)
DB_123 <- merge(DB_123, DB_123_2007, by = "CODGEO_2007", all.x = T)
DB_123 <- merge(DB_123, DB_123_2008, by = "CODGEO_2008", all.x = T)
DB_123 <- merge(DB_123, DB_123_2009, by = "CODGEO_2009", all.x = T)
DB_123 <- merge(DB_123, DB_123_2010, by = "CODGEO_2010", all.x = T)
DB_123 <- merge(DB_123, DB_123_2011, by = "CODGEO_2011", all.x = T)
DB_123 <- merge(DB_123, DB_123_2012, by = "CODGEO_2012", all.x = T)
DB_123 <- merge(DB_123, DB_123_2013, by = "CODGEO_2013", all.x = T)
DB_123 <- merge(DB_123, DB_123_2014, by = "CODGEO_2014", all.x = T)
DB_123 <- merge(DB_123, DB_123_2015, by = "CODGEO_2015", all.x = T)
DB_123 <- merge(DB_123, DB_123_2016, by = "CODGEO_2016", all.x = T)
DB_123 <- merge(DB_123, DB_123_2017, by = "CODGEO_2017", all.x = T)
DB_123 <- merge(DB_123, DB_123_2018, by = "CODGEO_2018", all.x = T)
DB_123 <- merge(DB_123, DB_123_2019, by = "CODGEO_2019", all.x = T)
# Des doublons apparaissent uniquement à cette dernière étape, d'une façon un peu inexplicable. On les enlève :
DB_123 <- subset(DB_123, !duplicated(DB_123))

# Réorganisation de la table unifiée
DB_123 <- DB_123[, c("CODGEO_2019", "LIBGEO_2019", "CODGEO_2018", "LIBGEO_2018","CODGEO_2017", "LIBGEO_2017","CODGEO_2016", "LIBGEO_2016", "CODGEO_2015", "LIBGEO_2015", "CODGEO_2014", "LIBGEO_2014", "CODGEO_2013", "LIBGEO_2013","CODGEO_2012", "LIBGEO_2012","CODGEO_2011", "LIBGEO_2011","CODGEO_2010", "LIBGEO_2010","CODGEO_2009", "LIBGEO_2009","CODGEO_2008", "LIBGEO_2008","CODGEO_2007", "LIBGEO_2007","CODGEO_2006", "LIBGEO_2006","CODGEO_2005", "LIBGEO_2005","CODGEO_2004", "LIBGEO_2004","CODGEO_2003", "LIBGEO_2003", "ZONE_123_2003","ZONE_123_2004", "ZONE_123_2005","ZONE_123_2006", "ZONE_123_2007", "ZONE_123_2008","ZONE_123_2009","ZONE_123_2010", "ZONE_123_2011", "ZONE_123_2012", "ZONE_123_2013","ZONE_123_2014", "ZONE_123_2015", "ZONE_123_2016", "ZONE_123_2017", "ZONE_123_2018","ZONE_123_2019")]


# Exportation de la table unifiée
write.xlsx(DB_123, "Output/France/123_detail.xlsx")

3.2.2 Etape 2. Agrégation des données

L’agrégation des données se limite à une table de l’évolution des effectifs. Celle-ci est d’un intérêt assez faible après 2005, aucun reclassement n’ayant été opéré depuis cette date.

Concernant les dispositifs d’aide à l’accession, le seul dont l’éligibilité soit conditionnée à la localisation du bien selon le classement 1/2/3 sont les APL accession, qui ne sont plus disponibles qu’en zone 3 depuis 2018. Le calcul étant immédiat à partir du tableau des effectifs par zone, il n’a pas fait l’objet d’un tableau propre. La table synthétique ainsi élaborée est stockée en "Output/France

# Calcul pour 2003
DB_123_03 <- read_excel("Intermediate/123/2_step/123_2003.xlsx")
a03 <- sum(DB_123_03$ZONE_123_2003 == "1")
b03 <- sum(DB_123_03$ZONE_123_2003 == "2")
c03 <- sum(DB_123_03$ZONE_123_2003 == "3")
t03 <- nrow(DB_123_03)

# Calcul pour 2004
DB_123_04 <- read_excel("Intermediate/123/2_step/123_2004.xlsx")
a04 <- sum(DB_123_04$ZONE_123_2004 == "1")
b04 <- sum(DB_123_04$ZONE_123_2004 == "2")
c04 <- sum(DB_123_04$ZONE_123_2004 == "3")
t04 <- nrow(DB_123_04)

# Calcul pour 2005
DB_123_05 <- read_excel("Intermediate/123/2_step/123_2005.xlsx")
a05 <- sum(DB_123_05$ZONE_123_2005 == "1")
b05 <- sum(DB_123_05$ZONE_123_2005 == "2")
c05 <- sum(DB_123_05$ZONE_123_2005 == "3")
t05 <- nrow(DB_123_05)

# Calcul pour 2006
DB_123_06 <- read_excel("Intermediate/123/2_step/123_2006.xlsx")
a06 <- sum(DB_123_06$ZONE_123_2006 == "1")
b06 <- sum(DB_123_06$ZONE_123_2006 == "2")
c06 <- sum(DB_123_06$ZONE_123_2006 == "3")
t06 <- nrow(DB_123_06)

# Calcul pour 2007
DB_123_07 <- read_excel("Intermediate/123/2_step/123_2007.xlsx")
a07 <- sum(DB_123_07$ZONE_123_2007 == "1")
b07 <- sum(DB_123_07$ZONE_123_2007 == "2")
c07 <- sum(DB_123_07$ZONE_123_2007 == "3")
t07 <- nrow(DB_123_07)

# Calcul pour 2008
DB_123_08 <- read_excel("Intermediate/123/2_step/123_2008.xlsx")
a08 <- sum(DB_123_08$ZONE_123_2008 == "1")
b08 <- sum(DB_123_08$ZONE_123_2008 == "2")
c08 <- sum(DB_123_08$ZONE_123_2008 == "3")
t08 <- nrow(DB_123_08)

# Calcul pour 2009
DB_123_09 <- read_excel("Intermediate/123/2_step/123_2009.xlsx")
a09 <- sum(DB_123_09$ZONE_123_2009 == "1")
b09 <- sum(DB_123_09$ZONE_123_2009 == "2")
c09 <- sum(DB_123_09$ZONE_123_2009 == "3")
t09 <- nrow(DB_123_09)

# Calcul pour 2010
DB_123_10 <- read_excel("Intermediate/123/2_step/123_2010.xlsx")
a10 <- sum(DB_123_10$ZONE_123_2010 == "1")
b10 <- sum(DB_123_10$ZONE_123_2010 == "2")
c10 <- sum(DB_123_10$ZONE_123_2010 == "3")
t10 <- nrow(DB_123_10)

# Calcul pour 2011
DB_123_11 <- read_excel("Intermediate/123/2_step/123_2011.xlsx")
a11 <- sum(DB_123_11$ZONE_123_2011 == "1")
b11 <- sum(DB_123_11$ZONE_123_2011 == "2")
c11 <- sum(DB_123_11$ZONE_123_2011 == "3")
t11 <- nrow(DB_123_11)

# Calcul pour 2012
DB_123_12 <- read_excel("Intermediate/123/2_step/123_2012.xlsx")
a12 <- sum(DB_123_12$ZONE_123_2012 == "1")
b12 <- sum(DB_123_12$ZONE_123_2012 == "2")
c12 <- sum(DB_123_12$ZONE_123_2012 == "3")
t12 <- nrow(DB_123_12)

# Calcul pour 2013
DB_123_13 <- read_excel("Intermediate/123/2_step/123_2013.xlsx")
a13 <- sum(DB_123_13$ZONE_123_2013 == "1")
b13 <- sum(DB_123_13$ZONE_123_2013 == "2")
c13 <- sum(DB_123_13$ZONE_123_2013 == "3")
t13 <- nrow(DB_123_13)

# Calcul pour 2014
DB_123_14 <- read_excel("Intermediate/123/2_step/123_2014.xlsx")
a14 <- sum(DB_123_14$ZONE_123_2014 == "1")
b14 <- sum(DB_123_14$ZONE_123_2014 == "2")
c14 <- sum(DB_123_14$ZONE_123_2014 == "3")
t14 <- nrow(DB_123_14)

# Calcul pour 2015
DB_123_15 <- read_excel("Intermediate/123/2_step/123_2015.xlsx")
a15 <- sum(DB_123_15$ZONE_123_2015 == "1")
b15 <- sum(DB_123_15$ZONE_123_2015 == "2")
c15 <- sum(DB_123_15$ZONE_123_2015 == "3")
t15 <- nrow(DB_123_15)

# Calcul pour 2016
DB_123_16 <- read_excel("Intermediate/123/2_step/123_2016.xlsx")
a16 <- sum(DB_123_16$ZONE_123_2016 == "1")
b16 <- sum(DB_123_16$ZONE_123_2016 == "2")
c16 <- sum(DB_123_16$ZONE_123_2016 == "3")
t16 <- nrow(DB_123_16)

# Calcul pour 2017
DB_123_17 <- read_excel("Intermediate/123/2_step/123_2017.xlsx")
a17 <- sum(DB_123_17$ZONE_123_2017 == "1")
b17 <- sum(DB_123_17$ZONE_123_2017 == "2")
c17 <- sum(DB_123_17$ZONE_123_2017 == "3")
t17 <- nrow(DB_123_17)

# Calcul pour 2018
DB_123_18 <- read_excel("Intermediate/123/2_step/123_2018.xlsx")
a18 <- sum(DB_123_18$ZONE_123_2018 == "1")
b18 <- sum(DB_123_18$ZONE_123_2018 == "2")
c18 <- sum(DB_123_18$ZONE_123_2018 == "3")
t18 <- nrow(DB_123_18)

# Calcul pour 2019
DB_123_19 <- read_excel("Intermediate/123/2_step/123_2019.xlsx")
a19 <- sum(DB_123_19$ZONE_123_2019 == "1")
b19 <- sum(DB_123_19$ZONE_123_2019 == "2")
c19 <- sum(DB_123_19$ZONE_123_2019 == "3")
t19 <- nrow(DB_123_19)


Tab3 <- data.frame(Année = c(2003:2019),
                  Zone_1 = c(a03, a04, a05, a06, a07, a08, a09, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19),
                  Zone_2 = c(b03, b04, b05, b06, b07, b08, b09, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19),
                  Zone_3 = c(c03, c04, c05, c06, c07, c08, c09, c10, c11, c12, c13, c14, c15, c16, c17, c18, c19),
                  Total = c(t03, t04, t05, t06, t07, t08, t09, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19))

colnames(Tab3) <- c("Année", "Zone 1", "Zone 2", "Zone 3", "Total")

knitr::kable(Tab3)

Année	Zone 1	Zone 2	Zone 3	Total
2003	436	3053	33189	36678
2004	436	3129	33117	36682
2005	764	2801	33119	36684
2006	764	2801	33120	36685
2007	764	2801	33118	36683
2008	764	2802	33115	36681
2009	764	2802	33116	36682
2010	764	2802	33116	36682
2011	764	2800	33116	36680
2012	764	2816	33120	36700
2013	764	2816	33101	36681
2014	764	2817	33100	36681
2015	764	2816	33078	36658
2016	764	2811	32310	35885
2017	763	2804	31849	35416
2018	762	2803	31792	35357
2019	759	2797	31414	34970

Tab3 <- t(Tab3)
Tab3 <- as.data.frame(Tab3)
colnames(Tab3) <- c(2003:2019)
Tab3 <- Tab3[-1,]
rownames(Tab3) <- c("Année", "Zone 1", "Zone 2", "Zone 3")

4 Les dispositifs d’aide à l’acquisition à Paris, Lyon et Avignon : présentation et cartographie

Cette partie vise à produire une cartographie historique la plus complète possible des dispositifs d’aide à l’acquisition immobilière sur les FUA de Paris, Lyon et Avignon. Ces dispositifs se distinguent les uns des autres de plusieurs façons : leur maillage de référence (communal pour l’essentiel), leur caractère local ou national, leur dimension exclusive ou non (certaines zones sont-elles inéligibles ?).

A noter : le dispositif Malraux, bien que représentant une aide fiscale très conséquente, n’a pas été étudié ici, pour des raisons de manque de temps et de rareté des données (les conditions d’éligibilité sont très nombreuses et les divers zonages associés souvent difficiles à appréhender).

4.1 Présentation et sources

4.1.1 Les dispositifs nationaux

4.1.1.1 Présentation

Cette catégorie regroupe pour l’essentiel : les aides fiscales à l’investissement locatif (qui correspondent à l’actuel dispositif Pinel), les prêts à taux zéro (PTZ), la TVA réduite, l’APL accession et l’aide fiscale à la rénovation pour les propriétaires bailleurs (mise en place avec le dispositif Denormandie de 2019). Parmi ces dispositifs, en 2020, seule l’éligibilité au PTZ dans le neuf n’est pas dépendante de la localisation du logement.

A l’exception de la TVA réduite, les conditions géographiqes d’accès à ces dispositifs sont définies à l’échelle de la commune.

• L’évolution des conditions d’éligibilité aux aides fiscales à l’investissement locatif, au PTZ et à l’APL accession sont détaillées en 1.1 et 1.2.

• Le dispositif Denormandie, instauré en 2019, repose sur un modèle proche du dispositif Pinel. Il offre une réduction d’impôt sur le revenu aux bailleurs propriétaires réalisant des travaux de rénovation (pouvant aller jusqu’à 25% du montant de l’opération). Il est accessible dans les 222 communes cibles du plan Action coeur de ville (dont font par exemple partie Avignon et Vienne).

• La TVA réduite pour la construction de logement en accession est instaurée en 2006. De 2006 à 2014, elle concerne les secteurs du programme national de rénovation urbaine (PNRU). A partir de 2015, elle s’applique également aux quartiers prioritaires des politiques de la ville (QPV). Du fait de son caractère infracommunal et de la relative complexité de ses critères d’éligibilité, elle dispose d’une section autonome.

4.1.1.2 Sources

La cartographie de l’éligibilité aux aides fiscales à l’investissement locatif, au PTZ et à l’APL accession s’appuie sur les tables réalisées en parties 2 et 3 de ce document.

La liste des 222 communes éligibles au dispositif Denormandie est indiquée sur le site du ministère de la Cohésion des territoires. Pour chacune est renseignée le code INSEE.

La cartographie des QPV est librement accessible sur le site data.gouv.fr. En revanche, le périmètre des secteurs du PNRU est plus difficile à obtenir. Pour l’Ile-de-France, les périmètre des PNRU sont recensés sur le site data.iledefrance.fr. En revanche, pour le reste des territoires de l’étude, de tels sources n’existent pas. La seule liste exhaustive semble être celle proposée par le site sig.ville.gouv.fr, alimenté par l’ANCT, qui présente comme inconvénient majeur de proposer comme seul support cartographique un dessin du périmètre du PNRU au format .pdf. La cartographie des secteurs ANRU a donc été menée par digitalisation avec le logiciel QGIS à partir des périmètres proposés par l’ANCT. - L’ensemble des fichiers PDF qui ont été utilisés sont disponibles dans le dossier “raw-data_MCT_PNRU”

• Les fichiers shape utilisés pour l’Ile-de-France sont stockés dans le dossier “raw-data/IPR/PRU_IDF” (pour Institut Paris Région).

Le tableau ci-dessous vaut pour l’année 2019 :

Dispositif	Zonage de référence	Secteurs éligibles	Sources
Aide fiscale à l’investissement locatif (Pinel)	A/B/C	A bis, A, B1	WIsDHoM : Table ABC_detail
PTZ dans le neuf	A/B/C	Tous	WIsDHoM : Table ABC_detail
PTZ dans l’ancien	A/B/C	B2, C	WIsDHoM : Table ABC_detail
APL accession	1/2/3	3	WIsDHoM : Table 123_detail
Aide fiscale à la rénovation pour les propriétaires bailleurs (Denormandie)	Action coeur de ville	Communes de l’Action coeur de ville	ANCT
TVA réduite	PNRU / QPV	QPV + tampon de 300m	Région IDF (PNRU de l’IDF), ANCT (PNRU hors IDF et QPV)

4.1.2 Les dispositifs locaux

A ces zonages nationaux, s’ajoutent certains dispositifs locaux mis en place par une commune ou une métropole. Ces aides ou contraintes locales sont difficiles à lister de façon exhaustive faute de recensements. Certaines aides sont présentées sur les sites des ADIL des territoires concernées, mais ce n’est pas systématique.

Les aides des Fonds de solidarité logement (FSL) de la CAF ne sont pas étudiées dans la suite. Il s’agit d’un dispositif national géré à l’échelon départemental adressé autant aux locataires qu’aux propriétaires.

Après une présentation du cas particulier des OFS, on présente les différents dispositifs locaux FUA par FUA

4.1.2.1 Les OFS

Un organisme de foncier solidaire (OFS) est organisme à but non lucratif agréé par le préfet dont la fonction est de gérer du foncier. Un OFS propose des baux réels solidaires (BRS), instaurés par la loi ALUR de 2014 et inspirés par le modèle du Pass Foncier (2007-2011) et du Community Land Trust. Il permet à des ménages de devenir propriétaires d’un logement à un prix inférieur à ce qui se pratique sur le marché, en contrepartie de quoi l’OFS reste propriétaire du foncier (le ménage loue le foncier à l’OFS en s’acquittant d’une redevance foncière). Les propriétaires peuvent louer ou revendre le logement sous certaines conditions. Dans le second cas, il retrouve sa mise initiale à laquelle s’ajoute une plus-value (limitée par une clause anti-spéculative). Les ménages sont sélectionnés par l’OFS.

Des OFS existent ou sont en cours d’élaboration sur les trois territoires étudiés :

• A Paris, plusieurs OFS cohabitent.

  • La Coopérative foncière francilienne a été créée fin 2017 par association de groupements HLM. Elle réalise pour l’instant des opérations en première couronne, sur les communes du Kremlin-Bicêtre, Gennevilliers et Bagneux (une fiche réalisée par le CEREMA sur cet OFS est disponible ici, consulté le 8 avril 2020).
  • Habitat et humanisme a été créé en 2018 ; il dispose d’un site autonome consultable ici (consulté le 8 avril 2020)
  • La Foncière de Paris a été créée par la Ville de Paris fin 2019 ; une présentation est disponible ici (consulté le 8 avril 2020)

• A Lyon, la Métropole a annoncé au deuxième semestre 2019 la création d’un OFS. Il s’ajouterait à l’Organisme Régional Solidaire (ORSOL), dont une présentation est disponible ici (consulté le 8 avril 2020)

• A Avignon, la Ville d’Avignon travaille également sur la création d’un OFS, dont une présentation réalisée par le CEREMA est disponible ici (consulté le 8 avril 2020)

4.1.2.2 Paris

Dans la FUA de Paris, les dispositifs locaux sont relativement nombreux. La liste établie ci-dessous n’est sans doute pas exhaustive ; les informations indiquées sont à compléter. Concernant les dispositifs mis en place à l’échelle départementale d’abord :

• Seine et Marne (77) [499 communes]. Le prêt de la Caisse départementale d’aide au logement (CADAL) de Seine et Marne est un prêt de 10 000 euros par foyer à 1% accordé pour l’acquisition d’une résidence principale ; les modalités exactes sont présentées ici (consulté le 8 avril 2020).

• Yonne (89) [9 communes] accorde un prêt CODAL pour l’acquisition d’une résidence principale.

• Hauts de Seine (92) [36 communes]. Le conseil général a proposé, de 2009 à 2016, le Prêt logement Hauts de Seine (PLHDS), un prêt à taux zéro destiné aux primo-accédants acquérant une résidence principale (soit logement neuf soit logement social) dont le montant dépendait du type de logement acquis et de la taille du ménage (15 000 euros pour l’acquisition d’un logement social par une personne seule ; 55 200 euros pour l’acquisition d’un logement neuf par un ménage de 5 personnes). Les modalités plus précises sont encore disponibles ici (consulté le 8 avril 2020).

A l’échelle intercommunale, les aides recensées sont rares et ne couvrent que des territoires très restreints. Cependant, les récents regroupements intercommunaux pourraient donner lieu à l’émergence de nouvelles aides locales dans les prochaines années :

• Grand Paris Sud : ex CA Seine-Essonne : PTZ du Grand Paris Sud Seine-Essonne-Sénart, mis en place en 2012, est destiné aux primo-accédant devenant propriétaires de leur résidence principale (neuve ou ancienne) sur le territoire de l’ex CA Seine Essonne (5 communes regroupant un peu plus de 66 000 habitants), sous conditions de ressources. Il s’agit d’un prêt de 15 000 euros remboursable sur 12 ans. Plus d’informations disponibles ici (consulté le 8 avril 2020).

• La CA de Seine-Eure [1 commune : Courcelles-sur-Seine], propose une prime à l’acquisition.

A l’échelle communale :

• Paris : les aides propres à Paris sont essentiellement des prêts aidés et des aides à l’amélioration ou l’entretien du logement (les secondes n’étant pas détaillées ici)

  • Le prêt logement Paris est un prêt à taux zéro accordé par la Ville de Paris pour l’acquisition d’une résidence principale (neuve ou ancienne, avec ou sans travaux, mais aux performances énergétiques de niveau maximum C). Ce prêt, remboursable en 15 ans, est d’un montant de 24 200 euros pour une personne seule sans personne à charge et de 39 600 euros sinon.
  • Le prêt parcours résidentiel est également un prêt à taux zéro accordé par la Ville de Paris, destiné aux locataires sociaux souhaitant acquérir une résidence principale (neuve ou ancienne, avec ou sans travaux). Remboursable sur 15 ans également, son montant est fonction du nombre de personnes du ménage : de 27 500 euros pour une personne seule à 80 000 euros pour un couple avec trois enfants.

• Nanterre : l’accession encadrée consiste à mettre en vente chaque année des logements neufs (entre 20 et 80 d’après le site de la Ville de Nanterre) à des prix inférieurs à ceux du marché.

• Bagneux : met également en place une accession enadrée à la propriété.

Depuis le milieu des années 2010, des chartes promoteurs sont mises en place par des communes d’Ile-de-France. Le seul recensement disponible de ces chartes pour les communes d’IDF de plus de 10 000 habitants a été établi par le cabinet INOVEFA en 2018 ; le compte-rendu de cette étude est disponible ici ainsi que dans le dossier “raw-data/INOVEFA”. Des chartes, incitatives ou contraignantes seraient alors en vigueur dans une cinquantaine de communes d’Ile-de-France. La table .xlsx listant les communes concernées, directement tirée du compte-rendu cité ci-dessus, est également indiquée dans le dossier “raw-data”. Ces chartes sont très hétéroclites et demandent d’être étudiées au cas par cas pour en cerner les effets.

Les principaux dispositifs recensés dans la FUA de Paris sont donc :

Nom	Type	Territoire	Source
Prêt CADAL	Prêt à l’acquisition d’une résidence principale	Conseil départemental de Seine et Marne	CADAL 77
Prêt PLHDS	Prêt aux primo-accédants devenant propriétaires de leur résidence principale	Conseil général des Hauts de Seine	ADIL 92
Prêt logement Paris et prêt parcours résidentiel	Prêt à l’acquisition d’une résidence principale	Ville de Paris	Ville de Paris
Chartes promoteurs	Contraintes ou incitations aux promoteurs	Communes	INOVEFA

4.1.2.3 Lyon

Dans la FUA de Lyon, l’essentiel des dispositifs locaux en application en 2020 sont organisés par la Métropole de Lyon (ex Grand Lyon) :

• Le dispositif Louer solidaire offre aux propriétaires bailleurs, en contrepartie de loyers plafonnés (selon la zone géographique), de faire gérer leurs biens par des associations agréées par la Métropole de Lyon et de disposer de déductions fiscales sur les revenus locatifs pouvant aller jusqu’à 85%. La date d’instauration de ce dispositif n’est pas claire.

• Le Plan 3A, pour “Accession A prix Abordable”, offre une prime de 2000 à 6000 euros à l’acquéreur d’un logement portant le label 3A. Celui-ci est attribué aux opérations effectuées en dessous d’un seuil de prix défini en fonction de la commune et, pour Lyon et Villeurbanne, du quartier selon les modalités précisées ici (consulté le 3 avril 2020). Le montant de la prime est fonction de la taille du ménage et de la commune où se situe le bien ; la carte de ces secteurs, produite par le Grand Lyon, est disponible ici (consulté le 3 avril 2020). Le Plan 3A a été instauré en 2013 et ponctuellement interrompu en 2018.

• Les Secteurs mixité sociale, instaurés en 2008, définissent des quotas de logements aidés pour les programmes neufs.

• La régulation du marché des meublés de tourisme, visiblement menée par la Ville de Lyon depuis 2017, se limite à la commune de Lyon. Les contraintes sont plus strictes pour les biens situés dans l’hypercentre de Lyon (consulté le 3 avril 2020).

En dehors de la Métropole de Lyon, en plus d’aides à la rénovation des logements (assez nombreuses) :

• Ain (01) : le conseil départemental de l’Ain propose un prêt CODAL (consulté le 3 avril 2020) de 15 000 euros à 1% aux primo-accédants devenant propriétaires de leur résidence principale (construction ou acquisition, avec ou sans travaux). Les personnes ayant réalisé un investissement locatif sont inéligibles. L’éligibilité au CODAL est également conditionnée : 1/ Dans le neuf : à l’obtention d’un PTZ et d’un PAS ; 2/ Dans l’ancien d’un PAS seulement.

• Isère (38) : les ADIL ne recensent aucune aide appliquée aux communes de la FUA de Lyon.

• Loire (42) : les aides recensées par l’ADIL concernent seulement les travaux (adaptation du logement à la perte d’autonomie, aide contre la précarité énergétique, etc.) et sont organisées par les CC.

• Rhône (69) : pas d’aide locale hors Métropole de Lyon.

Nom	Type	Territoire	Adossé à un zonage	Eligibilité conditionnée à la localisation	Source
Louer solidaire	Gestion locative et aides fiscales aux propriétaires bailleurs	Métropole de Lyon	Oui	Non	Louer solidaire
Plan 3A	Prime aux acquéreurs	Métropole de Lyon	Oui	Non	Métropole de Lyon
Secteurs mixité sociale	Quotas de logements aidés dans les programmes neufs	Métropole de Lyon	Oui	Oui	Data.gouv.fr
Régulation des meublés de tourisme	Contraintes à la location et taxe de séjour	Ville de Lyon	Oui	Non	Ville de Lyon
Prêt CODAL	Prêt aux primo-accédants devenant propriétaires de leur résidence principale	Conseil départemental de l’Ain	Non	Non	CODAL de l’Ain

4.1.2.4 Avignon

• Bouches du Rhône (13) : le conseil départemental propose l’aide ADAPA, qui subventionne l’achat d’un logement ancien (construit avant 1948) au titre de résidence principale, sous certaines conditions de ressources et pour certains secteurs (vieille ville ou secteur OPAH) de certaines communes (liste disponible ici, consulté le 7 avril 2020 - et récapitulé ci-dessous), dont huit font partie de la FUA d’Avignon (tableau ci-dessous). Ce dispositif existe depuis 1986 et prend le nom d’ADAPA en 2008. La prime est d’un montant de 3000 euros, pouvant être majorée à 4000.

Communes	Secteur concerné
Barbentane	Secteur OPAH
Cabanne	Secteur OPAH
Chateaurenard	Secteur OPAH
Eyragues	Secteur OPAH
Maillane	Secteur OPAH
Noves	Totalité
Rognonas	Secteur OPAH
Verquieres	Secteur OPAH

• Gard (30) : les seuls aides recensées par d’ADIL sont spécifiques à Nîmes Métropole.

• Vaucluse (84) : l’ADIL ne recense aucun dispositif d’aide local.

4.1.3 Les secteurs TVA réduite

Depuis 2006, certains secteurs bénéficient d’une TVA réduite à 5,5% pour la construction de logements en accession. Les périmètres de ces secteurs ont été modifiés en 2014, 2015 et 2017. L’ensemble des conditions géographiques d’éligibilité (assez complexes) sont détaillées sur le site de l’ANRU et synthétisés dans une note rapide de l’IAU d’Ile-de-France (consultés le 4 mai 2020).

4.1.3.1 Présentation

Le secteurs TVA réduite englobent :

• De janvier 2006 à décembre 2013 : les secteurs du programme national de rénovation urbaine (PNRU) prolongés d’une bande de 500m.

• De janvier 2014 à décembre 2014 : les secteurs du PNRU prolongés d’une bande de 300m.

• De janvier 2015 à décembre 2016 : s’y ajoutent les quartiers prioritaires des politiques de la ville (QPV) prolongés de 300m également.

• Depuis janvier 2017 : dans le cas où le QPV est porteur d’un NPNRU, l’éligibilité s’étire sur 500m autour du secteur.

L’éligibilité ne dure qu’un certain temps :

• Dans le cas des secteurs du PNRU, elle se termine deux ans après le 31 décembre de la fin du financement du PNRU (ce délai supplémentaire de deux ans a été ajouté par la loi de finance pour 2016).

• Dans le cas des QPV seuls, elle se termine au 31 décembre de l’année de fin du contrat de ville, c’est-à-dire 2020 dans l’essentiel des cas (les dates particulières de fin de chaque contrat n’étant mentionnée nulle part, la date du 31 décembre 2020 a été appliquée à l’ensemble des quartiers).

• Dans le cas des QPV adossés à un NPNRU, elle se termine le 31 décembre 2024.

4.1.3.2 Sources et traitements

4.1.3.2.1 Les quartiers prioritaires des politiques de la ville (2014-2020)

Une base géoréférencée des QPV est disponible sur data.gouv.fr (stockée dans “raw-data”) Les NPNRU sont indiqués sur le site sig.ville.gouv.fr (consultés le 5 mai 2020) : à partir de la carte interactive disponible, les QPV adossés à un NPNRU ont été identifiés et indiqués “à la main”. La base géoréférencée des QPV enrichie des indications relative à l’existence d’un NPNRU est stockée dans “Intermediate/TVA/QPV_NPNRU”.

Ces bases ont ensuite été retraitées et stockées, pour chaque FUA, dans “Dispositifs/Output” selon le script suivant :

require(sf)
require(stringr)

# Ouverture des shapefiles
QPV <- st_read("raw-data/MCT/QPV/QP_METROPOLE_LB93.shp") # La base géoréférencée
fuaPa <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "studyFu")
fuaLy <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "studyFu")
fuaAv <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "studyFu")

# Intersection entre QPV et les shapefiles respectifs
QPV_Pa <- st_intersection(st_buffer(QPV,0), fuaPa)
QPV_Ly <- st_intersection(st_buffer(QPV,0), fuaLy)
QPV_Av <- st_intersection(st_buffer(QPV,0), fuaAv)

# On enregistre
st_write(obj = QPV_Pa, dsn = "Output/Paris/Paris_TVA.gpkg", layer = "QPV_Fu", 
         delete_layer = TRUE, quiet = TRUE)
st_write(obj = QPV_Ly, dsn = "Output/Lyon/Lyon_TVA.gpkg", layer = "QPV_Fu", 
         delete_layer = TRUE, quiet = TRUE)
st_write(obj = QPV_Av, dsn = "Output/Avignon/Avignon_TVA.gpkg", layer = "QPV_Fu", 
         delete_layer = TRUE, quiet = TRUE)

4.1.3.2.2 Les secteurs du PNRU

Les secteurs PNRU sont plus difficiles à obtenir. Leur liste a été établie en compilant trois sources :

• L’Institut Paris Région, qui met à disposition une base géoréférencée des PNRU d’Ile-de-France disponible ici.

• La liste des PNRU mise à disposition par l’ANCT - disponible ici - à partir de laquelle les secteurs PNRU ont été digitalisés avec l’aide d’Adji Diatou Diallo (stagiaire à Avignon Université). La DDT du Rhône met également un disposition, sur data.gouv.fr, une base géoréférencée des secteurs PNRU de son département. Néanmoins, les secteurs en question ne recoupant qu’imparfaitement ceux indiqués sur le site de l’ANCT, on a privilégié la seconde, pour l’essentiel en raison du caractère brouillon de la base disponible (les conventions n’étant par exemple pas référencées par leur numéro ANRU).

Ont ensuite été rajoutées manuellement les date de fin des opérations à partir de la liste fournie (en format PDF) sur le site de l’ANRU (consulté le 4 mai 2020). Le champ “date_fin” indique l’année de la fin du programme du PNRU (et non la fin de l’éligibilité à la TVA réduite). Les tables ainsi modifiées ont été stockées dans le dossier “Dispositifs/Intermediate/TVA/PNRU”.

On produit ensuite un fichier unifié de l’ensemble des périmètres ANRU de la période pour la France entière, stocké dans “Dispositifs/Output/France”, au moyen du script suivant :

# Ouverture et recodage des bases

# Ouverture du fichier hors IDF
France <- st_read("Intermediate/TVA/PNRU_hors-IDF/PNRU.shp")
France <- France[,c(5,6,4,3,1,7,8,2,9,10)]
France$dep <- as.factor(France$dep)
France$pru <- as.character(France$pru)
France$insee1 <- as.character(France$insee1)
France$insee2 <- as.character(France$insee2)
France$date_sign < as.numeric(as.character(France$date_sign))
France$date_fin < as.numeric(as.character(France$date_fin))

# Ouverture du fichier IDF
IDF <- st_read("Intermediate/TVA/PNRU_IDF/perimetres-des-projets-de-renovation-urbaine-pru-dile-de-france.shp")
IDF$insee1 <- as.character(IDF$insee1)
IDF$insee2 <- as.character(IDF$insee2)
IDF$pru <- as.character(IDF$pru)
IDF$date_sign <- substr(IDF$date_sign, 0,4)
IDF$date_fin < as.numeric(as.character(IDF$date_fin))
IDF$date_sign <- as.numeric(as.character(IDF$date_sign))
IDF$pru <- substr(IDF$pru, 1, nchar(IDF$pru)-1) # Correction d'un bug (dédoublement du dernier signe)
IDF$insee1 <- substr(IDF$insee1, 1, nchar(IDF$insee1)-1) # Correction d'un bug (dédoublement du dernier signe)
IDF$insee2 <- substr(IDF$insee2, 1, nchar(IDF$insee2)-1) # Correction d'un bug (dédoublement du dernier signe)
IDF$pru[nchar(IDF$pru) == 1] <- paste0("00", IDF$pru[nchar(IDF$pru) == 1])
IDF$pru[nchar(IDF$pru) == 2] <- paste0("0", IDF$pru[nchar(IDF$pru) == 2])
IDF$insee2[IDF$insee2 == 0] <- NA

IDF <- st_transform(IDF, "+proj=lcc +lat_1=49 +lat_2=44 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m") # Passage en Lambert 93

# Fusion des deux tables
PNRU <- rbind(IDF, France)


# Exports

# Export de la table pour Avignon
Avignon <- subset(PNRU, PNRU$dep == "84") # Cette base n'est constituée que d'une seule entité, mais on peut difficilement faire autrement
st_write(obj = Avignon, dsn = "Output/Avignon/Avignon_TVA.gpkg", layer = "PNRU_Fu", 
         delete_layer = TRUE, quiet = TRUE)
remove(Avignon)
PNRU <- subset(PNRU, !PNRU$dep == "84")

# Export de la table pour Lyon
Lyon <- subset(PNRU, PNRU$dep == "38" | PNRU$dep == "41" | PNRU$dep == "69")
st_write(obj = Lyon, dsn = "Output/Lyon/Lyon_TVA.gpkg", layer = "PNRU_Fu", 
         delete_layer = TRUE, quiet = TRUE)
remove(Lyon)
PNRU <- subset(PNRU, PNRU$dep != "38" & PNRU$dep != "41" & PNRU$dep != "69")

# Export de la table pour Paris
st_write(obj = PNRU, dsn = "Output/Paris/Paris_TVA.gpkg", layer = "PNRU_Fu", 
         delete_layer = TRUE, quiet = TRUE)

4.2 Script R

La cartographie des différents dispositifs s’appuie sur les géométries figurant en Output du dossier geom. Celles-ci correspondant pour l’instant (4 avril 2020) au découpage de 2019, elles ont uniquement donné lieu à des cartographies statiques de l’état de la situation en 2019 pour les FUA de Paris et Lyon. Les 45 communes de la FUA d’Avignon n’ayant pas été affectées par des fusions ni divisions sur la période 2003-2019, l’évolution des zonages et éligibilités des communes aux dispositifs a d’ores-et-déjà pu être cartographiée.

# Packages utilisés 
require(readxl)
require(openxlsx)

## Le chargement a nécessité le package : openxlsx

require(cartography)

## Le chargement a nécessité le package : cartography

## This project is in maintenance mode. 
## Core functionalities of `cartography` can be found in `mapsf`.
## https://riatelab.github.io/mapsf/

require(sf)

## Le chargement a nécessité le package : sf

## Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1

require(dplyr)

## Le chargement a nécessité le package : dplyr

## 
## Attachement du package : 'dplyr'

## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag

## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union

require(readr)
require(rgdal)

## Le chargement a nécessité le package : rgdal

## Le chargement a nécessité le package : sp

## rgdal: version: 1.5-23, (SVN revision 1121)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.2.1, released 2020/12/29
## Path to GDAL shared files: C:/Users/Ronan/Documents/R/win-library/4.1/rgdal/gdal
## GDAL binary built with GEOS: TRUE 
## Loaded PROJ runtime: Rel. 7.2.1, January 1st, 2021, [PJ_VERSION: 721]
## Path to PROJ shared files: C:/Users/Ronan/Documents/R/win-library/4.1/rgdal/proj
## PROJ CDN enabled: FALSE
## Linking to sp version:1.4-5
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading rgdal.
## Overwritten PROJ_LIB was C:/Users/Ronan/Documents/R/win-library/4.1/rgdal/proj

4.2.1 Paris

On crée une base synthétique des données à l’échelon communal sur Paris. Cette base renseigne, pour chaque année, le code INSEE de la commune, son classement dans les zonages A/B/C et 1/2/3. S’y ajoute son appartenance ou non au programme de l’Action coeur de ville ou sa participation à une opération de revitalisation de territoire, la date de signature de l’agrément ministériel et / ou préfectoral le cas échéant.

Cette table (fuaLy_DC pour “dispositifs communaux”) est enregistrée à “Output/Paris/Dispositifs_Paris.xlsx”.

# 1. Chargement des tables

## Ouverture des fonds de cartes des communes de la FUA de fuaPa
fuaPa_COM <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "comFu")
fuaPa_COM <- subset(fuaPa_COM, fuaPa_COM$study == "FUA")
fuaPa_COM <- fuaPa_COM[,c(1,2, 13)]

## Ouverture de la base ABC (France)
ABC <- read_excel("Output/France/ABC_detail.xlsx")

## Ouverture de la base 123 (France)
DB_123 <- read_excel("Output/France/123_detail.xlsx")

## Ouverture de la base Action coeur de ville
ACV <- read_delim("raw-data/MCT/ACV/Action_coeur_ville.csv", ";", escape_double = FALSE, trim_ws = TRUE)
ACV$ACV <- "Oui"
ACV <- ACV[,c(1,4)]

## Ouverture de la base sur les opérations de revitalisation des territoires (ORT)
ORT <- read_excel("raw-data/MCT/ORT/ORT.xlsx")
ORT$ORT <- "Oui"
ORT <- ORT[,c(4,5)]

## Ouverture de la base sur les agréments ministériels (Scellier)
# Agrements_Scellier <- read_excel("raw-data/LEGIFRANCE/Agrements_Scellier.xlsx")
# Agrements_Scellier <- Agrements_Scellier[,c(1,5)]
# colnames(Agrements_Scellier)[2] <- "DATE_AGREM_M"


## Ouverture de la base sur les agréments préfectoraux (Duflot / Pinel)
Agrements <- read_excel("raw-data/MCT/ZONAGE_ABC/Agrements.xls")
Agrements <- Agrements[,c(4,6)]
colnames(Agrements) <- c("CODGEO", "DATE_AGREM_P")
Agrements$DATE_AGREM_P <- substr(Agrements$DATE_AGREM_P, 1, 4)
Agrements$DATE_AGREM_P[is.na(Agrements$DATE_AGREM_P)] <- "2015"


# 2. Fusion des tables

fuaPa_DC <- merge(fuaPa_COM, ABC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- merge(fuaPa_COM, DB_123, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- Interm[,c(1,36:52)]
fuaPa_DC <- (cbind(fuaPa_DC, Interm))
remove(Interm)
fuaPa_DC <- fuaPa_DC[,c(1,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36:52,54:71)]
names(fuaPa_DC)[1] <- "CODGEO_2019"
names(fuaPa_DC)[2] <- "LIBGEO_2019"
fuaPa_DC <- merge(fuaPa_DC, ACV, by.x = "CODGEO_2019", by.y = "INSEE_COM", all.x = T)
fuaPa_DC$ACV[is.na(fuaPa_DC$ACV)] <- "Non"
fuaPa_DC <- merge(fuaPa_DC, ORT, by.x = "CODGEO_2019", by.y = "Code commune", all.x = T)
fuaPa_DC$ORT[is.na(fuaPa_DC$ORT)] <- "Non"
fuaPa_DC <- merge(fuaPa_DC, Agrements, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)
fuaPa_DC <- merge(fuaPa_DC, Agrements_Scellier, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)


# 2b Entrée manuelle des informations sur les arrondissements
fuaPa_DC$ZONE_ABC_2003[is.na(fuaPa_DC$ZONE_ABC_2003)] <- "A"
fuaPa_DC$ZONE_ABC_2004[is.na(fuaPa_DC$ZONE_ABC_2004)] <- "A"
fuaPa_DC$ZONE_ABC_2005[is.na(fuaPa_DC$ZONE_ABC_2005)] <- "A"
fuaPa_DC$ZONE_ABC_2006[is.na(fuaPa_DC$ZONE_ABC_2006)] <- "A"
fuaPa_DC$ZONE_ABC_2007[is.na(fuaPa_DC$ZONE_ABC_2007)] <- "A"
fuaPa_DC$ZONE_ABC_2008[is.na(fuaPa_DC$ZONE_ABC_2008)] <- "A"
fuaPa_DC$ZONE_ABC_2009[is.na(fuaPa_DC$ZONE_ABC_2009)] <- "A"
fuaPa_DC$ZONE_ABC_2010[is.na(fuaPa_DC$ZONE_ABC_2010)] <- "A bis"
fuaPa_DC$ZONE_ABC_2011[is.na(fuaPa_DC$ZONE_ABC_2011)] <- "A bis"
fuaPa_DC$ZONE_ABC_2012[is.na(fuaPa_DC$ZONE_ABC_2012)] <- "A bis"
fuaPa_DC$ZONE_ABC_2013[is.na(fuaPa_DC$ZONE_ABC_2013)] <- "A bis"
fuaPa_DC$ZONE_ABC_2014[is.na(fuaPa_DC$ZONE_ABC_2014)] <- "A bis"
fuaPa_DC$ZONE_ABC_2015[is.na(fuaPa_DC$ZONE_ABC_2015)] <- "A bis"
fuaPa_DC$ZONE_ABC_2016[is.na(fuaPa_DC$ZONE_ABC_2016)] <- "A bis"
fuaPa_DC$ZONE_ABC_2017[is.na(fuaPa_DC$ZONE_ABC_2017)] <- "A bis"
fuaPa_DC$ZONE_ABC_2018[is.na(fuaPa_DC$ZONE_ABC_2018)] <- "A bis"
fuaPa_DC$ZONE_ABC_2019[is.na(fuaPa_DC$ZONE_ABC_2019)] <- "A bis"
fuaPa_DC$ZONE_123_2003[is.na(fuaPa_DC$ZONE_123_2003)] <- "1"
fuaPa_DC$ZONE_123_2004[is.na(fuaPa_DC$ZONE_123_2004)] <- "1"
fuaPa_DC$ZONE_123_2005[is.na(fuaPa_DC$ZONE_123_2005)] <- "1"
fuaPa_DC$ZONE_123_2006[is.na(fuaPa_DC$ZONE_123_2006)] <- "1"
fuaPa_DC$ZONE_123_2007[is.na(fuaPa_DC$ZONE_123_2007)] <- "1"
fuaPa_DC$ZONE_123_2008[is.na(fuaPa_DC$ZONE_123_2008)] <- "1"
fuaPa_DC$ZONE_123_2009[is.na(fuaPa_DC$ZONE_123_2009)] <- "1"
fuaPa_DC$ZONE_123_2010[is.na(fuaPa_DC$ZONE_123_2010)] <- "1"
fuaPa_DC$ZONE_123_2011[is.na(fuaPa_DC$ZONE_123_2011)] <- "1"
fuaPa_DC$ZONE_123_2012[is.na(fuaPa_DC$ZONE_123_2012)] <- "1"
fuaPa_DC$ZONE_123_2013[is.na(fuaPa_DC$ZONE_123_2013)] <- "1"
fuaPa_DC$ZONE_123_2014[is.na(fuaPa_DC$ZONE_123_2014)] <- "1"
fuaPa_DC$ZONE_123_2015[is.na(fuaPa_DC$ZONE_123_2015)] <- "1"
fuaPa_DC$ZONE_123_2016[is.na(fuaPa_DC$ZONE_123_2016)] <- "1"
fuaPa_DC$ZONE_123_2017[is.na(fuaPa_DC$ZONE_123_2017)] <- "1"
fuaPa_DC$ZONE_123_2018[is.na(fuaPa_DC$ZONE_123_2018)] <- "1"
fuaPa_DC$ZONE_123_2019[is.na(fuaPa_DC$ZONE_123_2019)] <- "1"
fuaPa_DC$CODGEO_2019 <- as.character(fuaPa_DC$CODGEO_2019)
fuaPa_DC$CODGEO_2003[is.na(fuaPa_DC$CODGEO_2003)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2003)]
fuaPa_DC$CODGEO_2004[is.na(fuaPa_DC$CODGEO_2004)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2004)]
fuaPa_DC$CODGEO_2005[is.na(fuaPa_DC$CODGEO_2005)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2005)]
fuaPa_DC$CODGEO_2006[is.na(fuaPa_DC$CODGEO_2006)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2006)]
fuaPa_DC$CODGEO_2007[is.na(fuaPa_DC$CODGEO_2007)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2007)]
fuaPa_DC$CODGEO_2008[is.na(fuaPa_DC$CODGEO_2008)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2008)]
fuaPa_DC$CODGEO_2009[is.na(fuaPa_DC$CODGEO_2009)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2009)]
fuaPa_DC$CODGEO_2010[is.na(fuaPa_DC$CODGEO_2010)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2010)]
fuaPa_DC$CODGEO_2011[is.na(fuaPa_DC$CODGEO_2011)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2011)]
fuaPa_DC$CODGEO_2012[is.na(fuaPa_DC$CODGEO_2012)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2012)]
fuaPa_DC$CODGEO_2013[is.na(fuaPa_DC$CODGEO_2013)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2013)]
fuaPa_DC$CODGEO_2014[is.na(fuaPa_DC$CODGEO_2014)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2014)]
fuaPa_DC$CODGEO_2015[is.na(fuaPa_DC$CODGEO_2015)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2015)]
fuaPa_DC$CODGEO_2016[is.na(fuaPa_DC$CODGEO_2016)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2016)]
fuaPa_DC$CODGEO_2017[is.na(fuaPa_DC$CODGEO_2017)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2017)]
fuaPa_DC$CODGEO_2018[is.na(fuaPa_DC$CODGEO_2018)] <- fuaPa_DC$CODGEO_2019[is.na(fuaPa_DC$CODGEO_2018)]


# 3. Chargement des données supplémentaires : population au dernier recensement (2016) et revenu médian 
# Note: il serait également possible de reconstituer ces données par ré-agrégation des carreaux INSEE, mais cette méthode supposerait des inférences qui en limiteraient la précision

## Population 2016 (fournie par l'INSEE selon la géographie au 1er janvier 2019 ; ce qui n'est pas tout à fait le cas : plusieurs communes qui n'ont fusionné qu'en 2019 n'y apparaissent pas. On fait donc la fusion avec le découpage au 31 décembre 2019)

### Pour les communes
Pop <- read_xls("raw-data/INSEE/INSEE_DATA/BTX_TD_POP1A_2016.xls", col_names = F, sheet = "COM")
Pop <- Pop[c(11:34964),c(1,3:22)]
colnames(Pop) <- Pop[c(1),]
Pop <- Pop[c(2:34954),]
Pop2 <- data.frame(sapply(Pop[,c(2:21)], function(x) as.numeric(x)))
Pop <- cbind(Pop, Pop2)
remove(Pop2)
Pop <- Pop[,c(1,22:41)]
Pop$POPULATION <- rowSums(Pop[2:21], na.rm = T)
Pop <- Pop[,c(1,22)]

### Ajout des arrondissements
Pop_Arr <- read_xls("raw-data/INSEE/INSEE_DATA/BTX_TD_POP1A_2016.xls", col_names = F, sheet = "ARM")
Pop_Arr <- Pop_Arr[c(11:56),c(1,3:22)]
colnames(Pop_Arr) <- Pop_Arr[c(1),]
Pop_Arr <- Pop_Arr[c(2:46),]
Pop2_Arr <- data.frame(sapply(Pop_Arr[,c(2:21)], function(x) as.numeric(x)))
Pop_Arr <- cbind(Pop_Arr, Pop2_Arr)
remove(Pop2_Arr)
Pop_Arr <- Pop_Arr[,c(1,22:41)]
Pop_Arr$POPULATION <- rowSums(Pop_Arr[2:21], na.rm = T)
Pop_Arr <- Pop_Arr[,c(1,22)]

### Fusion des tables
Pop <- rbind(Pop, Pop_Arr)
fuaPa_DC <- merge(fuaPa_DC, Pop, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)
remove(Pop_Arr)
remove(Pop)

## Revenus médians 2017 (sur la géographie au 1er janvier 2018)
# Note : il s'agit plus exactement du revenu médian par unité de consommation

### Ouverture et traitement de la table
Rev <- read_xlsx("raw-data/INSEE/INSEE_DATA/FILO2017_DEC_COM.xlsx", col_names = F, sheet = "ENSEMBLE")
Rev <- Rev[c(6:31751),c(1,8)]
colnames(Rev) <- Rev[c(1),]
Rev <- Rev[c(2:31746),]
names(Rev)[2] <- "REV_MEDIAN"
Rev$REV_MEDIAN <- as.numeric(Rev$REV_MEDIAN)

### Jointure
fuaPa_DC <- merge(fuaPa_DC, Rev, by.x = "CODGEO_2018", by.y = "CODGEO", all.x = T) # Les NA restant correspondent aux communes de trop petite taille
remove(Rev)

# 4. Enregistrement de la table brute

fuaPa_DC <- as.data.frame(fuaPa_DC)
fuaPa_DC <- fuaPa_DC[,c(1:58)]

# Du fait d'un dysfonctionnement du package xlsx, on passe par des voies un peu détournées pour enregistrer deux feuilles un même document
Final <- createWorkbook()
addWorksheet(Final, "Brut")
addWorksheet(Final, "Def")
writeData(Final, sheet = "Brut", x = fuaPa_DC)



# 5. Construction de la table définitive (1 seule ligne par commune de 2019 + prise en compte des fusions)

## Base de départ
fuaPa_Def <- as.data.frame(fuaPa_COM)
fuaPa_Def <- fuaPa_Def[,c(1,2)]

## Import de la matrice de passage
modif <- as.data.frame(read_xlsx("../geom/input/table_passage_geo2003_geo2020.xlsx",
                               col_types = "text", sheet = "Table de passage", 
                               skip = 5)) 

## Réalisation et jointure des bases par années successives pour ABC

### 2003
DB_03 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2003",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_03, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_03)

### 2004
DB_04 <- comix(x = fuaPa_DC, xid = "CODGEO_2004", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2004",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_04, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_04)

### 2005
DB_05 <- comix(x = fuaPa_DC, xid = "CODGEO_2005", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2005",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_05, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_05)

### 2006
DB_06 <- comix(x = fuaPa_DC, xid = "CODGEO_2006", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2006",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_06, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_06)

### 2007
DB_07 <- comix(x = fuaPa_DC, xid = "CODGEO_2007", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2007",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_07, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_07)

### 2008
DB_08 <- comix(x = fuaPa_DC, xid = "CODGEO_2008", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2008",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_08, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_08)

### 2009
DB_09 <- comix(x = fuaPa_DC, xid = "CODGEO_2009", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2009",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_09, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_09)

### 2010
DB_10 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2010",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_10, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_10)

### 2011
DB_11 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2011",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_11, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_11)

### 2012
DB_12 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2012",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_12, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_12)

### 2013
DB_13 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2013",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_13, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_13)

### 2014
DB_14 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2014",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_14, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_14)

### 2015
DB_15 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2015",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_15, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_15)

### 2016
DB_16 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2016",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_16, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_16)

### 2017
DB_17 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2017",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_17, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_17)

### 2018
DB_18 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2018",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_18, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_18)

### 2019
fuaPa_Def <- merge(fuaPa_Def, subset(fuaPa_DC[,c("CODGEO_2019", "ZONE_ABC_2019")], !duplicated(fuaPa_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)

### Recodage
fuaPa_Def$ZONE_ABC_2003[fuaPa_Def$ZONE_ABC_2003 == "C-B"] <- "B-C"
fuaPa_Def$ZONE_ABC_2004[fuaPa_Def$ZONE_ABC_2004 == "C-B"] <- "B-C"
fuaPa_Def$ZONE_ABC_2005[fuaPa_Def$ZONE_ABC_2005 == "C-B"] <- "B-C"
fuaPa_Def$ZONE_ABC_2006[fuaPa_Def$ZONE_ABC_2006 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2007[fuaPa_Def$ZONE_ABC_2007 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2008[fuaPa_Def$ZONE_ABC_2008 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2009[fuaPa_Def$ZONE_ABC_2009 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2010[fuaPa_Def$ZONE_ABC_2010 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2011[fuaPa_Def$ZONE_ABC_2011 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2012[fuaPa_Def$ZONE_ABC_2012 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2013[fuaPa_Def$ZONE_ABC_2013 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2014[fuaPa_Def$ZONE_ABC_2014 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2014[fuaPa_Def$ZONE_ABC_2014 == "B2-A"] <- "A-B2"
fuaPa_Def$ZONE_ABC_2015[fuaPa_Def$ZONE_ABC_2015 == "C-B2"] <- "B2-C"
fuaPa_Def$ZONE_ABC_2015[fuaPa_Def$ZONE_ABC_2015 == "B2-A"] <- "A-B2"



## Réalisation et jointure des bases par années successives pour 123

### 2003
DB_03 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2003",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_03, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_03)

### 2004
DB_04 <- comix(x = fuaPa_DC, xid = "CODGEO_2004", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2004",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_04, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_04)

### 2005
DB_05 <- comix(x = fuaPa_DC, xid = "CODGEO_2005", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2005",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_05, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_05)

### 2006
DB_06 <- comix(x = fuaPa_DC, xid = "CODGEO_2006", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2006",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_06, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_06)

### 2007
DB_07 <- comix(x = fuaPa_DC, xid = "CODGEO_2007", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2007",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_07, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_07)

### 2008
DB_08 <- comix(x = fuaPa_DC, xid = "CODGEO_2008", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2008",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_08, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_08)

### 2009
DB_09 <- comix(x = fuaPa_DC, xid = "CODGEO_2009", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2009",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_09, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_09)

### 2010
DB_10 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2010",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_10, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_10)

### 2011
DB_11 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2011",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_11, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_11)

### 2012
DB_12 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2012",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_12, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_12)

### 2013
DB_13 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2013",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_13, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_13)

### 2014
DB_14 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2014",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_14, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_14)

### 2015
DB_15 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2015",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_15, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_15)

### 2016
DB_16 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2016",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_16, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_16)

### 2017
DB_17 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2017",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_17, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_17)

### 2018
DB_18 <- comix(x = fuaPa_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2018",
                var.type = "text")
fuaPa_Def <- merge(fuaPa_Def, DB_18, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_18)

### 2019
fuaPa_Def <- merge(fuaPa_Def, subset(fuaPa_DC[,c("CODGEO_2019", "ZONE_123_2019")], !duplicated(fuaPa_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)

### Recodage

fuaPa_Def$ZONE_123_2005[fuaPa_Def$ZONE_123_2005 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2006[fuaPa_Def$ZONE_123_2006 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2007[fuaPa_Def$ZONE_123_2007 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2008[fuaPa_Def$ZONE_123_2008 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2009[fuaPa_Def$ZONE_123_2009 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2010[fuaPa_Def$ZONE_123_2010 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2011[fuaPa_Def$ZONE_123_2011 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2012[fuaPa_Def$ZONE_123_2012 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2013[fuaPa_Def$ZONE_123_2013 == "2-1"] <- "1-2"
fuaPa_Def$ZONE_123_2014[fuaPa_Def$ZONE_123_2014 == "2-1"] <- "1-2"


## Jointure pour l'ACV et les agréments

fuaPa_Def <- merge(fuaPa_Def, subset(fuaPa_DC[,c("CODGEO_2019", "ACV", "ORT", "DATE_AGREM_M", "DATE_AGREM_P", "POPULATION")], !duplicated(fuaPa_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)


## Export de la table
writeData(Final, sheet = "Def", x = fuaPa_Def)

# Export the file
saveWorkbook(Final, "Output/Paris/Dispositifs_Paris.xlsx")

Rappel : on utilise ici la fonction ‘comix’ élaborée par Ronan Ysebaert,que l’on indique ici :

comix <- function(x, xid, app, app.init, app.target, var, var.type, w = NULL, na.rm = FALSE) {
  
  # Supprimer les géométries s'il y en a 
  if (methods::is(x, "sf")){
    x <- st_set_geometry(x, NULL)
    }
  
  # Import table d'appartenance des fusions territoriales
  app <- app
  
  # Jointure table d'entrée - table des fusions territoriales
  x <- merge(x, app[,c(app.init, app.target)], by.x = xid, by.y = app.init, all.x = TRUE)
  
  # Unités non concernées par modifications
  tmp <- aggregate(x[,app.target], by = list(app.target = x[,app.target]), FUN = length)
  tmp <- tmp[tmp$x <= 1,] 
  selecUnit <- tmp$app.target
  intact <- x[x[,app.target] %in% selecUnit, ]
  intact <- intact[, c(app.target, var)] 

  # Unités concernées par une modification
  modif <- x[!x[,app.target]%in% selecUnit, ]
  modif <- modif[, c(app.target, var, w)]
  
  # Gestion des types de variables déclarées 
  tmp <- data.frame(var, var.type, row.names = var)
  txt <- row.names(tmp[tmp$var.type == "text",])
  stock <-  row.names(tmp[tmp$var.type == "stock",])
  ratio <- row.names(tmp[tmp$var.type == "ratio",])
  
  # Si variables de type caractère > concaténation des modalités
  if(length(txt > 0)){
    modif.t <- modif[,c(app.target, txt)]
    
    modif.t <- aggregate(modif.t[, -1],
                         by = list(app.target = modif.t[,app.target]),
                         FUN = function(x) {paste0(unique(x), collapse = "-")})
    names(modif.t) <- c(app.target, txt)
    }

  
  # Si variables de type stock > somme des valeurs
  if(length(stock > 0)){
    
    modif.s <- modif[,c(app.target, stock)]
    modif.s <- aggregate(modif.s[, -1],
                         by = list(app.target = modif.s[,app.target]),
                         FUN = sum, na.rm = na.rm)
    names(modif.s) <- c(app.target, stock)
    }
  

  # Si variables de type ratio > moyenne simple ou pondérée 
  ## Si pas de variable de pondération
  if(length(ratio > 0)){  
    if(is.null(w)){
      modif.r <- modif[,c(app.target, ratio)]
      modif.r <- aggregate(modif.r[, -1],
                           by = list(CODGEO_2020 = modif.r$CODGEO_2020),
                           FUN = mean, na.rm = na.rm)
      }
    
    ## Si pondération... 
    # Commentaire : Avec dplyr(!), pas très sexy mais fonctionne. A essayé 36 méthodes
    # non concluantes (cf sous la fonction)
    else{
      modif.r <- modif[,c(app.target, ratio, w)]
      names(modif.r)[which(names(modif.r) == w)] <- "weight"
      names(modif.r)[which(names(modif.r) == app.target)]  <- "app.target"
      names(modif.r)[which(names(modif.r) %in% ratio)]  <- paste0("ratio",names(modif.r[ratio]))
      
      modif.r <- modif.r %>%                   
        group_by_at(vars(app.target)) %>% 
        summarise_at(vars(starts_with('ratio')), list(~weighted.mean(., weight, na.rm = na.rm)))  
        modif.r <- as.data.frame(modif.r)
        }
    
    names(modif.r) <- c(app.target, ratio)
  }
  
  # Union des 3 types de variables - 8 cas de figure
  # Commentaire : pas trouvé la solution du type if(exists("x")), cbind(x)
  if(exists("modif.t") == FALSE & exists("modif.s") == FALSE & exists("modif.r") == FALSE ){
    stop("Define at least one var combined to one var.type", call. = FALSE)
  }
  
  if(exists("modif.t") == TRUE & exists("modif.s") == TRUE & exists("modif.r") == TRUE ){
    modif <- cbind(modif.t, modif.s, modif.r) 
  }
  
  if(exists("modif.t") == FALSE & exists("modif.s") == TRUE & exists("modif.r") == TRUE ){
    modif <- cbind(modif.s, modif.r) 
  }
  
  if(exists("modif.t") == TRUE & exists("modif.s") == FALSE & exists("modif.r") == TRUE){
    modif <- cbind(modif.t, modif.r) 
  }
  
  if(exists("modif.t") == TRUE & exists("modif.s") == TRUE & exists("modif.r") == FALSE){
    modif <- cbind(modif.t, modif.s) 
  }
  
  if(exists("modif.t") == TRUE & exists("modif.s") == FALSE & exists("modif.r") == FALSE){
    modif <- modif.t
  }
  
  if(exists("modif.t") == FALSE & exists("modif.s") == TRUE & exists("modif.r") == FALSE){
    modif <- modif.s
  }
  
  if(exists("modif.t") == FALSE & exists("modif.s") == FALSE & exists("modif.r") == TRUE){
    modif <- modif.r
  }
  


  # Liaison avec les unités territoriales inchangées
  x <- rbind(intact, modif[,names(intact)])
  
  return(x)
  }

4.2.1.1 Situation en 2019

A titre de démonstration, on réalise ici cinq cartes enregistrées au format .png dans le dossier “fig/Paris” :

1. Le zonage A/B/C sur la FUA de Paris (“ABC.png”)

2. Le zonage 1/2/3 sur la FUA (“123.png”)

3. L’éligibilité aux dispositifs nationaux communaux (Pinel, PTZ, APL, Denormandie) (“DNC.png”)

4. L’éligibilité aux dispositifs locaux communaux (CADAL, PLP et PPR de Paris, chartes promoteurs) (“DLC.pgn”)

5. L’éligibilité aux dispositifs infracommunaux (TVA réduite, quotas de logements aidés) (“DI.png”)

Le script suivant est adapté à la situation propre à 2019. Il peut néanmoins servir de base à une réécriture pour d’autres années.

# 1. Préparation

# Ouverture des bases

## Ouverture des fonds de cartes des communes de la FUA de Paris
fuaPa_COM <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "comFu")
fuaPa_COM <- subset(fuaPa_COM, fuaPa_COM$study == "FUA")
fuaPa_COM <- fuaPa_COM[,c(1,2, 13)]

## Ouverture des couches départements et métropoles
fuaPa_DEP <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "depFu")
fuaPa_MET <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "metroFu")
fuaPa_STUDY <- st_read("raw-data/geom/output/geom_Paris_FUA.gpkg", layer = "studyFu")

# Ouverture de la table sur les dispositifs nationaux à l'échelon communal
fuaPa_DC <- read_excel("Output/Paris/Dispositifs_Paris.xlsx", sheet = "Def")
fuaPa_DC <- fuaPa_DC[,c("INSEE_COM", "ZONE_ABC_2019", "ZONE_123_2019", "ACV", "ORT")]

## Ouverture de la table des communes ayant signé une charte promoteur
CP <- read_excel("raw-data/INOVEFA/Chartes_promoteurs.xlsx")
CP$Charte_prom <- "Oui"
CP <- CP[,c(1,4)]

## Ouverture de la couche sur les QPV
QPV_Pa <- st_read("Output/Paris/Paris_TVA.gpkg", layer = "QPV_Fu", quiet = T)
PNRU_Pa <- st_read("Output/Paris/Paris_TVA.gpkg", layer = "PNRU_Fu", quiet = T)


# Jointure des tables sur les dispositifs communaux nationaux
fuaPa_COM <- merge(fuaPa_COM, fuaPa_DC, by = "INSEE_COM", all.x = T)
fuaPa_COM <- subset(fuaPa_COM, !duplicated(fuaPa_COM$INSEE_COM))

## Création de la variable éligibilité aux différents dispositifs nationaux
fuaPa_COM$ELIG_Pinel <- "Oui"
fuaPa_COM$ELIG_Pinel[fuaPa_COM$ZONE_ABC_2019 == "C" | fuaPa_COM$ZONE_ABC_2019 == "B2"] <- "Non"

fuaPa_COM$ELIG_PTZ_Ancien <- "Non"
fuaPa_COM$ELIG_PTZ_Ancien[fuaPa_COM$ZONE_ABC_2019 == "C" | fuaPa_COM$ZONE_ABC_2019 == "B2"] <- "Oui"

fuaPa_COM$ELIG_APL <- "Non"
fuaPa_COM$ELIG_APL[fuaPa_COM$ZONE_123_2019 == "3"] <- "Oui"


## Construction de la variable "ELIG_N", qui synthétise l'éligibilité aux dispositifs nationaux

fuaPa_COM$ELIG_N[fuaPa_COM$ELIG_Pinel == "Oui" & fuaPa_COM$ELIG_APL == "Oui"] <- "Pinel + APLA"
fuaPa_COM$ELIG_N[fuaPa_COM$ELIG_Pinel == "Oui" & fuaPa_COM$ELIG_APL == "Non"] <- "Pinel seul"
fuaPa_COM$ELIG_N[fuaPa_COM$ELIG_Pinel == "Non" & fuaPa_COM$ELIG_APL == "Oui"] <- "PTZ ancien + APLA"
fuaPa_COM$ELIG_N[fuaPa_COM$ELIG_Pinel == "Non" & fuaPa_COM$ELIG_APL == "Non"] <- "PTZ ancien seul"


## Fusion des arrondissements parisiens

Paris <- subset(fuaPa_COM, substr(fuaPa_COM$NOM_COM, 0,5) == "Paris")
Paris <- aggregate(Paris,  by = list(Paris$ZONE_ABC_2019), FUN = head, 1)
Paris$NOM_COM <- "Paris"
Paris$INSEE_COM <- "75056"
Paris <- Paris[,c(2:11)]

fuaPa_COM <- subset(fuaPa_COM, substr(fuaPa_COM$NOM_COM, 0,5) != "Paris")
fuaPa_COM <- rbind(fuaPa_COM, Paris)


## Fusion de la table sur les chartes promoteurs et variable portant sur la signature ces chartes

fuaPa_COM <- merge(fuaPa_COM, CP, by.x = "INSEE_COM", by.y = "CODGEO", all.x = T)
fuaPa_COM$Charte_prom[is.na(fuaPa_COM$Charte_prom)] <- "Non"


# Construction de la variable "ELIG_L" 

fuaPa_COM$DEP <- substr(fuaPa_COM$INSEE_COM,0,2)
fuaPa_COM$ELIG_L[fuaPa_COM$NOM_COM == "Paris"] <- "Prêt logement Paris\n+ Prêt parcours résidentiel\n+ Charte promoteurs"
fuaPa_COM$ELIG_L[fuaPa_COM$DEP == "77"] <- "Prêt CADAL"
fuaPa_COM$ELIG_L[fuaPa_COM$DEP == "77" & fuaPa_COM$Charte_prom == "Oui"] <- "Prêt CADAL\n+Charte promoteur"
fuaPa_COM$ELIG_L[fuaPa_COM$DEP != "77" & fuaPa_COM$Charte_prom == "Oui" & fuaPa_COM$NOM_COM != "Paris"] <- "Charte promoteur"



# 2. Cartographie

sizes <- getFigDim(x = fuaPa_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : zonage A/B/C

png(file = "fig/Paris/2019/ABC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_COM, var = "ZONE_ABC_2019",
           col = c("#993404", "#d95f0e", "#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A bis", "A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage A/B/C 2019 - Paris", 
            sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 50, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 2 : zonage 1/2/3

png(file = "fig/Paris/2019/123.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_COM, var = "ZONE_123_2019",
           col = c("#4eb3d3", "#a8ddb5", "#e0f3db"),
           border = NA,
           legend.pos =  "topright",
           legend.values.order = c("1", "2", "3"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage 1/2/3 2019 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 3 : éligibilités croisées aux dispositifs Pinel, PTZ et APL

png(file = "fig/Paris/2019/DNC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_COM, var = "ELIG_N",
           border = NA,
           col = carto.pal("pastel.pal", 8) [c(4,6,5,7)],
           legend.pos = "topright",
           legend.values.order = c("PTZ ancien seul","PTZ ancien + APLA","Pinel seul","Pinel + APLA"), legend.values.cex = 0.6, 
           legend.title.txt = NA, add = TRUE)

hatchedLayer(fuaPa_COM[fuaPa_COM$ACV == "Oui" | fuaPa_COM$ORT == "Oui",], 
             pattern= "left2right", 
             density = 10, 
             col = "black",
             add = T)

legendHatched(
  "right", 
  title.txt = NA,
  categ = "Denormandie (ACV et ORT)",
  patterns = "left2right")

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray37", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité des communes aux dispositifs nationaux d'aide à l'acquisition immobilière 2019 - Paris",
       sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()



# Carte 4 : éligibilité aux dispositifs locaux communaux


png(file = "fig/Paris/2019/DLC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)

typoLayer(x = fuaPa_COM, var = "ELIG_L",
           border = NA,
           col = carto.pal("pastel.pal", 8)[c(2,3,4,6)], 
           legend.pos = "topright",
           legend.values.order = c("Prêt logement Paris\n+ Prêt parcours résidentiel\n+ Charte promoteurs", "Charte promoteur", "Prêt CADAL", "Prêt CADAL\n+Charte promoteur"), legend.nodata = "Pas de dispositif\nlocal identifié",
           legend.values.cex = 0.6, 
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité des communes aux dispositifs locaux d'aide à l'acquisition immobilière 2019 - Paris",
       sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 5 : dispositifs infra-communaux

png(file = "fig/Paris/2019/DI.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)

plot(st_geometry(fuaPa_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Pa[2019 %in% PNRU_Pa$date_sign:PNRU_Pa$date_fin+2], 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Pa, 300)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Pa[QPV_Pa$NPNRU == "OUI",], 500)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("Secteurs du PNRU", "Quartiers prioritaires\ndes politiques de la ville"),
            col = c("#74c476", "#74a9cf"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2019 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.1.2 Evolution 2003-2019

4.2.1.2.1 Préparation de la table

La cartographie de l’évolution des zonages se fait à partir du découpage de 2019 et de la table de passage fournie par l’INSEE, ce qui pose le problème du traitement des fusions (aucune scission n’est recensée sur les trois FUA à l’étude entre 2003 et 2020). Deux options sont possibles :

• L’utilisation de la fonction ‘comix’ élaborée par Ronan Ysebaert permet d’indiquer les communes de la géographie actuelle qui résulte d’une fusion entre des communes de zones différentes.

• Une autre façon, plus économe en légende, mais moins précise, consiste à conserver le classement correspondant à la commune qui a imposé son code INSEE à la commune recensée en 2019. Dans le cas de la FUA de Paris, 24 communes ont connu des fusions entre 2003 et 2019.

On utilise ici la seconde méthode, moins précise mais plus économe en légende et plus lisible (en 2014, par exemple, 1 commune est en “A-A bis”, 1 commune en “A-B2”, 2 communes en “B1-B2”, 3 communes en “B2-C”). La première façon de procéder est indiquée dans le script derrière des # afin de ne pas l’exécuter automatiquement. Ce choix nécessitera néanmoins d’ajuster les scripts de cartographie afin de prendre en compte les nouvelles modalités ainsi générées.

On construit une base à partir de laquelle sont ensuite réalisées les cartes :

# Ouverture des fonds de cartes des communes de la FUA de Paris
fuaPa_COM <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "comFu")
fuaPa_COM <- subset(fuaPa_COM, fuaPa_COM$study == "FUA")
fuaPa_COM <- fuaPa_COM[,c(1,2, 13)]

# Ouverture de la base sur les dispositifs
fuaPa_DC <- read_excel("OutPut/Paris/Dispositifs_Paris.xlsx", sheet = "Brut")

# Jointure
fuaPa_DC <- merge(fuaPa_COM, fuaPa_DC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)

# Gestion des fusions
fuaPa_DC <- subset(fuaPa_DC, fuaPa_DC$INSEE_COM == fuaPa_DC$CODGEO_2003)

# Réorganisation de la base
fuaPa_DC <- fuaPa_DC[,c(1,2,20:57)] # On n'a pas besoin de la population ici
colnames(fuaPa_DC)[1] <- "CODGEO"
colnames(fuaPa_DC)[2] <- "LIBGEO"

###################################################################################
# Gestion alternative des fusions :
# fuaPa_COM <- st_read("../geom/output/geom_Paris_FUA.gpkg", layer = "comFu")
# fuaPa_COM <- subset(fuaPa_COM, fuaPa_COM$study == "FUA")
# fuaPa_COM <- fuaPa_COM[,c(1,2, 13)]
# fuaPa_DC <- read_excel("OutPut/Paris/Dispositifs_Paris.xlsx", sheet = "Def")
# fuaPa_DC <- merge(fuaPa_COM, fuaPa_DC, by = "INSEE_COM", all.x = T)
# fuaPa_DC <- fuaPa_DC[,c(1,2,4:39)] # On n'a pas besoin de la population ici
# colnames(fuaPa_DC)[1] <- "CODGEO"
# colnames(fuaPa_DC)[2] <- "LIBGEO"
## La suite ne change pas.
###################################################################################

# Fusion des arrondissements Parisiens
Paris <- subset(fuaPa_DC, substr(fuaPa_DC$LIBGEO, 0,5) == "Paris")
Paris$Fus <- 1
Paris <- aggregate(Paris,  by = list(Paris$Fus), FUN = head, 1)
Paris$LIBGEO <- "Paris"
Paris$CODGEO <- "75056"
Paris <- Paris[,c(2:41, 43)]

fuaPa_DC <- subset(fuaPa_DC, substr(fuaPa_DC$LIBGEO, 0,5) != "Paris")
fuaPa_DC <- rbind(fuaPa_DC, Paris)
remove(Paris)


# Définition de l'éligibilité selon la zone année par année

## La période 2003-2008 ne présente pas d'intérêt, toutes les communes étant éligibles

## Pour la période 2009-2012
fuaPa_DC$ELIG_2012 <- "Eligible"
fuaPa_DC$ELIG_2012[fuaPa_DC$ZONE_ABC_2012 == "C"] <- "Non éligible"

## Pour 2013
fuaPa_DC$ELIG_2013 <- "Eligible"
fuaPa_DC$ELIG_2013[fuaPa_DC$ZONE_ABC_2013 == "C" | fuaPa_DC$ZONE_ABC_2013 == "B2"] <- "Non éligible"

## Pour la période 2014-2017
fuaPa_DC$ELIG_2014 <- "Eligible"
fuaPa_DC$ELIG_2014[fuaPa_DC$ZONE_ABC_2014 == "C" | fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Non éligible"

## Pour la période 2018-2019
fuaPa_DC$ELIG_2018 <- "Eligible"
fuaPa_DC$ELIG_2018[fuaPa_DC$ZONE_ABC_2018 == "C" | fuaPa_DC$ZONE_ABC_2018 == "B2"] <- "Non éligible"

## Modification de la variable éligibilité
fuaPa_DC$ELIG_2012[fuaPa_DC$DATE_AGREM_M == "2012"] <- "Eligible par\nagrément\n(2012)"
fuaPa_DC$ELIG_2013[fuaPa_DC$DATE_AGREM_P == "2013"] <- "Eligible par\nagrément"
fuaPa_DC$ELIG_2013[fuaPa_DC$DATE_AGREM_P == "2014" & fuaPa_DC$ZONE_ABC_2013 == "A"] <- "Eligible par\nagrément"
fuaPa_DC$ELIG_2014[fuaPa_DC$DATE_AGREM_P == "2014" & fuaPa_DC$ZONE_ABC_2013 != "A"] <- "Eligible par\nagrément\n(2014-2017)"
fuaPa_DC$ELIG_2014[fuaPa_DC$DATE_AGREM_P == "2013" & fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Eligible par\nagrément\n(2014-2017)"
fuaPa_DC$ELIG_2014[fuaPa_DC$DATE_AGREM_P == "2015"] <- "Eligible par\nagrément\n(2014-2017)"

17 agréments ont donc été accordés à des communes de la FUA de Paris entre 2013 et 2017, ils se répartissent ainsi :

Année de l’agrément	2013	2014	2015
A	0	1	0
B2	15	1	2
Total	15	2	2

Le cas de la commune agréée en 2014 et classée la même année en zone A s’explique par un décalage des deux chronologies. La commune en question (La Chapelle-en-Serval - 60142) a été d’abord agréée, puis reclassée, à l’occasion de l’arrêté du 1er août 2014 en zone A. Pour des raisons de lisibilité et par souci de conserver cette information, on l’a faite figurer sur la carte de 2013. Sur les territoires étudiés, l’ensemble des agréments ont été accordés à des communes qui se situaient alors en B2.

4.2.1.2.2 Cartographie

Pour cartographier l’évolution des zonages et de l’éligibilité aux dispositifs nationaux à l’échelon communal, on se limite à une cartographie par période. Pour cela, on identifie préalablement les années de rupture et de reclassement.

• Pour le zonage ABC, l’étude des effectifs par zone (en 2.2.4.1 de ce document) suggère le découpage suivant : 2003-2005, 2006-2008, 2009, 2010-2013, 2014-2018, 2019. Cependant, dans le cas de la FUA de Paris, les arrêtés de 2009 et 2019 ont introduit particulièrement peu de changements. On se limite donc à cartographier les périodes 2003-2005 ; 2006-2009 ; 2010-2013 ; 2014-.

Classement	2006	2009	2010	2014	2019
Nombre de reclassement par rapport au classement précédent	1223	4	68	341	1

• L’éligibilité aux aides à l’investissement locatif a été retirée aux communes de la zone C à partir de 2009 (sauf dérogation sur la période 2010-2017) puis de la zone B2 à partir de 2013 (sauf dérogation sur la période 2013-2017). L’éligibilité à ces aides nécessite un découpage particulièrement commençant en 2009 : 2009-2012, 2013 (avec agréments), 2014- (avec agréments sur la période 2014-2017). L’éligibilité au PTZ dans l’ancien (instauré en 2005 pour toutes les communes, supprimé en 2011 et réinstauré sous une forme plus restrictive l’année d’après) a simplement été retirée aux communes des zones A, Abis et B1 depuis 2018, ce qui ne justifie pas de réaliser une carte indépendante.

• Le classement 1/2/3 des communes de la FUA de Paris n’a connu aucun changement entre 2003 et 2019. La seule évolution notable est relative à l’éligibilité à l’APL accession, qui n’est plus disponible qu’en zone 3 depuis 2018 - ce qui ne justifie pas une carte à part entière.

• Pour la TVA réduite. Les QPV instaurés en 2015 sont connus. La région Ile-de-France propose une cartographie des zones ANRU (2004-2014) qui sert de support à la détermination des zones d’éligibilité à la TVA réduite sur la période 2006-2014. Pour le reste des territoires concernés, les périmètres des PNRU ont été obtenu par digitalisationà partir des données fournées par l’ANCT via le site sig.ville.gouv.fr (cf. partie 4.1.1.2)

4.2.1.2.2.1 Historique - ABC

L’historique du zonage ABC est disponible ici sous la forme d’un document “ABC.pdf”, qui permet de disposer d’une image en vecteur relativement peu lourde.

# On repart des bases élaborées dans le chunk précédent


# 1. Préparations

# Ouverture des couches départements et métropoles
fuaPa_DEP <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "depFu")
fuaPa_MET <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "metroFu")
fuaPa_STUDY <- st_read("raw-data/geom/geom_Paris_FUA.gpkg", layer = "studyFu")



# 2. Cartographie


pdf("fig/Paris/Historique/ABC.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaPa_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : A/B/C 2003-2005

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ZONE_ABC_2003",
           col = c("#d95f0e","#feb24c", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A", "B", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage A/B/C 2003-2005 - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

# Carte 2 : A/B/C 2006-2009

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ZONE_ABC_2006",
           col = c("#d95f0e","#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage A/B/C 2006-2009 - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : A/B/C 2010-2013

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ZONE_ABC_2010",
           col = c("#993404","#d95f0e","#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A bis", "A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage A/B/C 2010-2013 - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 4 : A/B/C depuis 2014

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ZONE_ABC_2014",
           col = c("#993404","#d95f0e","#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A bis", "A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Zonage A/B/C depuis 2014 - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

L’historique de l’éligibilité aux aides fiscales à l’investissement locatif (Scellier, Duflot, Pinel) est également disponible ici sous le nom “AFIL.pdf”.

pdf("fig/Paris/Historique/AFIL.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaPa_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : 2009-2012

table(fuaPa_DC$ELIG_2012)

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ELIG_2012",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément\n(2012)"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité au dispositif Scellier (2009-2012) - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2013

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ELIG_2013",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité au dispositif Duflot (2013) - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : depuis 2014


plot(st_geometry(fuaPa_DEP), col = "white", border = NA)
plot(st_geometry(fuaPa_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaPa_DC, var = "ELIG_2014",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément\n(2014-2017)"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité au dispositif Duflot (2014) et Pinel (depuis 2015) - Paris (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.1.2.2.2 Evolution des périmètres de TVA réduite à 5,5%

Les périmètres de TVA réduite à 5,5% pour la construction de logements en accession, instaurés en 2006, ont été modifiés en 2014, en 2015 et en 2017 : on réalise donc un panneau de quatre cartes correspondant aux années 2010 (milieu de la première période), 2014, 2016 et 2019. Cependant, dans la mesure où l’éligibilité à la TVA réduite des secteurs du PNRU dépend de la date de signature et de fin du contrat ANRU, il faudrait en toute rigueur réaliser une carte par année - ce que permet de faire le script shiny en fin de document.

pdf("fig/Paris/Historique/TVA.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaPa_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : 2010

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)

plot(st_geometry(fuaPa_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Pa[2010 %in% PNRU_Pa$date_sign:PNRU_Pa$date_fin+2], 500)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 500m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2010 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2014

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)

plot(st_geometry(fuaPa_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Pa[2014 %in% PNRU_Pa$date_sign:PNRU_Pa$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2014 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : 2016

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)

plot(st_geometry(fuaPa_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Pa[2016 %in% PNRU_Pa$date_sign:PNRU_Pa$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Pa, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m"),
            col = c("red1", "#74c476"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2016 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

# Carte 4 : 2019

plot(st_geometry(fuaPa_DEP), col = "white", border = NA)

plot(st_geometry(fuaPa_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaPa_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Pa[2016 %in% PNRU_Pa$date_sign:PNRU_Pa$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Pa, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Pa[QPV_Pa$NPNRU == "OUI",], 500)), col = "#2b8cbe", border = NA, add = TRUE)

plot(st_geometry(fuaPa_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaPa_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m", "NPNRU + 500m"),
            col = c("red1", "#74c476", "#2b8cbe"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2019 - Paris",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.2 Lyon

On crée une base synthétique des données à l’échelon communal sur Lyon. Cette base renseigne, pour chaque année, le code INSEE de la commune, son classement dans les zonages A/B/C et 1/2/3. S’y ajoute son appartenance ou non au programme de l’Action coeur de ville ou sa participation à une opération de revitalisation de territoire, la date de signature de l’agrément ministériel et / ou préfectoral le cas échéant.

Cette table (fuaLy_DC pour “dispositifs communaux”) est enregistrée à “Output/Lyon/Dispositifs_Lyon.xlsx”.

# 1. Chargement des tables

## Ouverture des fonds de cartes des communes de la FUA de Lyon
fuaLy_COM <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "comFu")
fuaLy_COM <- subset(fuaLy_COM, fuaLy_COM$study == "FUA")
fuaLy_COM <- fuaLy_COM[,c(1,2, 13)]

## Ouverture de la base ABC (France)
ABC <- read_excel("Output/France/ABC_detail.xlsx")

## Ouverture de la base 123 (France)
DB_123 <- read_excel("Output/France/123_detail.xlsx")

## Ouverture de la base Action coeur de ville
ACV <- read_delim("raw-data/MCT/ACV/Action_coeur_ville.csv", ";", escape_double = FALSE, trim_ws = TRUE)
ACV$ACV <- "Oui"
ACV <- ACV[,c(1,4)]

## Ouverture de la base sur les opérations de revitalisation des territoires (ORT)
ORT <- read_excel("raw-data/MCT/ORT/ORT.xlsx")
ORT$ORT <- "Oui"
ORT <- ORT[,c(4,5)]

## Ouverture de la base sur les agréments ministériels (Scellier)
Agrements_Scellier <- read_excel("raw-data/LEGIFRANCE/Agrements_Scellier.xlsx")
Agrements_Scellier <- Agrements_Scellier[,c(1,5)]
colnames(Agrements_Scellier)[2] <- "DATE_AGREM_M"

## Ouverture de la base sur les agréments préfectoraux
Agrements <- read_excel("raw-data/MCT/ZONAGE_ABC/Agrements.xls")
Agrements <- Agrements[,c(4,6)]
colnames(Agrements) <- c("CODGEO", "DATE_AGREM_P")
Agrements$DATE_AGREM_P <- substr(Agrements$DATE_AGREM_P, 1, 4)
Agrements$DATE_AGREM_P[is.na(Agrements$DATE_AGREM_P)] <- "2015"


# 2. Fusion des tables

fuaLy_DC <- merge(fuaLy_COM, ABC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- merge(fuaLy_COM, DB_123, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- Interm[,c(1,36:52)]
fuaLy_DC <- (cbind(fuaLy_DC, Interm))
remove(Interm)
fuaLy_DC <- fuaLy_DC[,c(1,2, 4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36:52,54:72)]
names(fuaLy_DC)[1] <- "CODGEO_2019"
names(fuaLy_DC)[2] <- "LIBGEO_2019"
fuaLy_DC <- merge(fuaLy_DC, ACV, by.x = "CODGEO_2019", by.y = "INSEE_COM", all.x = T)
fuaLy_DC$ACV[is.na(fuaLy_DC$ACV)] <- "Non"
fuaLy_DC <- merge(fuaLy_DC, ORT, by.x = "CODGEO_2019", by.y = "Code commune", all.x = T)
fuaLy_DC$ORT[is.na(fuaLy_DC$ORT)] <- "Non"
fuaLy_DC <- merge(fuaLy_DC, Agrements, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)
fuaLy_DC <- merge(fuaLy_DC, Agrements_Scellier, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)


# 2b Entrée manuelle des informations sur les arrondissements
fuaLy_DC$ZONE_ABC_2003[is.na(fuaLy_DC$ZONE_ABC_2003)] <- "B"
fuaLy_DC$ZONE_ABC_2004[is.na(fuaLy_DC$ZONE_ABC_2004)] <- "B"
fuaLy_DC$ZONE_ABC_2005[is.na(fuaLy_DC$ZONE_ABC_2005)] <- "B"
fuaLy_DC$ZONE_ABC_2006[is.na(fuaLy_DC$ZONE_ABC_2006)] <- "B1"
fuaLy_DC$ZONE_ABC_2007[is.na(fuaLy_DC$ZONE_ABC_2007)] <- "B1"
fuaLy_DC$ZONE_ABC_2008[is.na(fuaLy_DC$ZONE_ABC_2008)] <- "B1"
fuaLy_DC$ZONE_ABC_2009[is.na(fuaLy_DC$ZONE_ABC_2009)] <- "B1"
fuaLy_DC$ZONE_ABC_2010[is.na(fuaLy_DC$ZONE_ABC_2010)] <- "B1"
fuaLy_DC$ZONE_ABC_2011[is.na(fuaLy_DC$ZONE_ABC_2011)] <- "B1"
fuaLy_DC$ZONE_ABC_2012[is.na(fuaLy_DC$ZONE_ABC_2012)] <- "B1"
fuaLy_DC$ZONE_ABC_2013[is.na(fuaLy_DC$ZONE_ABC_2013)] <- "B1"
fuaLy_DC$ZONE_ABC_2014[is.na(fuaLy_DC$ZONE_ABC_2014)] <- "A"
fuaLy_DC$ZONE_ABC_2015[is.na(fuaLy_DC$ZONE_ABC_2015)] <- "A"
fuaLy_DC$ZONE_ABC_2016[is.na(fuaLy_DC$ZONE_ABC_2016)] <- "A"
fuaLy_DC$ZONE_ABC_2017[is.na(fuaLy_DC$ZONE_ABC_2017)] <- "A"
fuaLy_DC$ZONE_ABC_2018[is.na(fuaLy_DC$ZONE_ABC_2018)] <- "A"
fuaLy_DC$ZONE_ABC_2019[is.na(fuaLy_DC$ZONE_ABC_2019)] <- "A"
fuaLy_DC$ZONE_123_2003[is.na(fuaLy_DC$ZONE_123_2003)] <- "2"
fuaLy_DC$ZONE_123_2004[is.na(fuaLy_DC$ZONE_123_2004)] <- "2"
fuaLy_DC$ZONE_123_2005[is.na(fuaLy_DC$ZONE_123_2005)] <- "2"
fuaLy_DC$ZONE_123_2006[is.na(fuaLy_DC$ZONE_123_2006)] <- "2"
fuaLy_DC$ZONE_123_2007[is.na(fuaLy_DC$ZONE_123_2007)] <- "2"
fuaLy_DC$ZONE_123_2008[is.na(fuaLy_DC$ZONE_123_2008)] <- "2"
fuaLy_DC$ZONE_123_2009[is.na(fuaLy_DC$ZONE_123_2009)] <- "2"
fuaLy_DC$ZONE_123_2010[is.na(fuaLy_DC$ZONE_123_2010)] <- "2"
fuaLy_DC$ZONE_123_2011[is.na(fuaLy_DC$ZONE_123_2011)] <- "2"
fuaLy_DC$ZONE_123_2012[is.na(fuaLy_DC$ZONE_123_2012)] <- "2"
fuaLy_DC$ZONE_123_2013[is.na(fuaLy_DC$ZONE_123_2013)] <- "2"
fuaLy_DC$ZONE_123_2014[is.na(fuaLy_DC$ZONE_123_2014)] <- "2"
fuaLy_DC$ZONE_123_2015[is.na(fuaLy_DC$ZONE_123_2015)] <- "2"
fuaLy_DC$ZONE_123_2016[is.na(fuaLy_DC$ZONE_123_2016)] <- "2"
fuaLy_DC$ZONE_123_2017[is.na(fuaLy_DC$ZONE_123_2017)] <- "2"
fuaLy_DC$ZONE_123_2018[is.na(fuaLy_DC$ZONE_123_2018)] <- "2"
fuaLy_DC$ZONE_123_2019[is.na(fuaLy_DC$ZONE_123_2019)] <- "2"
fuaLy_DC$CODGEO_2019 <- as.character(fuaLy_DC$CODGEO_2019)
fuaLy_DC$CODGEO_2003[is.na(fuaLy_DC$CODGEO_2003)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2003)]
fuaLy_DC$CODGEO_2004[is.na(fuaLy_DC$CODGEO_2004)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2004)]
fuaLy_DC$CODGEO_2005[is.na(fuaLy_DC$CODGEO_2005)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2005)]
fuaLy_DC$CODGEO_2006[is.na(fuaLy_DC$CODGEO_2006)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2006)]
fuaLy_DC$CODGEO_2007[is.na(fuaLy_DC$CODGEO_2007)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2007)]
fuaLy_DC$CODGEO_2008[is.na(fuaLy_DC$CODGEO_2008)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2008)]
fuaLy_DC$CODGEO_2009[is.na(fuaLy_DC$CODGEO_2009)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2009)]
fuaLy_DC$CODGEO_2010[is.na(fuaLy_DC$CODGEO_2010)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2010)]
fuaLy_DC$CODGEO_2011[is.na(fuaLy_DC$CODGEO_2011)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2011)]
fuaLy_DC$CODGEO_2012[is.na(fuaLy_DC$CODGEO_2012)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2012)]
fuaLy_DC$CODGEO_2013[is.na(fuaLy_DC$CODGEO_2013)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2013)]
fuaLy_DC$CODGEO_2014[is.na(fuaLy_DC$CODGEO_2014)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2014)]
fuaLy_DC$CODGEO_2015[is.na(fuaLy_DC$CODGEO_2015)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2015)]
fuaLy_DC$CODGEO_2016[is.na(fuaLy_DC$CODGEO_2016)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2016)]
fuaLy_DC$CODGEO_2017[is.na(fuaLy_DC$CODGEO_2017)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2017)]
fuaLy_DC$CODGEO_2018[is.na(fuaLy_DC$CODGEO_2018)] <- fuaLy_DC$CODGEO_2019[is.na(fuaLy_DC$CODGEO_2018)]


# 3. Jointure d'informations sur la population (2016) et le revenu médian (2017)

## Population 2016 (fournie par l'INSEE selon la géographie au 1er janvier 2019)

### Pour les communes
Pop <- read_xls("raw-data/INSEE/INSEE_DATA/BTX_TD_POP1A_2016.xls", col_names = F, sheet = "COM")
Pop <- Pop[c(11:34964),c(1,3:22)]
colnames(Pop) <- Pop[c(1),]
Pop <- Pop[c(2:34954),]
Pop2 <- data.frame(sapply(Pop[,c(2:21)], function(x) as.numeric(x)))
Pop <- cbind(Pop, Pop2)
remove(Pop2)
Pop <- Pop[,c(1,22:41)]
Pop$POPULATION <- rowSums(Pop[2:21], na.rm = T)
Pop <- Pop[,c(1,22)]

### Ajout des arrondissements
Pop_Arr <- read_xls("raw-data/INSEE/INSEE_DATA/BTX_TD_POP1A_2016.xls", col_names = F, sheet = "ARM")
Pop_Arr <- Pop_Arr[c(11:56),c(1,3:22)]
colnames(Pop_Arr) <- Pop_Arr[c(1),]
Pop_Arr <- Pop_Arr[c(2:46),]
Pop2_Arr <- data.frame(sapply(Pop_Arr[,c(2:21)], function(x) as.numeric(x)))
Pop_Arr <- cbind(Pop_Arr, Pop2_Arr)
remove(Pop2_Arr)
Pop_Arr <- Pop_Arr[,c(1,22:41)]
Pop_Arr$POPULATION <- rowSums(Pop_Arr[2:21], na.rm = T)
Pop_Arr <- Pop_Arr[,c(1,22)]

### Fusion des tables
Pop <- rbind(Pop, Pop_Arr)
fuaLy_DC <- merge(fuaLy_DC, Pop, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)


## Revenus médians 2017 (sur la géographie au 1er janvier 2018)
# Note : il s'agit plus exactement du revenu médian par unité de consommation

### Ouverture et traitement de la table
Rev <- read_xlsx("raw-data/INSEE/INSEE_DATA/FILO2017_DEC_COM.xlsx", col_names = F, sheet = "ENSEMBLE")
Rev <- Rev[c(6:31751),c(1,8)]
colnames(Rev) <- Rev[c(1),]
Rev <- Rev[c(2:31746),]
names(Rev)[2] <- "REV_MEDIAN"
Rev$REV_MEDIAN <- as.numeric(Rev$REV_MEDIAN)

### Jointure
fuaLy_DC <- merge(fuaLy_DC, Rev, by.x = "CODGEO_2018", by.y = "CODGEO", all.x = T) # Les NA restant correspondent aux communes de trop petite taille


# 4. Enregistrement de la table

fuaLy_DC <- as.data.frame(fuaLy_DC)
fuaLy_DC <- fuaLy_DC[,c(1:58)]


# Du fait d'un dysfonctionnement du package xlsx, on passe par des voies un peu détournées pour enregistrer deux feuilles un même document
Final <- createWorkbook()
addWorksheet(Final, "Brut")
addWorksheet(Final, "Def")
writeData(Final, sheet = "Brut", x = fuaLy_DC)



# 5. Construction de la table définitive (1 seule ligne par commune de 2019 + prise en compte des fusions)

## Base de départ
fuaLy_Def <- as.data.frame(fuaLy_COM)
fuaLy_Def <- fuaLy_Def[,c(1,2)]

## Import de la matrice de passage
modif <- as.data.frame(read_xlsx("raw-data/geom/input/table_passage_geo2003_geo2020.xlsx",
                               col_types = "text", sheet = "Table de passage", 
                               skip = 5)) 

## Réalisation et jointure des bases par années successives pour ABC

### 2003
DB_03 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2003",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_03, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_03)

### 2004
DB_04 <- comix(x = fuaLy_DC, xid = "CODGEO_2004", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2004",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_04, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_04)

### 2005
DB_05 <- comix(x = fuaLy_DC, xid = "CODGEO_2005", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2005",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_05, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_05)

### 2006
DB_06 <- comix(x = fuaLy_DC, xid = "CODGEO_2006", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2006",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_06, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_06)

### 2007
DB_07 <- comix(x = fuaLy_DC, xid = "CODGEO_2007", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2007",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_07, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_07)

### 2008
DB_08 <- comix(x = fuaLy_DC, xid = "CODGEO_2008", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2008",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_08, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_08)

### 2009
DB_09 <- comix(x = fuaLy_DC, xid = "CODGEO_2009", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2009",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_09, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_09)

### 2010
DB_10 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2010",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_10, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_10)

### 2011
DB_11 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2011",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_11, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_11)

### 2012
DB_12 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2012",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_12, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_12)

### 2013
DB_13 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2013",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_13, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_13)

### 2014
DB_14 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2014",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_14, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_14)

### 2015
DB_15 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2015",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_15, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_15)

### 2016
DB_16 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2016",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_16, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_16)

### 2017
DB_17 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2017",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_17, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_17)

### 2018
DB_18 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_ABC_2018",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_18, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_18)

### 2019
fuaLy_Def <- merge(fuaLy_Def, subset(fuaLy_DC[,c("CODGEO_2019", "ZONE_ABC_2019")], !duplicated(fuaLy_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)

### Recodage
fuaLy_Def$ZONE_ABC_2003[fuaLy_Def$ZONE_ABC_2003 == "C-B"] <- "B-C"
fuaLy_Def$ZONE_ABC_2004[fuaLy_Def$ZONE_ABC_2004 == "C-B"] <- "B-C"
fuaLy_Def$ZONE_ABC_2005[fuaLy_Def$ZONE_ABC_2005 == "C-B"] <- "B-C"
fuaLy_Def$ZONE_ABC_2006[fuaLy_Def$ZONE_ABC_2006 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2007[fuaLy_Def$ZONE_ABC_2007 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2008[fuaLy_Def$ZONE_ABC_2008 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2009[fuaLy_Def$ZONE_ABC_2009 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2010[fuaLy_Def$ZONE_ABC_2010 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2011[fuaLy_Def$ZONE_ABC_2011 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2012[fuaLy_Def$ZONE_ABC_2012 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2013[fuaLy_Def$ZONE_ABC_2013 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2014[fuaLy_Def$ZONE_ABC_2014 == "C-B2"] <- "B2-C"
fuaLy_Def$ZONE_ABC_2006[fuaLy_Def$ZONE_ABC_2006 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2007[fuaLy_Def$ZONE_ABC_2007 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2008[fuaLy_Def$ZONE_ABC_2008 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2009[fuaLy_Def$ZONE_ABC_2009 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2010[fuaLy_Def$ZONE_ABC_2010 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2011[fuaLy_Def$ZONE_ABC_2011 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2012[fuaLy_Def$ZONE_ABC_2012 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2013[fuaLy_Def$ZONE_ABC_2013 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2014[fuaLy_Def$ZONE_ABC_2014 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2015[fuaLy_Def$ZONE_ABC_2015 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2016[fuaLy_Def$ZONE_ABC_2016 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2017[fuaLy_Def$ZONE_ABC_2017 == "C-B1"] <- "B1-C"
fuaLy_Def$ZONE_ABC_2018[fuaLy_Def$ZONE_ABC_2018 == "C-B1"] <- "B1-C"


## Réalisation et jointure des bases par années successives pour 123

### 2003
DB_03 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2003",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_03, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_03)

### 2004
DB_04 <- comix(x = fuaLy_DC, xid = "CODGEO_2004", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2004",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_04, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_04)

### 2005
DB_05 <- comix(x = fuaLy_DC, xid = "CODGEO_2005", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2005",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_05, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_05)

### 2006
DB_06 <- comix(x = fuaLy_DC, xid = "CODGEO_2006", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2006",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_06, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_06)

### 2007
DB_07 <- comix(x = fuaLy_DC, xid = "CODGEO_2007", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2007",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_07, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_07)

### 2008
DB_08 <- comix(x = fuaLy_DC, xid = "CODGEO_2008", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2008",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_08, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_08)

### 2009
DB_09 <- comix(x = fuaLy_DC, xid = "CODGEO_2009", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2009",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_09, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_09)

### 2010
DB_10 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2010",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_10, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_10)

### 2011
DB_11 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2011",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_11, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_11)

### 2012
DB_12 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2012",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_12, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_12)

### 2013
DB_13 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2013",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_13, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_13)

### 2014
DB_14 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2014",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_14, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_14)

### 2015
DB_15 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2015",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_15, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_15)

### 2016
DB_16 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2016",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_16, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_16)

### 2017
DB_17 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2017",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_17, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_17)

### 2018
DB_18 <- comix(x = fuaLy_DC, xid = "CODGEO_2003", app = modif,
                app.init = "CODGEO_INI", app.target = "CODGEO_2020", 
                var = "ZONE_123_2018",
                var.type = "text")
fuaLy_Def <- merge(fuaLy_Def, DB_18, by.x = "INSEE_COM", by.y = "CODGEO_2020")
remove(DB_18)

### 2019
fuaLy_Def <- merge(fuaLy_Def, subset(fuaLy_DC[,c("CODGEO_2019", "ZONE_123_2019")], !duplicated(fuaLy_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)

### Recodage

fuaLy_Def$ZONE_123_2005[fuaLy_Def$ZONE_123_2005 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2006[fuaLy_Def$ZONE_123_2006 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2007[fuaLy_Def$ZONE_123_2007 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2008[fuaLy_Def$ZONE_123_2008 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2009[fuaLy_Def$ZONE_123_2009 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2010[fuaLy_Def$ZONE_123_2010 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2011[fuaLy_Def$ZONE_123_2011 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2012[fuaLy_Def$ZONE_123_2012 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2013[fuaLy_Def$ZONE_123_2013 == "3-2"] <- "2-3"
fuaLy_Def$ZONE_123_2014[fuaLy_Def$ZONE_123_2014 == "3-2"] <- "2-3"


## Jointure pour l'ACV et les agréments

fuaLy_Def <- merge(fuaLy_Def, subset(fuaLy_DC[,c("CODGEO_2019", "ACV", "ORT", "DATE_AGREM_M", "DATE_AGREM_P", "POPULATION")], !duplicated(fuaLy_DC$CODGEO_2019)), by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T, all.y = F)


## Export de la table
writeData(Final, sheet = "Def", x = fuaLy_Def)

# Export the file
saveWorkbook(Final, "Output/Lyon/Dispositifs_Lyon.xlsx")

4.2.2.1 Situation en 2019

A titre de démonstration, on réalise ici cinq cartes enregistrées au format .png dans le dossier “fig/Lyon” :

1. Le zonage A/B/C sur la FUA de Lyon (“ABC.png”)

2. Le zonage 1/2/3 sur la FUA (“123.png”)

3. L’éligibilité aux dispositifs nationaux communaux (Pinel, PTZ, APL, Denormandie) (“DNC.png”)

4. L’éligibilité aux dispositifs locaux communaux (Louer solidaire, Plan 3A, régulation des meublés de tourisme, prêt CODAL) (“DLC.pgn”)

5. L’éligibilité aux dispositifs infracommunaux (TVA réduite, quotas de logements aidés) (“DI.png”)

Le script suivant est adapté à la situation propre à 2019. Il peut néanmoins servir de base à une réécriture pour d’autres années.

# 1. Préparation

# Ouverture des bases

## Ouverture des fonds de cartes des communes de la FUA de Lyon
fuaLy_COM <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "comFu")
fuaLy_COM <- subset(fuaLy_COM, fuaLy_COM$study == "FUA")
fuaLy_COM <- fuaLy_COM[,c(1,2, 13)]

## Ouverture des couches départements et métropoles
fuaLy_DEP <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "depFu")
fuaLy_MET <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "metroFu")
fuaLy_STUDY <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "studyFu")

# Ouverture de la table sur les dispositifs nationaux à l'échelon communal
fuaLy_DC <- read_excel("Output/Lyon/Dispositifs_Lyon.xlsx")
fuaLy_DC <- fuaLy_DC[,c("CODGEO_2019", "ZONE_ABC_2019", "ZONE_123_2019", "ACV", "ORT")]

# Ouverture de la couche sur les secteurs mixité sociale
SMS <- st_read("raw-data/LYON_METROPOLE/Secteurs_mixite_sociale/SMS.shp", quiet = TRUE)

# Ouverture de la couche sur les QPV
QPV_Ly <- st_read("Output/Lyon/Lyon_TVA.gpkg", layer = "QPV_Fu", quiet = T)
PNRU_Ly <- st_read("Output/Lyon/Lyon_TVA.gpkg", layer = "PNRU_Fu", quiet = T)


# Jointure des communes de la FUA de Lyon et la table des dispositifs
fuaLy_COM <- merge(fuaLy_COM, fuaLy_DC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)


# Création de la variable éligibilité aux différents dispositifs nationaux

fuaLy_COM$ELIG_Pinel <- "Oui"
fuaLy_COM$ELIG_Pinel[fuaLy_COM$ZONE_ABC_2019 == "C" | fuaLy_COM$ZONE_ABC_2019 == "B2"] <- "Non"

fuaLy_COM$ELIG_PTZ_Ancien <- "Non"
fuaLy_COM$ELIG_PTZ_Ancien[fuaLy_COM$ZONE_ABC_2019 == "C" | fuaLy_COM$ZONE_ABC_2019 == "B2"] <- "Oui"

fuaLy_COM$ELIG_APL <- "Non"
fuaLy_COM$ELIG_APL[fuaLy_COM$ZONE_123_2019 == "3"] <- "Oui"


# Construction de la variable "ELIG_N", qui synthétise l'éligibilité aux dispositifs nationaux

fuaLy_COM$ELIG_N[fuaLy_COM$ELIG_Pinel == "Oui" & fuaLy_COM$ELIG_APL == "Oui"] <- "Pinel + APLA"
fuaLy_COM$ELIG_N[fuaLy_COM$ELIG_Pinel == "Oui" & fuaLy_COM$ELIG_APL == "Non"] <- "Pinel seul"
fuaLy_COM$ELIG_N[fuaLy_COM$ELIG_Pinel == "Non" & fuaLy_COM$ELIG_APL == "Oui"] <- "PTZ ancien + APLA"
fuaLy_COM$ELIG_N[fuaLy_COM$ELIG_Pinel == "Non" & fuaLy_COM$ELIG_APL == "Non"] <- "PTZ ancien seul"


# Fusion des arrondissements lyonnais

Lyon <- subset(fuaLy_COM, substr(fuaLy_COM$NOM_COM, 0,4) == "Lyon")
Lyon <- aggregate(Lyon,  by = list(Lyon$ZONE_ABC_2019), FUN = head, 1)
Lyon$NOM_COM <- "Lyon"
Lyon$INSEE_COM <- "69123"
Lyon <- Lyon[,c(2:12)]

fuaLy_COM <- subset(fuaLy_COM, substr(fuaLy_COM$NOM_COM, 0,4) != "Lyon")
fuaLy_COM <- rbind(fuaLy_COM, Lyon)
remove(Lyon)


# Construction de la variable "ELIG_L" 

GL_COM <- st_intersection(st_buffer(fuaLy_COM, -1), fuaLy_MET) # Le tampon de -1m permet d'éviter de saisir les communes voisines
GL_COM$ELIG_L <- "Louer solidaire + Plan 3A"
GL_COM <- as.data.frame(GL_COM)[,c("INSEE_COM", "ELIG_L")]
fuaLy_COM <- merge(fuaLy_COM, GL_COM, all.x = T)

fuaLy_COM$ELIG_L[fuaLy_COM$NOM_COM == "Lyon"] <- "Louer solidaire + Plan 3A\n+ régulation des meublés tourisme "

fuaLy_COM$ELIG_L[fuaLy_COM$DEP == "01"] <- "Prêt CODAL"


# Construction d'une variable "Etiq" pour déterminer les communes dont on indique le nom

fuaLy_COM$Etiq <- "0"

fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Lyon" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vienne"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Rive-de-Gier" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Villefranche-sur-Saône" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Pont-de-Chéruy"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "L'Isle-d'Abeau"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Savigny"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vaugneray"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Montluel"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vaulx-en-Velin"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vénissieux"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Dardilly"] <- "1"

#fuaLy_COM <- subset(fuaLy_COM, !duplicated(fuaLy_COM))



# 2. Cartographie

sizes <- getFigDim(x = fuaLy_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : zonage A/B/C

png(file = "fig/Lyon/2019/ABC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_COM, var = "ZONE_ABC_2019",
           col = c("#d95f0e", "#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2019 - Lyon", 
            sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 2 : zonage 1/2/3

png(file = "fig/Lyon/2019/123.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_COM, var = "ZONE_123_2019",
           col = c("#a8ddb5", "#e0f3db"),
           border = NA,
           legend.pos =  "topright",
           legend.values.order = c("2", "3"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage 1/2/3 2019 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 3 : éligibilités croisées aux dispositifs Pinel, PTZ et APL


png(file = "fig/Lyon/2019/DNC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_COM, var = "ELIG_N",
           border = NA,
           col = carto.pal("pastel.pal", 8) [c(4,6,5,7)],
           legend.pos = "topright",
           legend.values.order = c("PTZ ancien seul","PTZ ancien + APLA","Pinel seul","Pinel + APLA"), legend.values.cex = 0.6, 
           legend.title.txt = NA, add = TRUE)

hatchedLayer(fuaLy_COM[fuaLy_COM$ACV == "Oui" | fuaLy_COM$ORT == "Oui",], 
             pattern= "left2right", 
             density = 10, 
             col = "black",
             add = T)

legendHatched(
  "right", 
  title.txt = NA,
  categ = "Denormandie (ACV et ORT)",
  patterns = "left2right")

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray37", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité des communes aux dispositifs nationaux d'aide à l'acquisition immobilière 2019 - Lyon",
       sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 4 : éligibilité aux dispositifs locaux communaux


png(file = "fig/Lyon/2019/DLC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_COM, var = "ELIG_L", legend.pos = "n",
           border = NA, add = T)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("Prêt CODAL", "Louer solidaire + Plan 3A", "Louer solidaire + Plan 3A\n+ régulation des meublés tourisme "),
            col = carto.pal(pal1 = "pastel.pal", n1 = 5), 
            nodata = F, frame = FALSE, symbol = "box")

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité des communes aux dispositifs locaux d'aide à l'acquisition immobilière 2019 - Lyon",
       sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 5 : dispositifs infra-communaux

png(file = "fig/Lyon/2019/DI.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)

plot(st_geometry(fuaLy_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(SMS), col = "orange1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(PNRU_Ly[2019 %in% PNRU_Ly$date_sign:PNRU_Ly$date_fin+2], 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Ly, 300)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Ly[QPV_Ly$NPNRU == "OUI",], 500)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM", cex = 0.5,
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("Quotas de logements sociaux dans\nles programmes neufs (secteurs mixité\nsociale)", "TVA réduite (PNRU)", "TVA réduite\n(quartiers prioritaires des\npolitiques de la ville"),
            col = c("orange1", "#74c476", "#74a9cf"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Dispositifs infracommunaux d'aide à l'acquisition immobilière 2019 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.2.2 Evolution 2003-2019

4.2.2.2.1 Préparation de la table

La cartographie de l’évolution des zonages se fait à partir du découpage de 2019 et de la table de passage fournie par l’INSEE. Cette démarche présente d’une part certaines limites pour le traitement des fusions. On renvoie à l’explication pour Paris fournie en 4.2.1.2.1.

On identifie les communes qui ont connu des fusions entre 2003 et 2019 entre des communes aux classements différents :

Code 2019	Code 2003	Nom 2019	Zone 2003	Zone 2006	Zone 2014	Zone 2019
69159	69101	Porte des Pierres Dorées	C	C	C	B1
69159	69159	Porte des Pierres Dorées	C	C	B1	B1
69159	69114	Porte des Pierres Dorées	B	B2	B1	B1
69179	69213	Beauvallon	C	C	C	B1
69179	69179	Beauvallon	C	C	C	B1
69179	69048	Beauvallon	C	C	B1	B1
69255	69221	Vaugneray	C	C	C	B1
69255	69255	Vaugneray	B	B1	B1	B1

On conserve, pour chaque commune de 2019, la ligne qui présente les classements les plus élevés.

Code 2019	Code 2003	Nom 2019	Zone 2003	Zone 2006	Zone 2014	Zone 2019
69159	69159	Porte des Pierres Dorées	C	C	B1	B1
69179	69179	Beauvallon	C	C	C	B1
69255	69255	Vaugneray	B	B1	B1	B1

Le problème des fusions peut également se poser pour la gestion des agréments. Dans le cas de Lyon, aucun agrément n’a été accordé à une commune qui aurait fusionné depuis.

On construit une base à partir de laquelle sont ensuite réalisées les cartes :

# Ouverture des bases géo
fuaLy_COM <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "comFu")
fuaLy_COM <- subset(fuaLy_COM, fuaLy_COM$study == "FUA")
fuaLy_COM <- fuaLy_COM[,c(1,2, 13)]

# Ouverture de la base sur les dispositifs
fuaLy_DC <- read_excel("OutPut/Lyon/Dispositifs_Lyon.xlsx")

# Jointure
fuaLy_DC <- merge(fuaLy_COM, fuaLy_DC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)

# Gestion des fusions
fuaLy_DC <- subset(fuaLy_DC, fuaLy_DC$INSEE_COM == fuaLy_DC$CODGEO_2003)

# Réorganisation de la base
fuaLy_DC <- fuaLy_DC[,c(1,2,20:57)]
colnames(fuaLy_DC)[1] <- "CODGEO"
colnames(fuaLy_DC)[2] <- "LIBGEO"

# Fusion des arrondissements lyonnais
Lyon <- subset(fuaLy_DC, substr(fuaLy_DC$LIBGEO, 0,4) == "Lyon")
Lyon$Fus <- 1
Lyon <- aggregate(Lyon,  by = list(Lyon$Fus), FUN = head, 1)
Lyon$LIBGEO <- "Lyon"
Lyon$CODGEO <- "69123"
Lyon <- Lyon[,c(2:41, 43)]

fuaLy_DC <- subset(fuaLy_DC, substr(fuaLy_DC$LIBGEO, 0,4) != "Lyon")
fuaLy_DC <- rbind(fuaLy_DC, Lyon)
remove(Lyon)


# Définition de l'éligibilité selon la zone année par année

## La période 2003-2008 ne présente pas d'intérêt, toutes les communes étant éligibles

## Pour la période 2009-2012
fuaLy_DC$ELIG_2012 <- "Eligible"
fuaLy_DC$ELIG_2012[fuaLy_DC$ZONE_ABC_2012 == "C"] <- "Non éligible"

## Pour 2013
fuaLy_DC$ELIG_2013 <- "Eligible"
fuaLy_DC$ELIG_2013[fuaLy_DC$ZONE_ABC_2013 == "C" | fuaLy_DC$ZONE_ABC_2013 == "B2"] <- "Non éligible"

## Pour la période 2014-2017
fuaLy_DC$ELIG_2014 <- "Eligible"
fuaLy_DC$ELIG_2014[fuaLy_DC$ZONE_ABC_2014 == "C" | fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Non éligible"

## Pour la période 2018-2019
fuaLy_DC$ELIG_2018 <- "Eligible"
fuaLy_DC$ELIG_2018[fuaLy_DC$ZONE_ABC_2018 == "C" | fuaLy_DC$ZONE_ABC_2018 == "B2"] <- "Non éligible"



## Modification de la variable éligibilité
fuaLy_DC$ELIG_2012[fuaLy_DC$DATE_AGREM_M == "2012"] <- "Eligible par\nagrément (2012)"
fuaLy_DC$ELIG_2013[fuaLy_DC$DATE_AGREM_P == "2013"] <- "Eligible par agrément"
fuaLy_DC$ELIG_2014[fuaLy_DC$DATE_AGREM_P == "2014"| fuaLy_DC$DATE_AGREM_P == "2015" | fuaLy_DC$DATE_AGREM_P == "2016"] <- "Eligible par\nagrément (2014-2017)"
fuaLy_DC$ELIG_2014[fuaLy_DC$DATE_AGREM_P == "2013" & fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Eligible par\nagrément (2014-2017)"

28 agréments ont donc été accordés à des communes de la FUA de Lyon entre 2013 et 2017. Au moment de l’agrément, les communes concernées sont toujours classées en B2. Ces agréments se répartissent ainsi :

Année de l’agrément	2013	2014	2015	2016
Effectifs	13	6	8	1

4.2.2.2.2 Cartographie

Pour cartographier l’évolution des zonages et de l’éligibilité aux dispositifs nationaux à l’échelon communal, on se limite à une cartographie par période. Pour cela, on identifie préalablement les années de rupture et de reclassement.

• Pour le zonage ABC, l’étude des effectifs par zone et des reclassements suggère le découpage suivant : 2003-2005, 2006-2008, 2009-2013, 2014-2019.

Classement	2006	2009	2014	2019
Nombre de reclassement par rapport au classement précédent	124	18	64	1

• L’éligibilité aux aides à l’investissement locatif a été retirée aux communes de la zone C à partir de 2009 (sauf dérogation sur la période 2010-2017) puis de la zone B2 à partir de 2013 (sauf dérogation sur la période 2013-2017). L’éligibilité à ces aides nécessite un découpage particulièrement commençant en 2009 : 2009-2012, 2013 (avec agréments), 2014- (avec agréments sur la période 2014-2017). L’éligibilité au PTZ ancien a simplement été retirée aux communes des zones A, Abis et B1 depuis 2018, ce qui ne justifie pas de réaliser une carte indépendante.

• Le classement 1/2/3 des communes de la FUA de Lyon n’a connu aucun changement entre 2003 et 2019. La seule évolution notable est relative à l’éligibilité à l’APL accession, qui n’est plus disponible qu’en zone 3 depuis 2018 - ce qui ne justifie pas une carte à part entière.

• Pour la TVA réduite. Les QPV instaurés en 2015 sont connus. La région Ile-de-France propose une cartographie des zones ANRU (2004-2014) qui sert de support à la détermination des zones d’éligibilité à la TVA réduite sur la période 2006-2014. Pour le reste des territoires concernés, les périmètres des PNRU ont été obtenu par digitalisationà partir des données fournées par l’ANCT via le site sig.ville.gouv.fr (cf. partie 4.1.1.2)

4.2.2.2.2.1 Historique - ABC

L’historique du zonage ABC est disponible ici sous la forme d’un document “ABC.pdf”, qui permet de disposer d’une image en vecteur relativement peu lourde.

# On repart des bases élaborées dans le chunk précédent


# 1. Préparations

# Ouverture des couches départements et métropoles
fuaLy_DEP <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "depFu")
fuaLy_MET <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "metroFu")
fuaLy_STUDY <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "studyFu")

# Etiquettes 
fuaLy_COM$Etiq <- "0"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Lyon" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vienne"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Rive-de-Gier" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Villefranche-sur-Saône" ] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Pont-de-Chéruy"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "L'Isle-d'Abeau"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Savigny"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vaugneray"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Montluel"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vaulx-en-Velin"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Vénissieux"] <- "1"
fuaLy_COM$Etiq[fuaLy_COM$NOM_COM == "Dardilly"] <- "1"

fuaLy_COM <- subset(fuaLy_COM, !duplicated(fuaLy_COM))


# 2. Cartographie


pdf("fig/Lyon/Historique/ABC.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaLy_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : A/B/C 2003-2005

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ZONE_ABC_2003",
           col = c("#feb24c", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2003-2005 - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

# Carte 2 : A/B/C 2006-2008

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ZONE_ABC_2006",
           col = c("#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2006-2008 - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : A/B/C 2009-2013

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ZONE_ABC_2009",
           col = c("#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2009-2013 - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 4 : A/B/C depuis 2014

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ZONE_ABC_2014",
           col = c("#d95f0e", "#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("A", "B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C depuis 2014 - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

L’historique de l’éligibilité aux aides fiscales à l’investissement locatif (Scellier, Duflot, Pinel) est également disponible ici sous le nom “AFIL.pdf”.

# 1. Préparations

# Ouverture des couches départements et métropoles
fuaLy_DEP <- st_read("raw-data/geom/Output/geom_Lyon_FUA.gpkg", layer = "depFu")
fuaLy_MET <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "metroFu")
fuaLy_STUDY <- st_read("raw-data/geom/geom_Lyon_FUA.gpkg", layer = "studyFu")

# Création des étiquettes, qui indiquent, dans le cas d'agréments, l'année de sa signature
fuaLy_DC$Etiq[fuaLy_DC$DATE_AGREM_P == "2013"] <- "1"
fuaLy_DC$Etiq[fuaLy_DC$DATE_AGREM_P == "2014"] <- "1"
fuaLy_DC$Etiq[fuaLy_DC$DATE_AGREM_P == "2015"] <- "1"
fuaLy_DC$Etiq[fuaLy_DC$DATE_AGREM_P == "2016"] <- "1"


fuaLy_COM <- subset(fuaLy_COM, !duplicated(fuaLy_COM))


# 2. Cartographie


pdf("fig/Lyon/Historique/AFIL.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaLy_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : 2009-2012

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ELIG_2012",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément (2012)"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité au dispositif Scellier (2009-2012) - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2013

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ELIG_2013",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par agrément"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

layoutLayer(title = "Eligibilité au dispositif Duflot (2013) - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

table(fuaLy_DC$ELIG_2014)

# Carte 3 : depuis 2014

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)
plot(st_geometry(fuaLy_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaLy_DC, var = "ELIG_2014",
           col = c("#a1d99b", "#feb24c", "#756bb1"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément (2014-2017)"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_DC, Etiq == "1"),
           txt = "DATE_AGREM_P", cex = 0.7,
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité au dispositif Duflot (2014) et Pinel (2015-2017) - Lyon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.2.2.2.2 Evolution des périmètres de TVA réduite à 5,5%

Les périmètres de TVA réduite à 5,5% pour la construction de logements en accession, instaurés en 2006, ont été modifiés en 2014, en 2015 et en 2017 : on réalise donc un panneau de quatre cartes correspondant aux années 2010 (milieu de la première période), 2014, 2016 et 2019. Cependant, dans la mesure où l’éligibilité à la TVA réduite des secteurs du PNRU dépend de la date de signature et de fin du contrat ANRU, il faudrait en toute rigueur réaliser une carte par année - ce que permet de faire le script shiny en fin de document.

pdf("fig/Lyon/Historique/TVA.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaLy_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : 2010

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)

plot(st_geometry(fuaLy_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Ly[2010 %in% PNRU_Ly$date_sign:PNRU_Ly$date_fin+2], 500)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 500m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2010 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2014

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)

plot(st_geometry(fuaLy_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Ly[2014 %in% PNRU_Ly$date_sign:PNRU_Ly$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2014 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : 2016

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)

plot(st_geometry(fuaLy_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Ly[2016 %in% PNRU_Ly$date_sign:PNRU_Ly$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Ly, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m"),
            col = c("red1", "#74c476"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2016 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

# Carte 4 : 2019

plot(st_geometry(fuaLy_DEP), col = "white", border = NA)

plot(st_geometry(fuaLy_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaLy_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Ly[2016 %in% PNRU_Ly$date_sign:PNRU_Ly$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Ly, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Ly[QPV_Ly$NPNRU == "OUI",], 500)), col = "#2b8cbe", border = NA, add = TRUE)

plot(st_geometry(fuaLy_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaLy_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaLy_COM, Etiq == "1"),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m", "NPNRU + 500m"),
            col = c("red1", "#74c476", "#2b8cbe"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2019 - Lyon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.3 Avignon

On crée une base synthétique des données à l’échelon communal sur Avignon. Cette base renseigne, pour chaque année, le code INSEE de la commune, son classement dans les zonages A/B/C et 1/2/3, son appartenance ou non au programme de l’Action coeur de ville.

Deux différences par rapport aux bases de Paris et Lyon sont à noter :

• Aucune fusion ni aucune scission n’ayant été recensée, le détail des codes année par année a surtout pour but l’harmonisation avec les autres tables. Dès lors, il n’y a pas lieu de distinguer une table “Brut” d’une table “Def”.

• Aucune des 45 communes de la FUA d’Avignon n’a été concernée par un agrément ministériel (Scellier) ni par une opération de revitalisation de territoire (ORT) ; ces deux tables n’ont donc pas été inclues.

Cette table (fuaAv_DC pour “dispositifs communaux”) est enregistrée à “Output/Avignon/Dispositifs_Avignon.xlsx”.

# 1. Chargement des tables

## Ouverture des fonds de cartes des communes de la FUA de Avignon
fuaAv_COM <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "comFu")
fuaAv_COM <- subset(fuaAv_COM, fuaAv_COM$study == "FUA")
fuaAv_COM <- fuaAv_COM[,c(1,2, 16)]

## Ouverture de la base ABC (France)
ABC <- read_excel("Output/France/ABC_detail.xlsx")

## Ouverture de la base 123 (France)
DB_123 <- read_excel("Output/France/123_detail.xlsx")

## Ouverture de la base Action coeur de ville
ACV <- read_delim("raw-data/MCT/ACV/Action_coeur_ville.csv", ";", escape_double = FALSE, trim_ws = TRUE)
ACV$ACV <- "Oui"
ACV <- ACV[,c(1,4)]

## Ouverture de la base sur les agréments préfectoraux
Agrements <- read_excel("raw-data/MCT/ZONAGE_ABC/Agrements.xls")
Agrements <- Agrements[,c(4,6)]
colnames(Agrements) <- c("CODGEO", "DATE_AGREM")
Agrements$DATE_AGREM <- substr(Agrements$DATE_AGREM, 1, 4)
Agrements$DATE_AGREM[is.na(Agrements$DATE_AGREM)] <- "2015"


# 2. Fusion des tables

fuaAv_DC <- merge(fuaAv_COM, ABC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- merge(fuaAv_COM, DB_123, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)
Interm <- Interm[,c(1,36:52)]
fuaAv_DC <- (cbind(fuaAv_DC, Interm))
remove(Interm)
fuaAv_DC <- fuaAv_DC[,c(1,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36:52,54:72)]
names(fuaAv_DC)[1] <- "CODGEO_2019"
names(fuaAv_DC)[2] <- "LIBGEO_2019"
fuaAv_DC <- merge(fuaAv_DC, ACV, by.x = "CODGEO_2019", by.y = "INSEE_COM", all.x = T)
fuaAv_DC$ACV[is.na(fuaAv_DC$ACV)] <- "Non"
fuaAv_DC <- merge(fuaAv_DC, Agrements, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)


# Jointure d'informations sur la population (2016) et le revenu médian (2017)

## Population 2016 (fournie par l'INSEE selon la géographie au 1er janvier 2019)

### Pour les communes
Pop <- read_xls("raw-data/INSEE/INSEE_DATA/BTX_TD_POP1A_2016.xls", col_names = F, sheet = "COM")
Pop <- Pop[c(11:34964),c(1,3:22)]
colnames(Pop) <- Pop[c(1),]
Pop <- Pop[c(2:34954),]
Pop2 <- data.frame(sapply(Pop[,c(2:21)], function(x) as.numeric(x)))
Pop <- cbind(Pop, Pop2)
remove(Pop2)
Pop <- Pop[,c(1,22:41)]
Pop$POPULATION <- rowSums(Pop[2:21], na.rm = T)
Pop <- Pop[,c(1,22)]

### Fusion des tables
fuaAv_DC <- merge(fuaAv_DC, Pop, by.x = "CODGEO_2019", by.y = "CODGEO", all.x = T)

## Revenus médians 2017 (sur la géographie au 1er janvier 2018)
# Note : il s'agit plus exactement du revenu médian par unité de consommation

### Ouverture et traitement de la table
Rev <- read_xlsx("raw-data/INSEE/INSEE_DATA/FILO2017_DEC_COM.xlsx", col_names = F, sheet = "ENSEMBLE")
Rev <- Rev[c(6:31751),c(1,8)]
colnames(Rev) <- Rev[c(1),]
Rev <- Rev[c(2:31746),]
names(Rev)[2] <- "REV_MEDIAN"
Rev$REV_MEDIAN <- as.numeric(Rev$REV_MEDIAN)

### Jointure
fuaAv_DC <- merge(fuaAv_DC, Rev, by.x = "CODGEO_2018", by.y = "CODGEO", all.x = T) # Les NA restant correspondent aux communes de trop petite taille


# 4. Enregistrement de la table

fuaAv_DC <- as.data.frame(fuaAv_DC)
fuaAv_DC <- fuaAv_DC[,c(1:55)]
write.xlsx(fuaAv_DC, "Output/Avignon/Dispositifs_Avignon.xlsx")

4.2.3.1 Situation en 2019

A titre de démonstration, on réalise ici cinq cartes enregistrées au format .png dans le dossier “fig/Avignon”

1. Le zonage A/B/C sur la FUA d’Avignon (“ABC.png”)

2. Le zonage 1/2/3 sur la FUA (“123.png”)

3. L’éligibilité aux dispositifs nationaux communaux (Pinel, PTZ, APL, Denormandie) (“DNC.png”)

4. L’éligibilité aux dispositifs infracommunaux (TVA réduite) (“DI.png”)

Les aides locales, qui ne concernent que certaines communes des Bouches-du-Rhône n’ont pas fait l’objet d’une carte par indisponibilité des périmètres des secteurs OPAH.

Le dispositif Denormandie ne concerne, pour le territoire étudié, que la commune d’Avignon.

On utilise le script suivant :

# 1. Préparation

# Ouverture des bases

## Ouverture des fonds de cartes des communes de la FUA d'Avignon
fuaAv_COM <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "comFu")
fuaAv_COM <- subset(fuaAv_COM, fuaAv_COM$study == "FUA")
fuaAv_COM <- fuaAv_COM[,c(1,2, 16)]

## Ouverture des couches départements et métropoles
fuaAv_DEP <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "depFu")
fuaAv_MET <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "metroFu")
fuaAv_STUDY <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "studyFu")

# Ouverture de la table sur les dispositifs à Avignon
fuaAv_DC <- read_excel("Output/Avignon/Dispositifs_Avignon.xlsx")
fuaAv_DC <- fuaAv_DC[,c("CODGEO_2019", "ZONE_ABC_2019", "ZONE_123_2019", "ACV")]

# Ouverture de la couche sur les QPV
QPV_Av <- st_read("Output/Avignon/Avignon_TVA.gpkg", layer = "QPV_Fu", quiet = TRUE)
PNRU_Av <- st_read("Output/Avignon/Avignon_TVA.gpkg", layer = "PNRU_Fu", quiet = TRUE)

# Jointure des communes de la FUA d'Avignon et des zones ABC
fuaAv_COM <- merge(fuaAv_COM, fuaAv_DC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)


# Création de la variable éligibilité aux différents dispositifs nationaux

fuaAv_COM$ELIG_Pinel <- "Oui"
fuaAv_COM$ELIG_Pinel[fuaAv_COM$ZONE_ABC_2019 == "C" | fuaAv_COM$ZONE_ABC_2019 == "B2"] <- "Non"

fuaAv_COM$ELIG_PTZ_Ancien <- "Non"
fuaAv_COM$ELIG_PTZ_Ancien[fuaAv_COM$ZONE_ABC_2019 == "C" | fuaAv_COM$ZONE_ABC_2019 == "B2"] <- "Oui"

fuaAv_COM$ELIG_APL <- "Non"
fuaAv_COM$ELIG_APL[fuaAv_COM$ZONE_123_2019 == "3"] <- "Oui"


# Construction de la variable "ELIG_N", qui synthétise l'éligibilité aux dispositifs nationaux

fuaAv_COM$ELIG_N[fuaAv_COM$ELIG_Pinel == "Oui" & fuaAv_COM$ELIG_APL == "Oui"] <- "Pinel + APLA"
fuaAv_COM$ELIG_N[fuaAv_COM$ELIG_Pinel == "Oui" & fuaAv_COM$ELIG_APL == "Non"] <- "Pinel seul"
fuaAv_COM$ELIG_N[fuaAv_COM$ELIG_Pinel == "Non" & fuaAv_COM$ELIG_APL == "Oui"] <- "PTZ ancien + APLA"
fuaAv_COM$ELIG_N[fuaAv_COM$ELIG_Pinel == "Non" & fuaAv_COM$ELIG_APL == "Non"] <- "PTZ ancien seul"


# Construction d'une variable surface qui servira à sélectionner les communes dont on indique le nom

# Création du champ surface (pour les étiquettes)
fuaAv_COM$area <- as.numeric(st_area(fuaAv_COM))



# 2. Cartographie

sizes <- getFigDim(x = fuaAv_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : zonage A/B/C

png(file = "fig/Avignon/2019/ABC_2.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)

typoLayer(x = fuaAv_COM, var = "ZONE_ABC_2019",
           col = c("#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "B2", "C"),
           legend.title.txt = NA)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2019 - Avignon", 
            sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 2 : zonage 1/2/3

png(file = "fig/Avignon/2019/123.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_COM, var = "ZONE_123_2019",
           col = c("#a8ddb5", "#e0f3db"),
           border = NA,
           legend.pos =  "topright",
           legend.values.order = c("2", "3"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage 1/2/3 2019 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

dev.off()


# Carte 3 : éligibilités croisées aux dispositifs Pinel, PTZ et APL

png(file = "fig/Avignon/2019/DNC.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)

typoLayer(x = fuaAv_COM, var = "ELIG_N",
           border = NA,
           col = carto.pal("pastel.pal", 8) [c(4,6,5,7)],
           legend.pos = "topright",
           legend.values.order = c("PTZ ancien seul","PTZ ancien + APLA","Pinel seul","Pinel + APLA"), legend.values.cex = 0.6, 
           legend.title.txt = NA, add = TRUE)

hatchedLayer(fuaAv_COM[fuaAv_COM$ACV == "Oui",], 
             pattern= "left2right", 
             density = 10, 
             col = "black",
             add = T)

legendHatched(
  "right", 
  title.txt = NA,
  categ = "Denormandie         ",
  patterns = "left2right")

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité des communes aux dispositifs nationaux d'aide à l'acquisition immobilière 2019 - Avignon",
       sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

dev.off()



# Carte 4 :  dispositifs infra-communaux

png(file = "fig/Avignon/2019/DI.png",width = sizes[1]*1.4, height = sizes[2], res = 400)

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)

plot(st_geometry(fuaAv_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Av[2019 %in% PNRU_Av$date_sign:PNRU_Av$date_fin+2,], 300)), col = "#74c476", border = NA, add = T)

plot(st_geometry(st_buffer(QPV_Av, 300)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Av[QPV_Av$NPNRU == "OUI",], 500)), col = "#74a9cf", border = NA, add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM", cex = 0.5,
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = "TVA réduite",
            col = c("#74a9cf"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs à TVA réduite 2019 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.3.2 Evolution 2003-2019

Les 45 communes de l’aire d’étude n’ont connu aucune fusion sur la période 2003-2019, ce qui simplifie le travail.

On conserve les mêmes chrnologies que pour les FUA précédentes.

# Ouverture des fonds de cartes des communes de la FUA de Avignon
fuaAv_COM <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "comFu")
fuaAv_COM <- subset(fuaAv_COM, fuaAv_COM$study == "FUA")
fuaAv_COM <- fuaAv_COM[,c(1,2, 16)]

# Ouverture de la base sur les dispositifs
fuaAv_DC <- read_excel("OutPut/Avignon/Dispositifs_Avignon.xlsx")

# Jointure
fuaAv_DC <- merge(fuaAv_COM, fuaAv_DC, by.x = "INSEE_COM", by.y = "CODGEO_2019", all.x = T)

# Réorganisation de la base
fuaAv_DC <- fuaAv_DC[,c(1,2,20:55)]
colnames(fuaAv_DC)[1] <- "CODGEO"
colnames(fuaAv_DC)[2] <- "LIBGEO"

# Définition de l'éligibilité selon la zone année par année

## La période 2003-2008 ne présente pas d'intérêt, toutes les communes étant éligibles

## Pour la période 2009-2012
fuaAv_DC$ELIG_2009 <- "Eligible"
fuaAv_DC$ELIG_2009[fuaAv_DC$ZONE_ABC_2009 == "C"] <- "Non éligible"

## Pour 2013
fuaAv_DC$ELIG_2013 <- "Eligible"
fuaAv_DC$ELIG_2013[fuaAv_DC$ZONE_ABC_2013 == "C" | fuaAv_DC$ZONE_ABC_2013 == "B2"] <- "Non éligible"

## Pour la période 2014-2017
fuaAv_DC$ELIG_2014 <- "Eligible"
fuaAv_DC$ELIG_2014[fuaAv_DC$ZONE_ABC_2014 == "C" | fuaAv_DC$ZONE_ABC_2014 == "B2"] <- "Non éligible"

## Pour la période 2018-2019
fuaAv_DC$ELIG_2018 <- "Eligible"
fuaAv_DC$ELIG_2018[fuaAv_DC$ZONE_ABC_2018 == "C" | fuaAv_DC$ZONE_ABC_2018 == "B2"] <- "Non éligible"


# Ajout des agréments préfectoraux sur la période 2013-2017

## Ouverture de la table sur les agréments
Agrements <- read_excel("raw-data/MCT/ZONAGE_ABC/Agrements.xls")
Agrements <- Agrements[,c(4,6)]
colnames(Agrements) <- c("CODGEO", "DATE_AGREM")

## Préparation en vue de son intégration à la base ABC
Agrements$DATE_AGREM <- substr(Agrements$DATE_AGREM, 1, 4)

## Gestion des NA
# En étudiant la table originale, il apparaît que les cas où la date de publication de l'agrément n'est pas renseignée, celle de la signature l'est en commentaire. Pour l'ensemble des cas, la signature est intervenue en 2015 ; on inscrit donc "2015".
Agrements$DATE_AGREM[is.na(Agrements$DATE_AGREM)] <- "2015"

## Jointure des tables sur les agréments à la table ABC 
fuaAv_DC <- merge(fuaAv_DC, Agrements, by.x = "CODGEO", all.x = T)

## Modification de la variable éligibilité
fuaAv_DC$ELIG_2013[fuaAv_DC$DATE_AGREM == "2013"] <- "Eligible par\nagrément"
fuaAv_DC$ELIG_2014[fuaAv_DC$DATE_AGREM == "2015"] <- "Eligible par\nagrément\n(2014-2017)"

4.2.3.2.0.1 Historique - ABC

L’historique du zonage ABC est disponible ici sous la forme d’un document “ABC.pdf”, qui permet de disposer d’une image en vecteur relativement peu lourde.

# 1. Préparations

# Ouverture des couches départements et métropoles
fuaAv_DEP <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "depFu")
fuaAv_MET <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "metroFu")
fuaAv_STUDY <- st_read("raw-data/geom/geom_Avignon_FUA.gpkg", layer = "studyFu")

fuaAv_COM$area <- as.numeric(st_area(fuaAv_COM))



# 2. Cartographie


pdf("fig/Avignon/Historique/ABC.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaAv_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : A/B/C 2003-2005

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ZONE_ABC_2003",
           col = c("#feb24c", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2003-2005 - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

# Carte 2 : A/B/C 2006-2008

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ZONE_ABC_2006",
           col = c("#fe9929", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2006-2008 - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : A/B/C 2009-2013

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ZONE_ABC_2009",
           col = c("#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C 2009-2013 - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")


# Carte 4 : A/B/C depuis 2014

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ZONE_ABC_2014",
           col = c("#fe9929", "#fed98e", "#ffffd4"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("B1", "B2", "C"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Zonage A/B/C depuis 2014 - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 10, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

L’historique de l’éligibilité aux aides fiscales à l’investissement locatif (Scellier, Duflot, Pinel) est également disponible ici sous le nom “AFIL.pdf”.

# Création des étiquettes, qui indiquent, dans le cas d'agréments, l'année de sa signature
fuaAv_DC$Etiq[fuaAv_DC$DATE_AGREM == "2015"] <- "1"


pdf("fig/Avignon/Historique/AFIL.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaAv_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)

# Carte 1 : 2009-2012

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ELIG_2009",
           col = c("#a1d99b", "#feb24c"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité au dispositif Scellier (2009-2012) - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2013

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ELIG_2013",
           col = c("#a1d99b", "#feb24c", "#a6bddb"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)


labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité au dispositif Duflot (2013) - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : depuis 2014

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)
plot(st_geometry(fuaAv_STUDY), col = "lightgrey", border = NA, add = TRUE)
typoLayer(x = fuaAv_DC, var = "ELIG_2014",
           col = c("#a1d99b", "#feb24c", "#a6bddb"),
           border = NA,
           legend.pos = "topright",
           legend.values.order = c("Eligible", "Non éligible", "Eligible par\nagrément\n(2014-2017)"),
           legend.title.txt = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "gray63", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

layoutLayer(title = "Eligibilité au dispositif Duflot (2014) et Pinel (depuis 2015) - Avignon (FUA)",
            author =  "ANR WhISDoM - 2020",
            sources = "Source : INSEE, Journal officiel",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

4.2.3.2.0.2 Evolution des périmètres de TVA réduite à 5,5%

Les périmètres de TVA réduite à 5,5% pour la construction de logements en accession, instaurés en 2006, ont été modifiés en 2014, en 2015 et en 2017 : on réalise donc un panneau de quatre cartes correspondant aux années 2010 (milieu de la première période), 2014, 2016 et 2019. Cependant, dans la mesure où l’éligibilité à la TVA réduite des secteurs du PNRU dépend de la date de signature et de fin du contrat ANRU, il faudrait en toute rigueur réaliser une carte par année - ce que permet de faire le script shiny en fin de document.

pdf("fig/Avignon/Historique/TVA.pdf", width=16,height=12)

par(mar = c(1,1,2,1), mfrow=c(2,2))

sizes <- getFigDim(x = fuaAv_DEP, width = 4000, mar = c(0,0,1.2,0), res = 400)


# Carte 1 : 2010

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)

plot(st_geometry(fuaAv_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Av[2010 %in% PNRU_Av$date_sign:PNRU_Av$date_fin+2], 500)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 500m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2010 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 2 : 2014

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)

plot(st_geometry(fuaAv_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Av[2014 %in% PNRU_Av$date_sign:PNRU_Av$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m"),
            col = c("red1"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2014 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")


# Carte 3 : 2016

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)

plot(st_geometry(fuaAv_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Av[2016 %in% PNRU_Av$date_sign:PNRU_Av$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Av, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m"),
            col = c("red1", "#74c476"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2016 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

# Carte 4 : 2019

plot(st_geometry(fuaAv_DEP), col = "white", border = NA)

plot(st_geometry(fuaAv_STUDY), col = "gray92", border = NA, add = TRUE)

plot(st_geometry(fuaAv_COM), col = NA, lwd = 0.4, border = "grey82", add = TRUE)

plot(st_geometry(st_buffer(PNRU_Av[2016 %in% PNRU_Av$date_sign:PNRU_Av$date_fin+2], 300)), col = "red1", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Av, 300)), col = "#74c476", border = NA, add = TRUE)

plot(st_geometry(st_buffer(QPV_Av[QPV_Av$NPNRU == "OUI",], 500)), col = "#2b8cbe", border = NA, add = TRUE)

plot(st_geometry(fuaAv_DEP), col = NA, lwd = 1, border = "grey", add = TRUE)

plot(st_geometry(fuaAv_MET), col = NA, lwd = 1, border = "black", add = TRUE)

labelLayer(filter(fuaAv_COM, area > 30000000),
           txt = "NOM_COM",
           halo = T,
           overlap = F)

legendTypo(pos = "topright", 
            title.txt = NA,
            categ = c("PNRU + 300m", "QPV + 300m", "NPNRU + 500m"),
            col = c("red1", "#74c476", "#2b8cbe"), 
            nodata = F, frame = FALSE, symbol = "box")

layoutLayer(title = "Secteurs de TVA réduite 2019 - Avignon",
           sources = "INSEE, Legifrance",
            author = "ANR WhISDoM - 2020",
            scale = 20, 
            frame = FALSE,
            theme = "red.pal")

dev.off()

5 Pistes pour l’analyse statistique

Dans cette partie, on propose quelques premiers résultats statistiques sur les données construites.

5.1 Données sur les effectifs communaux dans le classement A/B/C

Pour une visualisation simplifiée des résultats en HTML, on utilise ici le package plot.ly, qui permet la réalisation de graphiques interactifs renseignant également les effectifs.

Les scripts suivants retracent l’élaboration d’une table à partir de laquelle il est possible de compter facilement les effectifs.

A partir de ces scripts, il est possible également de représenter les effectifs en terme d’éligibilité. Il pourrait également être intéressant de représenter des effectifs en nombre d’habitants concernés.

5.1.1 Paris

Note : il est possible d’élaborer des graphiques statiques avec la fonction barplot à partir de la table “ABC_Pa”, ainsi que re-précisé dans le script.

library(plotly)
library(readxl)

fuaPa_DC <- read_xlsx("Output/Paris/Dispositifs_Paris.xlsx")
ABC_Pa <- fuaPa_DC[,c(19:35)]
ABC_Pa <- as.data.frame(t(ABC_Pa))
ABC_Pa$A <- rowSums(ABC_Pa == "A")
ABC_Pa$Abis <- rowSums(ABC_Pa == "A bis")
ABC_Pa$B <- rowSums(ABC_Pa == "B")
ABC_Pa$B1 <- rowSums(ABC_Pa == "B1")
ABC_Pa$B2 <- rowSums(ABC_Pa == "B2")
ABC_Pa$C <- rowSums(ABC_Pa == "C")
ABC_Pa <- ABC_Pa[,c(1852:1857)]
row.names(ABC_Pa) <- c(1:17)
ABC_Pa$Annee <- c(2003:2019)
ABC_Pa <- ABC_Pa[,c(7,1:6)] # Cette table peut servir de base à un graphique statique.



hist_ABC_Pa <- plot_ly(type = "bar",
                     x=ABC_Pa$Annee, 
                     y = ABC_Pa$C,
                     name = 'C')
      hist_ABC_Pa <- hist_ABC_Pa %>% add_trace(y = ABC_Pa$B2, name = 'B2') 
      hist_ABC_Pa <- hist_ABC_Pa %>% add_trace(y = ABC_Pa$B1, name = 'B1') 
      hist_ABC_Pa <- hist_ABC_Pa %>% add_trace(y = ABC_Pa$B, name = 'B') 
      hist_ABC_Pa <- hist_ABC_Pa %>% add_trace(y = ABC_Pa$A, name = 'A') 
      hist_ABC_Pa <- hist_ABC_Pa %>% add_trace(y = ABC_Pa$Abis, name = 'A bis') 
      hist_ABC_Pa <- hist_ABC_Pa %>% layout(title = "Classement A/B/C dans la FUA de Paris", xaxis= list(title = 'Années'), yaxis = list(title = 'Nombre de communes'), barmode = 'stack')
      
      hist_ABC_Pa

5.1.2 Lyon

Note : il est possible d’élaborer des graphiques statiques avec la fonction barplot à partir de la table “ABC_Ly”, ainsi que re-précisé dans le script.

fuaLy_DC <- read_xlsx("Output/Lyon/Dispositifs_Lyon.xlsx")
ABC_Ly <- fuaLy_DC[,c(19:35)]
ABC_Ly <- as.data.frame(t(ABC_Ly))
ABC_Ly$A <- rowSums(ABC_Ly == "A")
ABC_Ly$B <- rowSums(ABC_Ly == "B")
ABC_Ly$B1 <- rowSums(ABC_Ly == "B1")
ABC_Ly$B2 <- rowSums(ABC_Ly == "B2")
ABC_Ly$C <- rowSums(ABC_Ly == "C")
ABC_Ly <- ABC_Ly[,c(338:342)]
row.names(ABC_Ly) <- c(1:17)
ABC_Ly$Annee <- c(2003:2019)
ABC_Ly <- ABC_Ly[,c(6,1:5)] # Cette table peut servir de base à un graphique statique.



hist_ABC_Ly <- plot_ly(type = "bar",
                     x=ABC_Ly$Annee, 
                     y = ABC_Ly$C,
                     name = 'C')
      hist_ABC_Ly <- hist_ABC_Ly %>% add_trace(y = ABC_Ly$B2, name = 'B2') 
      hist_ABC_Ly <- hist_ABC_Ly %>% add_trace(y = ABC_Ly$B1, name = 'B1') 
      hist_ABC_Ly <- hist_ABC_Ly %>% add_trace(y = ABC_Ly$B, name = 'B') 
      hist_ABC_Ly <- hist_ABC_Ly %>% add_trace(y = ABC_Ly$A, name = 'A') 
      hist_ABC_Ly <- hist_ABC_Ly %>% layout(title = "Classement A/B/C dans la FUA de Lyon", xaxis= list(title = 'Années'), yaxis = list(title = 'Nombre de communes'), barmode = 'stack')
      
      hist_ABC_Ly

5.1.3 Avignon

Note : il est possible d’élaborer des graphiques statiques avec la fonction barplot à partir de la table “ABC_Av”, ainsi que re-précisé dans le script.

fuaAv_DC <- read_xlsx("Output/Avignon/Dispositifs_Avignon.xlsx")
ABC_Av <- fuaAv_DC[,c(19:35)]
ABC_Av <- as.data.frame(t(ABC_Av))
ABC_Av$B <- rowSums(ABC_Av == "B")
ABC_Av$B1 <- rowSums(ABC_Av == "B1")
ABC_Av$B2 <- rowSums(ABC_Av == "B2")
ABC_Av$C <- rowSums(ABC_Av == "C")
ABC_Av <- ABC_Av[,c(46:49)]
row.names(ABC_Av) <- c(1:17)
ABC_Av$Annee <- c(2003:2019)
ABC_Av <- ABC_Av[,c(5,1:4)] # Cette table peut servir de base à un graphique statique.


hist_ABC_Av <- plot_ly(type = "bar",
                     x=ABC_Av$Annee, 
                     y = ABC_Av$C,
                     name = 'C')
      hist_ABC_Av <- hist_ABC_Av %>% add_trace(y = ABC_Av$B2, name = 'B2') 
      hist_ABC_Av <- hist_ABC_Av %>% add_trace(y = ABC_Av$B1, name = 'B1') 
      hist_ABC_Av <- hist_ABC_Av %>% add_trace(y = ABC_Av$B, name = 'B') 
      hist_ABC_Av <- hist_ABC_Av %>% layout(title = "Classement A/B/C dans la FUA d'Avignon", xaxis= list(title = 'Années'), yaxis = list(title = 'Nombre de communes'), barmode = 'stack')
      
      hist_ABC_Av

5.2 Surfaces d’éligibilité à la TVA réduite à 5,5%

Pour chaque FUA, on calcule l’évolution des aires d’éligibilité à la TVA réduite à 5,5%.

5.2.1 Paris

library(sf)

## Ouverture des bases
PNRU_Pa <- st_read("Output/Paris/Paris_TVA.gpkg", layer = "PNRU_Fu", quiet = TRUE)
QPV_Pa <- st_read("Output/Paris/Paris_TVA.gpkg", layer = "QPV_Fu", quiet = TRUE)

## Calcul des surfaces
PNRU_Pa$surf_buffer300 <- st_area(st_buffer(PNRU_Pa, 300))
PNRU_Pa$surf_buffer500 <- st_area(st_buffer(PNRU_Pa, 500))
QPV_Pa$surf_buffer <- st_area(st_buffer(QPV_Pa, 300))
QPV_Pa$surf_bufferNPNRU <- ifelse(is.na(QPV_Pa$NPNRU), st_area(st_buffer(QPV_Pa, 300)), st_area(st_buffer(QPV_Pa, 500))) # Les surfaces intégrant l'option NPNRU (à partir de 2017)

PNRU_Pa <- as.data.frame(PNRU_Pa)
PNRU_Pa$surf_buffer500 <- as.numeric(PNRU_Pa$surf_buffer500)
PNRU_Pa$surf_buffer300 <- as.numeric(PNRU_Pa$surf_buffer300)

QPV_Pa <- as.data.frame(QPV_Pa)
QPV_Pa$surf_buffer <- as.numeric(QPV_Pa$surf_buffer)
QPV_Pa$surf_bufferNPNRU <- as.numeric(QPV_Pa$surf_bufferNPNRU)


## Enregistrement des surfaces

P_06 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2006 & PNRU_Pa$date_fin >= 2004,]$surf_buffer500))/1000000
P_07 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2007 & PNRU_Pa$date_fin >= 2005,]$surf_buffer500))/1000000
P_08 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2008 & PNRU_Pa$date_fin >= 2006,]$surf_buffer500))/1000000
P_09 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2009 & PNRU_Pa$date_fin >= 2007,]$surf_buffer500))/1000000
P_10 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2010 & PNRU_Pa$date_fin >= 2008,]$surf_buffer500))/1000000
P_11 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2011 & PNRU_Pa$date_fin >= 2009,]$surf_buffer500))/1000000
P_12 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2012 & PNRU_Pa$date_fin >= 2010,]$surf_buffer500))/1000000
P_13 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2013 & PNRU_Pa$date_fin >= 2011,]$surf_buffer500))/1000000
P_14 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2014 & PNRU_Pa$date_fin >= 2012,]$surf_buffer300))/1000000
P_15 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2015 & PNRU_Pa$date_fin >= 2013,]$surf_buffer300))/1000000
P_16 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2016 & PNRU_Pa$date_fin >= 2014,]$surf_buffer300))/1000000
P_17 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2017 & PNRU_Pa$date_fin >= 2015,]$surf_buffer300))/1000000
P_18 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2018 & PNRU_Pa$date_fin >= 2016,]$surf_buffer300))/1000000
P_19 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2019 & PNRU_Pa$date_fin >= 2017,]$surf_buffer300))/1000000
P_20 <- (sum(PNRU_Pa[PNRU_Pa$date_sign <= 2020 & PNRU_Pa$date_fin >= 2018,]$surf_buffer300))/1000000

Q_15 <- (sum(QPV_Pa$surf_buffer))/1000000
Q_16 <- (sum(QPV_Pa$surf_buffer))/1000000
Q_17 <- (sum(QPV_Pa$surf_bufferNPNRU))/1000000
Q_18 <- (sum(QPV_Pa$surf_bufferNPNRU))/1000000
Q_19 <- (sum(QPV_Pa$surf_bufferNPNRU))/1000000
Q_20 <- (sum(QPV_Pa$surf_bufferNPNRU))/1000000

T_06 <- P_06
T_07 <- P_07
T_08 <- P_08
T_09 <- P_09
T_10 <- P_10
T_11 <- P_11
T_12 <- P_12
T_13 <- P_13
T_14 <- P_14
T_15 <- P_15 + Q_15
T_16 <- P_16 + Q_16
T_17 <- P_17 + Q_17
T_18 <- P_18 + Q_18
T_19 <- P_19 + Q_19
T_20 <- P_20 + Q_20

## Création d'une table synthétique

TVA_Pa <- data.frame(Annee = c(2006:2020),
                  PNRU = c(P_06, P_07, P_08, P_09, P_10, P_11, P_12, P_13, P_14, P_15, P_16, P_17, P_18, P_19, P_20),
                  QPV = c(0,0,0,0,0,0,0,0,0, Q_15, Q_16, Q_17, Q_18, Q_19, Q_20),
                  Total = c(T_06, T_07, T_08, T_09, T_10, T_11, T_12, T_13, T_14, T_15, T_16, T_17, T_18, T_19, T_20))


hist_TVA_Pa <- plot_ly(type = "bar",
                     x=TVA_Pa$Annee, 
                     y = TVA_Pa$PNRU,
                     name = 'Secteurs du PNRU')
      hist_TVA_Pa <- hist_TVA_Pa %>% add_trace(y = TVA_Pa$QPV, name = 'Quartiers prioritaires\ndes politiques\nde la ville') 
      hist_TVA_Pa <- hist_TVA_Pa %>% layout(title = "Surface éligible à la TVA réduite à Paris", xaxis= list(title = 'Années'), yaxis = list(title = 'km2'), barmode = 'stack')
      
      hist_TVA_Pa

5.2.2 Lyon

## Ouverture des bases
PNRU_Ly <- st_read("Output/Lyon/Lyon_TVA.gpkg", layer = "PNRU_Fu", quiet = TRUE)
QPV_Ly <- st_read("Output/Lyon/Lyon_TVA.gpkg", layer = "QPV_Fu", quiet = TRUE)

## Calcul des surfaces
PNRU_Ly$surf_buffer300 <- st_area(st_buffer(PNRU_Ly, 300))
PNRU_Ly$surf_buffer500 <- st_area(st_buffer(PNRU_Ly, 500))
QPV_Ly$surf_buffer <- st_area(st_buffer(QPV_Ly, 300))
QPV_Ly$surf_bufferNPNRU <- ifelse(is.na(QPV_Ly$NPNRU), st_area(st_buffer(QPV_Ly, 300)), st_area(st_buffer(QPV_Ly, 500))) # Les surfaces intégrant l'option NPNRU (à partir de 2017)

PNRU_Ly <- as.data.frame(PNRU_Ly)
PNRU_Ly$surf_buffer500 <- as.numeric(PNRU_Ly$surf_buffer500)
PNRU_Ly$surf_buffer300 <- as.numeric(PNRU_Ly$surf_buffer300)

QPV_Ly <- as.data.frame(QPV_Ly)
QPV_Ly$surf_buffer <- as.numeric(QPV_Ly$surf_buffer)
QPV_Ly$surf_bufferNPNRU <- as.numeric(QPV_Ly$surf_bufferNPNRU)


## Enregistrement des surfaces

P_06 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2006 & PNRU_Ly$date_fin >= 2004,]$surf_buffer500))/1000000
P_07 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2007 & PNRU_Ly$date_fin >= 2005,]$surf_buffer500))/1000000
P_08 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2008 & PNRU_Ly$date_fin >= 2006,]$surf_buffer500))/1000000
P_09 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2009 & PNRU_Ly$date_fin >= 2007,]$surf_buffer500))/1000000
P_10 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2010 & PNRU_Ly$date_fin >= 2008,]$surf_buffer500))/1000000
P_11 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2011 & PNRU_Ly$date_fin >= 2009,]$surf_buffer500))/1000000
P_12 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2012 & PNRU_Ly$date_fin >= 2010,]$surf_buffer500))/1000000
P_13 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2013 & PNRU_Ly$date_fin >= 2011,]$surf_buffer500))/1000000
P_14 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2014 & PNRU_Ly$date_fin >= 2012,]$surf_buffer300))/1000000
P_15 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2015 & PNRU_Ly$date_fin >= 2013,]$surf_buffer300))/1000000
P_16 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2016 & PNRU_Ly$date_fin >= 2014,]$surf_buffer300))/1000000
P_17 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2017 & PNRU_Ly$date_fin >= 2015,]$surf_buffer300))/1000000
P_18 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2018 & PNRU_Ly$date_fin >= 2016,]$surf_buffer300))/1000000
P_19 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2019 & PNRU_Ly$date_fin >= 2017,]$surf_buffer300))/1000000
P_20 <- (sum(PNRU_Ly[PNRU_Ly$date_sign <= 2020 & PNRU_Ly$date_fin >= 2018,]$surf_buffer300))/1000000

Q_15 <- (sum(QPV_Ly$surf_buffer))/1000000
Q_16 <- (sum(QPV_Ly$surf_buffer))/1000000
Q_17 <- (sum(QPV_Ly$surf_bufferNPNRU))/1000000
Q_18 <- (sum(QPV_Ly$surf_bufferNPNRU))/1000000
Q_19 <- (sum(QPV_Ly$surf_bufferNPNRU))/1000000
Q_20 <- (sum(QPV_Ly$surf_bufferNPNRU))/1000000

T_06 <- P_06
T_07 <- P_07
T_08 <- P_08
T_09 <- P_09
T_10 <- P_10
T_11 <- P_11
T_12 <- P_12
T_13 <- P_13
T_14 <- P_14
T_15 <- P_15 + Q_15
T_16 <- P_16 + Q_16
T_17 <- P_17 + Q_17
T_18 <- P_18 + Q_18
T_19 <- P_19 + Q_19
T_20 <- P_20 + Q_20

## Création d'une table synthétique

TVA_Ly <- data.frame(Annee = c(2006:2020),
                  PNRU = c(P_06, P_07, P_08, P_09, P_10, P_11, P_12, P_13, P_14, P_15, P_16, P_17, P_18, P_19, P_20),
                  QPV = c(0,0,0,0,0,0,0,0,0, Q_15, Q_16, Q_17, Q_18, Q_19, Q_20),
                  Total = c(T_06, T_07, T_08, T_09, T_10, T_11, T_12, T_13, T_14, T_15, T_16, T_17, T_18, T_19, T_20))


hist_TVA_Ly <- plot_ly(type = "bar",
                     x=TVA_Ly$Annee, 
                     y = TVA_Ly$PNRU,
                     name = 'Secteurs du PNRU')
      hist_TVA_Ly <- hist_TVA_Ly %>% add_trace(y = TVA_Ly$QPV, name = 'Quartiers prioritaires\ndes politiques\nde la ville') 
      hist_TVA_Ly <- hist_TVA_Ly %>% layout(title = "Surface éligible à la TVA réduite à Lyon", xaxis= list(title = 'Années'), yaxis = list(title = 'km2'), barmode = 'stack')
      
      hist_TVA_Ly

5.2.3 Avignon

## Ouverture des bases
PNRU_Av <- st_read("Output/Avignon/Avignon_TVA.gpkg", layer = "PNRU_Fu", quiet = TRUE)
QPV_Av <- st_read("Output/Avignon/Avignon_TVA.gpkg", layer = "QPV_Fu", quiet = TRUE)

## Calcul des surfaces
PNRU_Av$surf_buffer300 <- st_area(st_buffer(PNRU_Av, 300))
PNRU_Av$surf_buffer500 <- st_area(st_buffer(PNRU_Av, 500))
QPV_Av$surf_buffer <- st_area(st_buffer(QPV_Av, 300))
QPV_Av$surf_bufferNPNRU <- ifelse(is.na(QPV_Av$NPNRU), st_area(st_buffer(QPV_Av, 300)), st_area(st_buffer(QPV_Av, 500))) # Les surfaces intégrant l'option NPNRU (à partir de 2017)

PNRU_Av <- as.data.frame(PNRU_Av)
PNRU_Av$surf_buffer500 <- as.numeric(PNRU_Av$surf_buffer500)
PNRU_Av$surf_buffer300 <- as.numeric(PNRU_Av$surf_buffer300)

QPV_Av <- as.data.frame(QPV_Av)
QPV_Av$surf_buffer <- as.numeric(QPV_Av$surf_buffer)
QPV_Av$surf_bufferNPNRU <- as.numeric(QPV_Av$surf_bufferNPNRU)


## Enregistrement des surfaces

P_06 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2006 & PNRU_Av$date_fin >= 2004,]$surf_buffer500))/1000000
P_07 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2007 & PNRU_Av$date_fin >= 2005,]$surf_buffer500))/1000000
P_08 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2008 & PNRU_Av$date_fin >= 2006,]$surf_buffer500))/1000000
P_09 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2009 & PNRU_Av$date_fin >= 2007,]$surf_buffer500))/1000000
P_10 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2010 & PNRU_Av$date_fin >= 2008,]$surf_buffer500))/1000000
P_11 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2011 & PNRU_Av$date_fin >= 2009,]$surf_buffer500))/1000000
P_12 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2012 & PNRU_Av$date_fin >= 2010,]$surf_buffer500))/1000000
P_13 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2013 & PNRU_Av$date_fin >= 2011,]$surf_buffer500))/1000000
P_14 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2014 & PNRU_Av$date_fin >= 2012,]$surf_buffer300))/1000000
P_15 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2015 & PNRU_Av$date_fin >= 2013,]$surf_buffer300))/1000000
P_16 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2016 & PNRU_Av$date_fin >= 2014,]$surf_buffer300))/1000000
P_17 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2017 & PNRU_Av$date_fin >= 2015,]$surf_buffer300))/1000000
P_18 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2018 & PNRU_Av$date_fin >= 2016,]$surf_buffer300))/1000000
P_19 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2019 & PNRU_Av$date_fin >= 2017,]$surf_buffer300))/1000000
P_20 <- (sum(PNRU_Av[PNRU_Av$date_sign <= 2020 & PNRU_Av$date_fin >= 2018,]$surf_buffer300))/1000000

Q_15 <- (sum(QPV_Av$surf_buffer))/1000000
Q_16 <- (sum(QPV_Av$surf_buffer))/1000000
Q_17 <- (sum(QPV_Av$surf_bufferNPNRU))/1000000
Q_18 <- (sum(QPV_Av$surf_bufferNPNRU))/1000000
Q_19 <- (sum(QPV_Av$surf_bufferNPNRU))/1000000
Q_20 <- (sum(QPV_Av$surf_bufferNPNRU))/1000000

T_06 <- P_06
T_07 <- P_07
T_08 <- P_08
T_09 <- P_09
T_10 <- P_10
T_11 <- P_11
T_12 <- P_12
T_13 <- P_13
T_14 <- P_14
T_15 <- P_15 + Q_15
T_16 <- P_16 + Q_16
T_17 <- P_17 + Q_17
T_18 <- P_18 + Q_18
T_19 <- P_19 + Q_19
T_20 <- P_20 + Q_20

## Création d'une table synthétique

TVA_Av <- data.frame(Annee = c(2006:2020),
                  PNRU = c(P_06, P_07, P_08, P_09, P_10, P_11, P_12, P_13, P_14, P_15, P_16, P_17, P_18, P_19, P_20),
                  QPV = c(0,0,0,0,0,0,0,0,0, Q_15, Q_16, Q_17, Q_18, Q_19, Q_20),
                  Total = c(T_06, T_07, T_08, T_09, T_10, T_11, T_12, T_13, T_14, T_15, T_16, T_17, T_18, T_19, T_20))


hist_TVA_Av <- plot_ly(type = "bar",
                     x=TVA_Av$Annee, 
                     y = TVA_Av$PNRU,
                     name = 'Secteurs du PNRU')
      hist_TVA_Av <- hist_TVA_Av %>% add_trace(y = TVA_Av$QPV, name = 'Quartiers prioritaires\ndes politiques\nde la ville') 
      hist_TVA_Av <- hist_TVA_Av %>% layout(title = "Surface éligible à la TVA réduite à Avignon", xaxis= list(title = 'Années'), yaxis = list(title = 'km2'), barmode = 'stack')
      
      hist_TVA_Av

5.3 Analyse des trajectoires communales

On propose ici une ébauche d’analyse des séquences des trajectoires de communes dans les classements A/B/C et quant à leur éligibilité aux aides fiscales à l’investissement locatif.

On produit un “tapis” par FUA, c’est-à-dire un graphe dans lequel chaque ligne représente la trajectoire d’une commune. Pour la représentation, on rassemble les communes par ressemblance, afin que le résultat soit lisible.

Pour plus d’explications : voir le chapitre sur l’analyse de séquence de Nicolas Robette.

5.3.1 Trajectoires communales dans le classement A/B/C

fuaPa_DC <- read_xlsx("Output/Paris/Dispositifs_Paris.xlsx")
seqPa_ABC <- seqdef(fuaPa_DC[,c(19:35)])

fuaLy_DC <- read_xlsx("Output/Lyon/Dispositifs_Lyon.xlsx")
seqLy_ABC <- seqdef(fuaLy_DC[,c(19:35)])

fuaAv_DC <- read_xlsx("Output/Avignon/Dispositifs_Avignon.xlsx")
seqAv_ABC <- seqdef(fuaAv_DC[,c(19:35)])

seq_ABC <- rbind(seqPa_ABC, seqLy_ABC, seqAv_ABC)
seq_ABC.om <- seqdist(seq_ABC, method = "LCS")
groupPa <- rep("Paris", 1851)
groupLy <- rep("Lyon", 337)
groupAv <- rep("Avignon", 45)
seq_ABC.part <- c(groupPa, groupLy, groupAv)

ordre_ABC <- cmdscale(as.dist(seq_ABC.om), k = 1)

png(file = "fig/Traj_ABC.png",width = 310, height = 200,units = "mm", res = 330)

seqIplot(seq_ABC, group = seq_ABC.part, sortv = ordre_ABC, xtlab = 2003:2019, 
  space = 0, border = NA, yaxis = F, use.layout = T)

dev.off()

Il n’y a pas de tendance univoque dans la façon dont évoluent les zonages. Les situations de stabilité sont majoritaires. Pour les communes en mobilité, cohabitent des trajectoires ascensionnelles et des déclassements. Quelques remarques non exhaustives :

• Aucune commune n’est jamais déclassée en C : les seuls déclassements se font vers la catégorie B2.

• Les déclassements ont été inaugurés par le classement de 2014.

• Les reclassements ne sautent que très rarement une catégorie.

• Le classement des communes du groupe B en 2006 n’a pas pris la même forme sur les différentes FUA (l’intégralité ont été reclassées en B1 sur Avignon ; une majorité en B2 sur Paris).

5.3.2 Trajectoires communales d’éligibilité aux aides à l’investissement locatif (actuel Pinel)

## Paris

### Ouverture
fuaPa_DC <- read_xlsx("Output/Paris/Dispositifs_Paris.xlsx")

### Eligibilité
fuaPa_DC$ELIG_2009 <- ifelse(fuaPa_DC$ZONE_ABC_2009 == "C", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2010 <- ifelse(fuaPa_DC$ZONE_ABC_2010 == "C", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2011 <- ifelse(fuaPa_DC$ZONE_ABC_2011 == "C", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2012 <- ifelse(fuaPa_DC$ZONE_ABC_2012 == "C", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2013 <- ifelse(fuaPa_DC$ZONE_ABC_2013 == "C" | fuaPa_DC$ZONE_ABC_2013 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2014 <- ifelse(fuaPa_DC$ZONE_ABC_2014 == "C" | fuaPa_DC$ZONE_ABC_2014 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2015 <- ifelse(fuaPa_DC$ZONE_ABC_2015 == "C" | fuaPa_DC$ZONE_ABC_2015 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2016 <- ifelse(fuaPa_DC$ZONE_ABC_2016 == "C" | fuaPa_DC$ZONE_ABC_2016 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2017 <- ifelse(fuaPa_DC$ZONE_ABC_2017 == "C" | fuaPa_DC$ZONE_ABC_2017 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2018 <- ifelse(fuaPa_DC$ZONE_ABC_2018 == "C" | fuaPa_DC$ZONE_ABC_2018 == "B2", "Non éligible", "Eligible (zonage)")
fuaPa_DC$ELIG_2019 <- ifelse(fuaPa_DC$ZONE_ABC_2019 == "C" | fuaPa_DC$ZONE_ABC_2019 == "B2", "Non éligible", "Eligible (zonage)")

### Agréments
fuaPa_DC$ELIG_2012[fuaPa_DC$DATE_AGREM_M == "2012"] <- "Eligible (agrément)"

fuaPa_DC$ELIG_2013[fuaPa_DC$DATE_AGREM_P == "2013"] <- "Eligible (agrément)"

fuaPa_DC$ELIG_2014[fuaPa_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaPa_DC$ELIG_2014[fuaPa_DC$DATE_AGREM_P == "2013" & fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaPa_DC$ELIG_2015[fuaPa_DC$DATE_AGREM_P == "2015" | fuaPa_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaPa_DC$ELIG_2015[fuaPa_DC$DATE_AGREM_P == "2013" & fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaPa_DC$ELIG_2016[fuaPa_DC$DATE_AGREM_P == "2016" | fuaPa_DC$DATE_AGREM_P == "2015" | fuaPa_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaPa_DC$ELIG_2016[fuaPa_DC$DATE_AGREM_P == "2013" & fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaPa_DC$ELIG_2017[fuaPa_DC$DATE_AGREM_P == "2017" | fuaPa_DC$DATE_AGREM_P == "2016" | fuaPa_DC$DATE_AGREM_P == "2015" | fuaPa_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaPa_DC$ELIG_2017[fuaPa_DC$DATE_AGREM_P == "2013" & fuaPa_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

seqPa_AFIL <- seqdef(fuaPa_DC[,c(59:69)])


## Lyon

### Ouverture
fuaLy_DC <- read_xlsx("Output/Lyon/Dispositifs_Lyon.xlsx")

### Eligibilité
fuaLy_DC$ELIG_2009 <- ifelse(fuaLy_DC$ZONE_ABC_2009 == "C", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2010 <- ifelse(fuaLy_DC$ZONE_ABC_2010 == "C", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2011 <- ifelse(fuaLy_DC$ZONE_ABC_2011 == "C", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2012 <- ifelse(fuaLy_DC$ZONE_ABC_2012 == "C", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2013 <- ifelse(fuaLy_DC$ZONE_ABC_2013 == "C" | fuaLy_DC$ZONE_ABC_2013 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2014 <- ifelse(fuaLy_DC$ZONE_ABC_2014 == "C" | fuaLy_DC$ZONE_ABC_2014 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2015 <- ifelse(fuaLy_DC$ZONE_ABC_2015 == "C" | fuaLy_DC$ZONE_ABC_2015 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2016 <- ifelse(fuaLy_DC$ZONE_ABC_2016 == "C" | fuaLy_DC$ZONE_ABC_2016 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2017 <- ifelse(fuaLy_DC$ZONE_ABC_2017 == "C" | fuaLy_DC$ZONE_ABC_2017 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2018 <- ifelse(fuaLy_DC$ZONE_ABC_2018 == "C" | fuaLy_DC$ZONE_ABC_2018 == "B2", "Non éligible", "Eligible (zonage)")
fuaLy_DC$ELIG_2019 <- ifelse(fuaLy_DC$ZONE_ABC_2019 == "C" | fuaLy_DC$ZONE_ABC_2019 == "B2", "Non éligible", "Eligible (zonage)")

### Agréments

fuaLy_DC$ELIG_2012[fuaLy_DC$DATE_AGREM_M == "2012"] <- "Eligible (agrément)"

fuaLy_DC$ELIG_2013[fuaLy_DC$DATE_AGREM_P == "2013"] <- "Eligible (agrément)"

fuaLy_DC$ELIG_2014[fuaLy_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaLy_DC$ELIG_2014[fuaLy_DC$DATE_AGREM_P == "2013" & fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaLy_DC$ELIG_2015[fuaLy_DC$DATE_AGREM_P == "2015" | fuaLy_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaLy_DC$ELIG_2015[fuaLy_DC$DATE_AGREM_P == "2013" & fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaLy_DC$ELIG_2016[fuaLy_DC$DATE_AGREM_P == "2016" | fuaLy_DC$DATE_AGREM_P == "2015" | fuaLy_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaLy_DC$ELIG_2016[fuaLy_DC$DATE_AGREM_P == "2013" & fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaLy_DC$ELIG_2017[fuaLy_DC$DATE_AGREM_P == "2017" | fuaLy_DC$DATE_AGREM_P == "2016" | fuaLy_DC$DATE_AGREM_P == "2015" | fuaLy_DC$DATE_AGREM_P == "2014"] <- "Eligible (agrément)"
fuaLy_DC$ELIG_2017[fuaLy_DC$DATE_AGREM_P == "2013" & fuaLy_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

seqLy_AFIL <- seqdef(fuaLy_DC[,c(59:69)])


## Avignon

### Ouverture
fuaAv_DC <- read_xlsx("Output/Avignon/Dispositifs_Avignon.xlsx")

### Eligibilité
fuaAv_DC$ELIG_2009 <- ifelse(fuaAv_DC$ZONE_ABC_2009 == "C", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2010 <- ifelse(fuaAv_DC$ZONE_ABC_2010 == "C", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2011 <- ifelse(fuaAv_DC$ZONE_ABC_2011 == "C", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2012 <- ifelse(fuaAv_DC$ZONE_ABC_2012 == "C", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2013 <- ifelse(fuaAv_DC$ZONE_ABC_2013 == "C" | fuaAv_DC$ZONE_ABC_2013 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2014 <- ifelse(fuaAv_DC$ZONE_ABC_2014 == "C" | fuaAv_DC$ZONE_ABC_2014 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2015 <- ifelse(fuaAv_DC$ZONE_ABC_2015 == "C" | fuaAv_DC$ZONE_ABC_2015 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2016 <- ifelse(fuaAv_DC$ZONE_ABC_2016 == "C" | fuaAv_DC$ZONE_ABC_2016 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2017 <- ifelse(fuaAv_DC$ZONE_ABC_2017 == "C" | fuaAv_DC$ZONE_ABC_2017 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2018 <- ifelse(fuaAv_DC$ZONE_ABC_2018 == "C" | fuaAv_DC$ZONE_ABC_2018 == "B2", "Non éligible", "Eligible (zonage)")
fuaAv_DC$ELIG_2019 <- ifelse(fuaAv_DC$ZONE_ABC_2019 == "C" | fuaAv_DC$ZONE_ABC_2019 == "B2", "Non éligible", "Eligible (zonage)")

### Agréments
fuaAv_DC$ELIG_2013[fuaAv_DC$DATE_AGREM == "2013"] <- "Eligible (agrément)"

fuaAv_DC$ELIG_2014[fuaAv_DC$DATE_AGREM == "2014"] <- "Eligible (agrément)"
fuaAv_DC$ELIG_2014[fuaAv_DC$DATE_AGREM == "2013" & fuaAv_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaAv_DC$ELIG_2015[fuaAv_DC$DATE_AGREM == "2015" | fuaAv_DC$DATE_AGREM == "2014"] <- "Eligible (agrément)"
fuaAv_DC$ELIG_2015[fuaAv_DC$DATE_AGREM == "2013" & fuaAv_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaAv_DC$ELIG_2016[fuaAv_DC$DATE_AGREM == "2016" | fuaAv_DC$DATE_AGREM == "2015" | fuaAv_DC$DATE_AGREM == "2014"] <- "Eligible (agrément)"
fuaAv_DC$ELIG_2016[fuaAv_DC$DATE_AGREM == "2013" & fuaAv_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

fuaAv_DC$ELIG_2017[fuaAv_DC$DATE_AGREM == "2017" | fuaAv_DC$DATE_AGREM == "2016" | fuaAv_DC$DATE_AGREM == "2015" | fuaAv_DC$DATE_AGREM == "2014"] <- "Eligible (agrément)"
fuaAv_DC$ELIG_2017[fuaAv_DC$DATE_AGREM == "2013" & fuaAv_DC$ZONE_ABC_2014 == "B2"] <- "Eligible (agrément)"

seqAv_AFIL <- seqdef(fuaAv_DC[,c(56:66)])


# Assemblage


seq_AFIL <- rbind(seqPa_AFIL, seqLy_AFIL, seqAv_AFIL)
seq_AFIL.om <- seqdist(seq_AFIL, method = "LCS")
groupPa <- rep("Paris", 1851)
groupLy <- rep("Lyon", 337)
groupAv <- rep("Avignon", 45)
seq_AFIL.part <- c(groupPa, groupLy, groupAv)

ordre_AFIL <- cmdscale(as.dist(seq_AFIL.om), k = 1)

png(file = "fig/Traj_AFIL.png",width = 310, height = 200,units = "mm", res = 330)

seqIplot(seq_AFIL, group = seq_AFIL.part, sortv = ordre_AFIL, xtlab = 2009:2019, 
  space = 0, border = NA, yaxis = F, use.layout = T)

dev.off()

Quelques remarques :

• La stabilité prévaut sur Lyon et Avignon, pas sur Paris.

• Le dispositif Duflot, instauré en 2013, a considérablement réduit l’éligibilité sur Paris en excluant les communes de zone B2 ; c’est davantage le reclassement de 2014 qui joue sur Avignon

• Dans les trois FUA, l’agrément accordé en 2013 a parfois précédé un reclassement en 2014 vers la zone B1.

• Les agréments n’ont joué presque aucun rôle sur Paris.

6 Session info

R version 4.1.0 (2021-05-18) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19043)

Matrix products: default

locale: [1] LC_COLLATE=French_France.1252 LC_CTYPE=French_France.1252
[3] LC_MONETARY=French_France.1252 LC_NUMERIC=C
[5] LC_TIME=French_France.1252

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] plotly_4.9.4.1 ggplot2_3.3.5 rgdal_1.5-23 sp_1.4-5
[5] dplyr_1.0.7 sf_1.0-2 cartography_3.0.0 openxlsx_4.2.4
[9] readxl_1.3.1 readr_2.0.1

loaded via a namespace (and not attached): [1] Rcpp_1.0.7 lattice_0.20-44 tidyr_1.1.3 png_0.1-7
[5] class_7.3-19 digest_0.6.27 utf8_1.2.1 R6_2.5.0
[9] cellranger_1.1.0 evaluate_0.14 e1071_1.7-7 httr_1.4.2
[13] highr_0.9 pillar_1.6.1 rlang_0.4.11 lazyeval_0.2.2
[17] rstudioapi_0.13 data.table_1.14.0 rmarkdown_2.9 stringr_1.4.0
[21] htmlwidgets_1.5.3 bit_4.0.4 munsell_0.5.0 proxy_0.4-26
[25] compiler_4.1.0 xfun_0.24 pkgconfig_2.0.3 rgeos_0.5-5
[29] htmltools_0.5.1.1 tidyselect_1.1.1 tibble_3.1.2 codetools_0.2-18
[33] viridisLite_0.4.0 fansi_0.5.0 crayon_1.4.1 tzdb_0.1.2
[37] withr_2.4.2 grid_4.1.0 jsonlite_1.7.2 gtable_0.3.0
[41] lifecycle_1.0.0 DBI_1.1.1 magrittr_2.0.1 units_0.7-2
[45] scales_1.1.1 KernSmooth_2.23-20 zip_2.2.0 cli_2.5.0
[49] stringi_1.6.1 vroom_1.5.4 ellipsis_0.3.2 generics_0.1.0
[53] vctrs_0.3.8 tools_4.1.0 bit64_4.0.5 glue_1.4.2
[57] purrr_0.3.4 crosstalk_1.1.1 hms_1.1.0 parallel_4.1.0
[61] yaml_2.2.1 colorspace_2.0-1 classInt_0.4-3 knitr_1.33