Allez, un petit billet léger pour bien commencer les vacances de Noël. Toujours sur le projet R de la formation en Data Science pour l’Actuariat, Cyril Legrand a proposé de fusionner deux bases, une sur le revenu moyen par foyer (fiscal) par commune, et une sur le nom de licenciés dans les clubs sportifs. Il est faire un peu de retraitement des codes INSEE pour la jointure, car par exemple Marseille est codée sur les arrondissements dans une des bases, sur la ville dans l’autre.

library(stringr)
library(dplyr)

Les données sont téléchargeables sur http://data.gouv.fr/ (j’ai laissé tous les codes, mais je mettrais juste la base finale en ligne)

a <- read.csv("data/impots_par_commune.csv", sep=";", encoding="UTF-8", colClasses=c("factor","factor","character","factor","numeric","numeric","numeric"),na.strings="n.d.")

On élimine alors les stats par tranche d’imposition

a <- a[a$tranche == "Total",]

Puis on crée à la main le code INSEE, formaté sur 5 caractères

a$code_insee <- as.factor(paste(str_sub(a$departement,1,2), a$commune, sep=""))

Pour notre études, les DOM et les TOM (codes 971 et 972) ainsi que les codes ‘autres pays’ (B31) ne seront pas exploités

a <- a[, c("code_insee", "departement", "foyers", "revenu_fisc_ref")]

Si on veut aller plus loin, on peut aussi géolocaliser les communes (voir si on joue plus aux sport d’extérieur dans le sud que dans le nord, si on veut)

b <- read.csv("data/Codes-INSEE-communes-geolocalisees.csv", sep=",", encoding="latin1", colClasses=c("factor","character","integer","factor","numeric","numeric","integer","numeric"))

Là encore, il nous faut créer le code INSEE

b[,"Insee"] <- as.factor(gsub(" ", "0", sprintf("%5s", as.character(b$Insee))))
b <- b[, c("Insee", "Altitude", "longitude_radian", "latitude_radian", "surface")]

Enfin, utilise le fichier des licences sportives, par communes

c <- read.csv("data/licences_2012.csv", sep=";", encoding="UTF-8", colClasses = c("factor","character","factor",rep("integer",63)), na.strings=".")
c <- c[, c(seq(1,14), 24, seq(37,47), 57)]

On doit retraiter les villes avec des arrondissement, Marseille, Lyon et Paris. On commence par Marseille

a_1 <- a[as.numeric(as.character(a$code_insee)) > 13300 & as.numeric(as.character(a$code_insee)) < 13399, ]
a_1 <- a_1[! is.na(a_1$code_insee), ]
a_2 <- data.frame("13055", "130", sum(a_1$foyers),  sum(a_1$revenu_fisc_ref))
colnames(a_2) <- colnames(a)
a <- rbind(a, a_2)

puis Lyon

a_1 <- a[as.numeric(as.character(a$code_insee)) > 69300 & as.numeric(as.character(a$code_insee)) < 69399, ]
a_1 <- a_1[! is.na(a_1$code_insee), ]
a_2 <- data.frame("69123", "690", sum(a_1$foyers),  sum(a_1$revenu_fisc_ref))
colnames(a_2) <- colnames(a)
a <- rbind(a, a_2)

et on finit avec Paris

a_1 <- a[as.numeric(as.character(a$code_insee)) > 75000 & as.numeric(as.character(a$code_insee)) < 75999, ]
a_1 <- a_1[! is.na(a_1$code_insee), ]
a_2 <- data.frame("75056", "750", sum(a_1$foyers),  sum(a_1$revenu_fisc_ref))
colnames(a_2) <- colnames(a)
a <- rbind(a, a_2)

par exemple pour Paris, on a

a[a$code_insee == "75056", ]
code_insee departement  foyers revenu_fisc_ref
[,16]       75056       750 1420941     56943735807

soit un total de 57 milliards d’euros, pour 1,4 millions de foyers. On fusionne alors les bases

d <- inner_join(c, a, by=c("cog2" = "code_insee"))
d <- inner_join(d, b, by=c("cog2" = "Insee"))

ON peut sauver les bases dans un gros fichier,

save(d, file="data/d.RData")

Maintenant on peut commencer à visialiser des variables. On charge les packages dont on aura besoin

library(magrittr)
library(stringr)
library(dplyr)
library(ggplot2)

On peut charger les données avec

load("http://freakonometrics.free.fr/d.RData")

On peut maintenant se lancer

d_rev_dep <- d[! is.na(d$revenu_fisc_ref) & ! is.na(d$foyers), c("revenu_fisc_ref", "foyers", "departement")]
d_rev_dep <- aggregate(d_rev_dep[,c("revenu_fisc_ref", "foyers")], FUN=sum, by=list(str_sub(d_rev_dep$departement,1,2)))
colnames(d_rev_dep) <- c("departement", "revenu_fisc_ref", "foyers")
d_rev_dep["rev_ref_moy"] <- d_rev_dep$revenu_fisc_ref / d_rev_dep$foyers
d_rev_dep <- d_rev_dep[, c("rev_ref_moy", "departement")]
d_rev_dep <- d_rev_dep[ do.call(order, c(d_rev_dep, decreasing=TRUE)), ]

Histoire d’avoir une analyse un peu robuste, on élimine les communes à faible population

d <- d[d$pop_2010 > 1000,]
d["rev_ref_moy"] <- d$revenu_fisc_ref / d$foyers
d["tx_licences"] <- d$l_2012 / d$pop_2010

on a pour les données de revenu

d_revenus <- unique(d[! is.na(d$rev_ref_moy), c("rev_ref_moy", "LIBELLE", "departement", "longitude_radian", "latitude_radian")])
d_revenus["long"] <- d_revenus$longitude_radian / pi * 180
d_revenus["lat"] <- d_revenus$latitude_radian / pi * 180
d_revenus <- d_revenus[ do.call(order, c(d_revenus, decreasing=TRUE)), ]

pour les données de sport

d_sport <- d[! is.na(d$l_2012), c("cog2", "LIBELLE", "revenu_fisc_ref", "pop_2010", "foyers", "l_2012")]
d_sport <- aggregate(d_sport$l_2012, FUN=sum, by=list(d_sport$cog2, d_sport$LIBELLE, d_sport$revenu_fisc_ref, d_sport$pop_2010, d_sport$foyers))
colnames(d_sport) <- c("cog2","LIBELLE", "revenu_fisc_ref", "pop_2010", "foyers", "l_2012")
d_sport["rev_ref_moy"] <- d_sport$revenu_fisc_ref / d_sport$foyers
d_sport["tx_licences"] <- d_sport$l_2012 / d_sport$pop_2010
d_sport.first <- d_sport[, c("tx_licences", "LIBELLE")]
d_sport.first <- d_sport.first[ do.call(order, c(d_sport.first, decreasing=TRUE)), ]
d_sport.fit <- lm(formula="tx_licences ~ rev_ref_moy", data=d_sport,weights=pop_2010)

On peut maintenant faire un dessin

g <- ggplot(d_sport.fit, aes(rev_ref_moy, tx_licences)) + geom_point() + geom_smooth()
g <- g + labs(title="Tous sports confondus", x="Revenu moyen", y="Taux de licenciés")
g <- g + theme(plot.title=element_text(size=12, face="bold", vjust=2, color="blue"))
g <- g + xlim(c(10000, 80000)) + ylim(c(0, 0.8))
plot(g)

mais on peut aussi mettre des poids, correspondant à la taille des communes

pop_2010 <- d_sport$pop_2010

soit

g <- ggplot(d_sport.fit, aes(rev_ref_moy, tx_licences, weight=pop_2010)) + geom_point() + geom_smooth()
g <- g + labs(title="Tous sports confondus", x="Revenu moyen", y="Taux de licenciés")
g <- g + theme(plot.title=element_text(size=12, face="bold", vjust=2, color="blue"))
g <- g + xlim(c(10000, 80000)) + ylim(c(0, 0.8))
plot(g)

x

Pour regarder par sport, on peut utiliser la fonction suivante

trace_graph <- function(nom, num_fed, ymax) {
extract <- unique(d[! is.na(d$tx_licences) & d$fed_2012 == num_fed, c("tx_licences", "LIBELLE", "rev_ref_moy")])
g <- ggplot(extract, aes(rev_ref_moy, tx_licences)) + geom_point() + geom_smooth()
g <- g + labs(title=nom, x="Revenu moyen", y="Taux de licenciés")
g <- g + theme(plot.title=element_text(size=12, face="bold", vjust=2, color="blue"))
g <- g + xlim(c(10000, 80000)) + ylim(c(0, ymax))
plot(g)
}

soit, pour le football

trace_graph_2("football", "111", 0.15)

ou dans la version avec des poids

trace_graph_w <- function(nom, num_fed, ymax) {
extract <- unique(d[! is.na(d$tx_licences) & d$fed_2012 == num_fed, c("tx_licences", "LIBELLE", "rev_ref_moy","pop_2010")])
g <- ggplot(extract, aes(rev_ref_moy, tx_licences,weight=pop_2010)) + geom_point() + geom_smooth()
g <- g + labs(title=nom, x="Revenu moyen", y="Taux de licenciés")
g <- g + theme(plot.title=element_text(size=12, face="bold", vjust=2, color="blue"))
g <- g + xlim(c(10000, 80000)) + ylim(c(0, ymax))
plot(g)
}

donc pour le football (toujours)

trace_graph_w("football", "111", 0.15)

A titre de comparaison, on peut regarder le tennis

trace_graph("tennis", "123", 0.2)

ou, dans la version avec des poids

trace_graph_w("tennis", "123", 0.2)

Pour l’équitation,

trace_graph("équitation", "109", 0.1)

ou, pour la version avec des poids

trace_graph_w("équitation", "109", 0.1)

Et pour le golf

trace_graph("golf", "132", 0.06)

ou pour la version avec des poids

trace_graph_w("golf", "132", 0.06)

C’est cliché, non ?

---

---