Ce notebook à vocation éducative présente une visualisation des données libres “Immeubles protégés au titre des Monuments Historiques”. Créé par Paul Amat, http://amat-design.com
La particularité de ce notebook est l’usage de variables transformées qui n’existent pas telles quelles dans les données sources, donnant lieu à une nouvelle grille de lecture. Pour cela, un algorithme basique de canonisation et classification permet de transformer des variables à texte libre en facteurs, permettant ainsi d’effectuer des statistiques sur ces derniers.
Nom : Immeubles protégés au titre des Monuments Historiques
Producteur : Ministère de la Culture, Médiathèque du patrimoine et de la photographie https://www.data.gouv.fr/fr/datasets/immeubles-proteges-au-titre-des-monuments-historiques-2/
Mise à jour : 23 juillet 2020
Licence : Ouverte / Open Licence version 2.0 https://www.etalab.gouv.fr/wp-content/uploads/2014/05/Licence_Ouverte.pdf
L’usage de ces données ne revêt ni caractère officiel à la réutilisation de l’information, ni quelconque reconnaissance ou caution par le producteur.
library(readr)
monu <- read.csv("/cloud/project/liste-des-immeubles-proteges-au-titre-des-monuments-historiques.csv", sep=";")
summary(monu)
## commune code_departement dmaj insee
## Length:45907 Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## region departement commune_1 appellation_courante
## Length:45907 Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## adresse_1 siecle date_de_protection
## Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## precision_sur_la_protection auteur statut
## Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## description historique affectataire adresse
## Length:45907 Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## ancienne_region reference contact longitude
## Length:45907 Length:45907 Length:45907 Length:45907
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## latitude coordonnees
## Min. : -21.4 Length:45907
## 1st Qu.: 45.0 Class :character
## Median : 47.2 Mode :character
## Mean : 91.6
## 3rd Qu.: 48.6
## Max. :1617084.0
## NA's :10217
length(which(monu[,"appellation_courante"] == ""))
## [1] 0
length(which(monu[,"region"] == ""))
## [1] 0
length(which(monu[,"siecle"] == ""))
## [1] 6806
t <- which(monu[,"siecle"] == "")
monu <- monu[-t,]
length(which(monu[,"siecle"] == ""))
## [1] 0
monu[,"region"] <- factor(monu[,"region"])
monu[,"siecle"] <- factor(monu[,"siecle"])
summary(monu[,c("appellation_courante", "region", "siecle")])
## appellation_courante region siecle
## Length:39101 Nouvelle-Aquitaine : 5824 16e siècle : 2470
## Class :character Occitanie : 4545 18e siècle : 2126
## Mode :character Auvergne-Rhône-Alpes : 4235 17e siècle : 1880
## Grand Est : 3712 15e siècle : 1502
## Bourgogne-Franche-Comté: 3202 12e siècle : 1408
## Île-de-France : 3058 Néolithique: 1142
## (Other) :14525 (Other) :28573
Pour récupérer la typologie du lieu, vecteur contenant le premier mot de l’appellation courante.
appe <- c()
t <- as.vector(monu[,"appellation_courante"])
for (i in 1:length(t)) {
appe <- c(appe, stringr::str_extract(t[i], '\\w*'))
}
Pour récupérer le siècle le plus ancien, vecteur contenant le premier siècle de construction.
if (!require(stringr)) install.packages("stringr")
## Loading required package: stringr
library(stringr)
siec <- c()
t <- as.vector(as.character(monu$siecle))
for (i in 1:length(t)) {
x <- c()
if (str_detect(t[i], "Age du fer")) {
x <- "Age du fer"
siec <- c(siec, x)
} else {
if (str_detect(t[i], ";")) {
index <- unlist(gregexpr(';', t[i]))[1]
x <- str_sub(t[i], start = 1L, end = index-1)
} else {
x <- t[i]
}
if (str_detect(x, "[A-z]") == F) {
x <- t[i]
}
if (str_detect(x, "[0-9]") == F) {
siec <- c(siec, x)
} else {
x <- str_extract(x, "[0-9]+e siècle(?!abc)|[0-9]+è siècle(?!abc)|[0-9]+er siècle(?!abc)")
x <- str_extract(x, "[0-9]+")
siec <- c(siec, x)
}
}
}
t[which(is.na(siec))]
## [1] "Début 14ème et 2ème moitié du 17ème siécle (église);début 18ème siécle (cloître);19e siècle"
## [2] "15e;16e;17e;18e"
Regroupement des siècles
Source : https://www.universalis.fr/encyclopedie/europe-prehistoire-et-protohistoire/
t <- which(is.na(siec))
siec[t] <- "15"
t <- which(str_detect(siec, "Paléolithique|Néolithique|Mésolithique|Préhistoire"))
siec[t] <- "Pré"
t <- which(str_detect(siec, "bronze|Chalcolithique|fer|Protohistoire"))
siec[t] <- "Proto"
t <- which(str_detect(siec, "Gallo|gallo|Romain|romain|Empire|Antiquité"))
siec[t] <- "Ant"
t <- which(str_detect(siec, "Moyen Age|Moyen-Age|moyen Age"))
siec[t] <- "10"
t <- which(str_detect(siec, "Temps modernes"))
siec[t] <- "10"
t <- which(str_detect(siec, "XVI"))
siec[t] <- "16"
t <- which(str_detect(siec, "XIV"))
siec[t] <- "14"
unique(siec)
## [1] "18" "16" "15" "19" "12" "13" "17" "11" "14"
## [10] "Proto" "Ant" "Pré" "20" "3" "10" "1" "6" "2"
## [19] "9" "4" "7" "5" "8"
Création d’un data frame de travail
d <- data.frame(regi = factor(as.vector(monu[,"region"])), appe, siec)
summary(d)
## regi appe siec
## Nouvelle-Aquitaine : 5824 Length:39101 Length:39101
## Occitanie : 4545 Class :character Class :character
## Auvergne-Rhône-Alpes : 4235 Mode :character Mode :character
## Grand Est : 3712
## Bourgogne-Franche-Comté: 3202
## Île-de-France : 3058
## (Other) :14525
Décision aléatoire pour séparer les catégories redondantes
d$regi <- as.character(d$regi)
for (i in 1:length(d$regi)) {
if(d$regi[i] == "Auvergne-Rhône-Alpes;Bourgogne-Franche-Comté") {
t <- runif(1, 1, 2)
if (t >= 1.5) {
d$regi[i] <- "Auvergne-Rhône-Alpes"
} else if (t < 1.5) {
d$regi[i] <- "Bourgogne-Franche-Comté"
}
}
}
head(levels(factor(d$appe)), 40)
## [1] "" "80" "Abattoir" "Abbatiale"
## [5] "abbaye" "Abbaye" "abri" "Abri"
## [9] "abris" "Abris" "Académie" "Aérium"
## [13] "Aérodrome" "Aérogare" "Affleurements" "agglomération"
## [17] "Aiguade" "Aiguille" "Aimé" "Aître"
## [21] "Alambic" "Alignement" "Alignements" "Allée"
## [25] "Allées" "Amphithéatre" "Amphithéâtre" "ancien"
## [29] "Ancien" "Ancienn" "ancienne" "Ancienne"
## [33] "Anciennes" "Anciens" "Anicenne" "Anneau"
## [37] "Antique" "Apothicairerie" "Aqueduc" "Arc"
Supprimer les valeurs incompréhensibles
t <- c("", "Ancien", "Ancienne", "Anciennes", "Anciens", "Les", "Sous", "Sept", "Vieille", "Vieux", "Deux", "Grand", "Groupe", "L", "Le", "80", "Vingt", "Six", "Petit", "Petite", "Dix", "Grande", "Haut", "Nouveau", "Tête", "Trois", "Premier", "Quatre", "Grands", "Grandes", "La", "P", "Cinq")
a <- which(d$appe %in% t)
d <- d[-a, ]
# levels(factor(d$appe))
Canonisation des appellations écrites au pluriel
d$appe <- as.character(d$appe)
for (i in 1:length(d$appe)) {
if (grepl("s", d$appe[i], fixed = TRUE)) {
if(substr(d$appe[i], 1, nchar(d$appe[i])-1) %in% d$appe) {
d$appe[i] <- substr(d$appe[i], 1, nchar(d$appe[i])-1)
}
}
}
for (i in 1:length(d$appe)) {
if (grepl("x", d$appe[i], fixed = TRUE)) {
if(substr(d$appe[i], 1, nchar(d$appe[i])-1) %in% d$appe) {
d$appe[i] <- substr(d$appe[i], 1, nchar(d$appe[i])-1)
}
}
}
Retrait des accents des appellations
unaccent <- function(text) {
text <- gsub("['`^~\"]", " ", text)
text <- iconv(text, to="ASCII//TRANSLIT//IGNORE")
text <- gsub("['`^~\"]", "", text)
return(text)
}
d$appe <- unaccent(d$appe)
Appellations en majuscules
d$appe <- as.character(d$appe)
if (!require(stringr)) install.packages("stringr")
library(stringr)
for (i in 1:length(d$appe)) {
d$appe[i] <- str_to_sentence(d$appe[i])
}
Ecraser les doublons
t <- which(d$appe == "Roche")
d[t, "appe"] <- "Rocher"
t <- which(d$appe == "Pierre")
d[t, "appe"] <- "Rocher"
t <- which(d$appe == "Ilot")
d[t, "appe"] <- "Ile"
t <- which(d$appe == "Ilet")
d[t, "appe"] <- "Ile"
t <- which(d$appe == "Bastide")
d[t, "appe"] <- "Bastion"
t <- which(d$appe == "Tourelle")
d[t, "appe"] <- "Tour"
t <- which(d$appe == "Parcelle")
d[t, "appe"] <- "Terrain"
d$appe <- factor(d$appe)
# levels(d$appe)
Catégorisation alphabétique pour faceting
alph <- c()
for (i in 1:length(d$appe)) {
alph <- c(alph, substr(d$appe[i], 1, 1))
}
d <- data.frame(d, "alph" = factor(alph))
Tri
d$siec <- factor(d$siec)
d$siec <- factor(d$siec, levels=c("Pré", "Proto", "Ant", 1:20))
d <- d[order(d$siec,decreasing = F),]
if (!require(ggplot2)) install.packages("ggplot2")
## Loading required package: ggplot2
library(ggplot2)
ggplot(d, aes(siec, regi, appe, color = regi)) +
geom_count() +
scale_x_discrete(name = "Période / Siècle", position="top") +
scale_y_discrete(name = "Région") +
scale_color_discrete(guide = "none") +
labs(title = "Répartition des monuments protégés par période \nhistorique et régions", subtitle = paste("Source : Open data, Ministère de la Culture, Médiathèque \ndu patrimoine et de la photographie, maj 23 juillet 2020 \nN = ", nrow(d), sep = ""), caption = "Pré: Préhistoire, Proto: Protohistoire, Ant: Antiquité \nCréé par Paul Amat, amat-design.com") +
theme_minimal()
f <- 100
s <- data.frame(table(d$appe))
t <- which(s$Freq < f)
t <- as.vector(s$Var1[t])
ign <- which(d$appe %in% t)
d2 <- d[-ign,]
ggplot(d2, aes(siec, appe, color = siec)) +
geom_count() +
scale_x_discrete(name = "Période / Siècle", position="top") +
scale_y_discrete(name = "Appellation") +
scale_color_discrete(guide = "none") +
labs(title = "Répartition des monuments protégés par période historique et appellation", subtitle = paste("Source : Open data, Ministère de la Culture, Médiathèque \ndu patrimoine et de la photographie, maj 23 juillet 2020 \nLes appellations dont la fréquence est inférieure à ", f, " sont ignorées (soit ", length(unique(d$appe[ign])), ") \nN = ", nrow(d2), sep = ""), caption = "Pré: Préhistoire, Proto: Protohistoire, Ant: Antiquité \nCréé par Paul Amat, amat-design.com") +
theme_minimal()
Appellations ignorées
sort(unique(d[ign,]$appe))
## [1] Abattoir Abbatiale Abri Academie
## [5] Aerium Aerodrome Aerogare Affleurements
## [9] Agglomeration Aiguade Aiguille Aime
## [13] Aitre Alambic Alignement Allee
## [17] Amphitheatre Ancien Ancienn Ancienne
## [21] Anicenne Anneau Antique Apothicairerie
## [25] Aqueduc Arc Arceau Arche
## [29] Ardoisieres Arenes Arsenal Ascenseur
## [33] Asile Atelier Atrium Auberge
## [37] Auditoire Aumonerie Autel Autogare
## [41] Avant Aven Aviatic Bac
## [45] Bailliage Bain Balancier Balise
## [49] Banc Banque Baptistere Bar
## [53] Baraque Baraquement Barbacane Barrage
## [57] Barriere Bas Basilique Bassin
## [61] Bastion Batiment Batterie Baumes
## [65] Becquet Beffroi Beguinage Belvedere
## [69] Bergerie Bibliotheque Bloc Blockhaus
## [73] Borie Borne Boucherie Bouillon
## [77] Boulangerie Boulevards Bourgade Bourloire
## [81] Bourse Boutique Brasserie Briquetages
## [85] Briqueterie Bungalow Bureau Butte
## [89] Buvette Cabane Caborde Cachot
## [93] Cadran Cafe Cairn Caisse
## [97] Cale Camp Campagne Canal
## [101] Canaux Capitainerie Carillon Carmel
## [105] Carreau Carriere Casa Cascade
## [109] Caserne Casino Castel Castelet
## [113] Castellaras Castellas Castello Castellum
## [117] Castillet Castrum Cathedrale Cave
## [121] Caverne Cavites Celle Cellier
## [125] Cenotaphe Cense Central Centrale
## [129] Centre Ceramic Cercle Chai
## [133] Chalet Chambre Chambrerie Champ
## [137] Chantiers Chantrerie Chapellerie Chapiteau
## [141] Chapitre Charcuterie Chartreuse Chatelet
## [145] Chaufferie Chaumiere Chaussee Chemin
## [149] Cheminee Chevalement Chibotte Chocolaterie
## [153] Cimenterie Cinema Cippe Circuit
## [157] Cirque Citadelle Cite Citerne
## [161] Clairiere Clinique Clocher Cloitre
## [165] Clos Closerie Clown Club
## [169] Cluzeau College Collegiale Colline
## [173] Colombier Colonie Colonne Commanderie
## [177] Communication Comptoir Confiserie Construction
## [181] Corderie Corps Cote Cour
## [185] Courees Cremerie Cristallerie Cromlech
## [189] Crucifix Crypte Cuivrerie Cure
## [193] Debit Demeure Dependance Depot
## [197] Deuxieme Digue Direction Dispensaire
## [201] Distillerie Donjon Double Doyenne
## [205] Eaux Echauguette Echelle Ecluse
## [209] Ecole Ecurie Edicule Edifice
## [213] Egout Element Emetteur Enclos
## [217] Encuvement Enfeu Enseigne Entonnoir
## [221] Entree Entrepot Eolienne Epanchoir
## [225] Eperon Epicerie Ermitage Escalier
## [229] Espace Etablissement Eveche Externat
## [233] Fabrique Faculte Faiencerie Faisanderie
## [237] Falaise Familistere Fanal Fanum
## [241] Faubourg Feculerie Fermette Feu
## [245] Figure Filature Fleuristerie Folie
## [249] Fondation Fonderie Forge Forme
## [253] Forteresse Fortification Fortin Forum
## [257] Fosse Fouilles Four Foyer
## [261] Fragment Funiculaire Fut Galerie
## [265] Garage Gare Gendarmerie Gentilhommiere
## [269] Gisement Gite Glaciere Grabatoire
## [273] Graduation Graineterie Grange Gravures
## [277] Grenier Grille Grosse Grues
## [281] Gymnase Habitat Habitation Hameau
## [285] Hangar Haras Hemicycle Hippodrome
## [289] Horloge Horlogerie Hospice Hostellerie
## [293] Hotellerie Houilleres Huilerie Huit
## [297] Hypocauste Hypogee Ile Imagerie
## [301] Imprimerie Infrastructures Inscription Institut
## [305] Institution Internat Jardin Jetee
## [309] Jeu Jumenterie Justice Kiosque
## [313] Klockhuis Kneighley Laboratoire Lanterne
## [317] Lavatory Lavoir Lazarets Lec
## [321] Lech Leproserie Librairie Lieu
## [325] Ligne Lion Livree Locature
## [329] Loge Logements Longere Lycee
## [333] Machine Magasin Mairie Maisonnette
## [337] Majestic Maladrerie Malouiniere Manecanterie
## [341] Manege Manufacture Marchand Marche
## [345] Maregraphe Mas Mausolee Megalithe
## [349] Memorial Mesure Metairie Metropolitain
## [353] Mill Mine Minoterie Mire
## [357] Mobilier Monastere Monnaie Mont
## [361] Montjoie Mosaique Mosquee Moutier
## [365] Mur Muraille Musee Museum
## [369] Museumotel Naval Necropole Niche
## [373] Noria Nouveau Nouvelle Nymphee
## [377] Obelisque Observatoire Odeon Office
## [381] Onze Opera Oppidum Orangeraie
## [385] Oratoire Orphelinat Ossuaire Ostel
## [389] Ouvrage Palais Palazzu Papeterie
## [393] Parc Partie Passage Passerelle
## [397] Patisserie Patrimoine Pavillon Pensionnat
## [401] Pergola Perrier Petites Petroglyphes
## [405] Phare Pharmacie Pigeonnier Pile
## [409] Pilori Piscine Place Plage
## [413] Plan Plaques Plate Plateau
## [417] Point Poissonnerie Polissoir Ponti
## [421] Porcelainerie Porche Port Portail
## [425] Portion Portique Poste Poterie
## [429] Poudriere Prefecture Presbytere Presqu
## [433] Pressoir Prestriere Prevote Prise
## [437] Prison Promenade Promontoire Propriete
## [441] Pseudo Puits Pyramide Quadrilatere
## [445] Quai Quartier Raffinerie Rampe
## [449] Recette Redoute Reduit Refectoire
## [453] Refuge Regina Relais Remise
## [457] Rempart Rendez Replique Reposoir
## [461] Reseau Reservoir Residence Restaurant
## [465] Retable Retranchement Reve Riviera
## [469] Rocher Roseraie Rotonde Rucher
## [473] Sacristie Saint Sainte Salle
## [477] Sanatorium Sanctuaire Sarcophage Saumoduc
## [481] Savonnerie Scierie Sculptures Secherie
## [485] Sechoir Second Section Seigneurie
## [489] Seminaire Sepulture Serre Service
## [493] Siege Silo Siphon Slip
## [497] Societe Socle Sol Sommet
## [501] Sondages Sorbonne Soufflerie Source
## [505] Souterrain Sporting Square Stade
## [509] Station Statue Stele Structure
## [513] Subdivision Substructions Sucrerie Suite
## [517] Synagogue Systeme Table Taillerie
## [521] Tannerie Taurobole Teinturerie Telegraphe
## [525] Telepherique Tennis Terrain Terrasse
## [529] Tertre Thermes Tir Tissage
## [533] Tombe Tombeau Tournerie Treize
## [537] Tresorerie Treuil Tribunal Tribunes
## [541] Troisieme Troncon Tuilerie Tumuli
## [545] Tumulus Tunnel Unite Universite
## [549] Usine Vasque Vendangeoir Vermicellerie
## [553] Verrerie Via Viaduc Vice
## [557] Vicus Vieil Vieilles Vierge
## [561] Village Ville Vivier Voie
## [565] Zone
## 603 Levels: Abattoir Abbatiale Abbaye Abri Academie Aerium ... Zone