1 Introduction

Pour ce projet nous nous intéressons aux données issues du site https://data.cityofchicago.org/. Ces données sont en libre accès et sont fournies par la ville de Chicago. Dans la suite du projet, sauf en cas de mention spéciale, toutes nos données sont issues de ce site.

L’idée que nous avons eu pour ce projet serait d’affirmer (ou d’infirmer) les stéréotypes présents dans la société avec l’exemple de la ville de Chicago. Par exemple, est-ce dans les quartiers populaires que l’on a un taux de criminalité plus élevé.

La problématique à laquelle nous allons tenter de répondre dans ce projet est donc :

Avons-nous des facteurs externes pouvant expliquer la criminalité à Chicago ?

Nous allons donc dans un premier temps faire une analyse de données temporelles, plus précisément sans prendre en compte des facteurs externes pour déterminer si l’on peut en tirer quelques conclusions.

Puis, nous prendrons en compte l’aspect spatial avec une analyse de données structurelles en prenant en compte la criminalité selon la commune. Il s’agira d’une analyse de données structurelles car nous créerons notre propre matrice statistique incluant des facteurs externes que nous montrerons plus tard.

Nous tenons à préciser que nous sélectionnerons des variables explicatives sans nous-mêmes chercher des causes et conséquence. Ce travail appartient à l’expert métier et non pas à nous.

2 Analyse de données temporelles

2.1 Visualisation de nos données

Les données sur lesquelles nous allons travailler dans cette partie recensent la criminalité entre 2001 et 2019.

#nos données
crimes2001 <- read.csv2("data/raw/crimes.csv", sep = ",")
library(knitr); library(kableExtra)
kable(head(crimes2001[,-1]), row.names = F) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Date	Primary.Type	Description	Location.Description	Arrest	Domestic	Beat	District	Ward	Community.Area	Year
03/18/2015 07:44:00 PM	BATTERY	AGGRAVATED: HANDGUN	STREET	false	false	1111	11	28	25	2015
03/18/2015 11:00:00 PM	OTHER OFFENSE	PAROLE VIOLATION	STREET	true	false	725	7	15	67	2015
03/18/2015 10:45:00 PM	BATTERY	DOMESTIC BATTERY SIMPLE	APARTMENT	false	true	222	2	4	39	2015
03/18/2015 10:30:00 PM	BATTERY	SIMPLE	APARTMENT	false	false	225	2	3	40	2015
03/18/2015 09:00:00 PM	ROBBERY	ARMED: HANDGUN	SIDEWALK	false	false	1113	11	28	25	2015
03/18/2015 10:00:00 PM	BATTERY	SIMPLE	APARTMENT	false	false	223	2	4	39	2015

Nous représentons ici le nombre de crimes survenus à Chicago. Nous avons obtenu ce graphe en nous inspirant notamment des cours de M. Christophe Dumora. Nous avons choisi de définir une fonction my_dygraph afin d’afficher un dygraph spécifique à un type de crime défini (ou tous les types de crimes) ce qui nous évite d’écrire une dizaine de ligne de code identique plusieurs fois (à un data.frame près).

library(xts); library(dygraphs); library(stringr)

#nb_crimes_pardate <- table(as.Date(crimes2001$Date, format="%d/%m/%Y"))
#nb_crimes_pardate <- as.data.frame(nb_crimes_pardate)
#write.csv(nb_crimes_pardate, "data/processed/nb_crime_par_date_2001_2019.csv", row.names = F)

#fonction pour afficher un dygraph avec le pic par année
my_dygraph <- function(data, title){
  # data must be a table(...)
  data <- as.data.frame(data)
  rownames(data) <- data$Var1
  colnames(data) <- c("Date", "Nombre de crimes")
  
  library(xts)
  data <- as.xts(data)
  
  library(stringr)
  nb_year <- unique(str_sub(data$Date,1,4))
  crimes_max <- c()
  date_max <- c()
  for (i in 1:length(nb_year)){
    tab <- data[which(str_sub(data$Date,1,4)==nb_year[i]),]
    pardate <- max(tab[,2])
    ind <- which.max(tab[,2])
    ma_x <- tab[ind,1]
    crimes_max <- c(crimes_max, pardate)
    date_max <- c(date_max,ma_x)
  }
  
  library(dygraphs)
  min_val <- as.numeric(min(data$`Nombre de crimes`))
  max_val <- as.numeric(max(data$`Nombre de crimes`))
  
  dy <- dygraph(data, main=title, width="100%", height=500) %>%
    dyRangeSelector(strokeColor="darkgreen", fillColor="darkgreen") %>%
    dyAxis("y", label="nombre (compteur)", 
           valueRange=c(min_val-2*(min_val+1),
                        max_val+(min_val+1)))
  for (i in 1:length(date_max)){
    dy <- dy %>%
      dyEvent(date_max[i], as.character(date_max[i]), labelLoc="top", 
              strokePattern="dotted", color="peru")
  }
  return (dy)
}

Avant de représenter notre graphe, nous pensions que l’influence sportive ou même politique pourrait avoir un impact sur la criminalité dans la ville. En effet, en 2005, les White Sox de Chicago ont remporté le championnat du monde de baseball, ce qui n’était pas arrivé depuis 88 ans. De plus en 2008, Barack Obama, sénateur de l’Illinois à l’époque, a été élu président des États-Unis. Ces deux événements, à priori majeure dans la ville, n’a guère eu d’impact à Chicago.

Cependant, nous avons remarqué un fait assez important lors que l’affichage de notre graphe d’évolution. Cette évolution est marqué par un pic assez conséquent durant le nouvel an de (quasiment) chaque année. Afin de tenter de comprendre ces pics, nous allons d’abord récupérer les types de crimes qui contribuent le plus aux pics durant les nouvels ans.

# dygraph tous crimes confondus
nb_crimes_pardate <- read.csv2("data/processed/nb_crime_par_date_2001_2019.csv", sep=",")
dy_all <- my_dygraph(nb_crimes_pardate, "Tous types de crimes confondus")
dy_all

2.2 Analyse de données au nouvel an

2.2.1 Les types de crimes qui contribuent aux pics de criminalité au nouvel an

Parmis toutes les variables, nous récupérons celles qui présentent un pic significatif au nouvel an. Nous considérons qu’un pic est significatif pour un type de crime donné s’il est supérieur au critère que nous avons défini : \(\text{moyenne} + 4\times\text{écart-type}\).

Voici donc les types de crimes présentant des pics significatifs au nouvel an selon notre critère (par ordre décroissant) :

type_de_crime <- names(table(crimes2001[,3]))
var_nv_an <- c()
var_pow <- c()

for(i in type_de_crime){
  nb_crimes_pardate <- table(as.Date(crimes2001$Date[which(crimes2001$Primary.Type==i)], format="%d/%m/%Y"))
  nb_crimes_pardate <- as.data.frame(nb_crimes_pardate)
  ecarttype <- sd(nb_crimes_pardate$Freq)
  moyenne <- mean(nb_crimes_pardate$Freq)
  critere <- (moyenne + 4*ecarttype)
  boolean <- nb_crimes_pardate$Freq >= critere
  condition <- str_sub(nb_crimes_pardate$Var1[which(boolean==TRUE)],6,10) == "01-01"
  pow <- length(which(condition==TRUE))
  if (pow >= 5){
    var_nv_an <- c(var_nv_an,i)
    var_pow <- c(var_pow,pow)
  }
}

library(knitr); library(kableExtra)
kable(paste(paste(c(1:6),". ", sep=""),
            var_nv_an[order(var_pow,decreasing = T)]), col.names="")%>%
  kable_styling(bootstrap_options = c("striped", "hover"))


OFFENSE INVOLVING CHILDREN
SEX OFFENSE
CRIM SEXUAL ASSAULT
WEAPONS VIOLATION
DECEPTIVE PRACTICE
THEFT

Pour quelques-uns de ces types de crimes, nous affichons donc leur évolution respective.

Uniquement les agressions impliquant des enfants

# dygraph des sex offense involving children
nb_offenseinvolvingchild_pardate <- table(as.Date(crimes2001[which(crimes2001[,3] == "OFFENSE INVOLVING CHILDREN"),2],
                                             format="%d/%m/%Y"))
dy_offenseinvolvingchildren <- my_dygraph(nb_offenseinvolvingchild_pardate,
                                          "Toutes les agressions impliquant des enfants")
dy_offenseinvolvingchildren

Uniquement les agressions sexuelles

# dygraph des sex offense
nb_sexoffense_pardate <- table(as.Date(crimes2001[which(crimes2001[,3] == "SEX OFFENSE"),2],
                                       format="%d/%m/%Y"))
dy_sexoffense <- my_dygraph(nb_sexoffense_pardate, "Toutes les agressions sexuelles")
dy_sexoffense

Uniquement les crimes liés aux armes

# dygraph des homicide
nb_weaponsviolation_pardate <- table(as.Date(crimes2001[which(crimes2001[,3] == "WEAPONS VIOLATION"),2], format="%d/%m/%Y"))
dy_weaponsviolation <- my_dygraph(nb_weaponsviolation_pardate, "Tous les crimes li\U00E9s aux armes")
dy_weaponsviolation

Uniquement les vols

# dygraph des vols
nb_theft_pardate <- table(as.Date(crimes2001[which(crimes2001[,3] == "THEFT"),2],
                                  format="%d/%m/%Y"))
dy_theft <- my_dygraph(nb_theft_pardate, "Tous les vols")
dy_theft

2.2.2 Utilisation des séries temporelles

Nous allons à présent utiliser les applications des séries temporelles. L’objectif est de montrer que la tendance est bien décroissante et pourquoi pas confirmer une saisonnalité.

library(forecast); library(fpp2); library(tseries)

nb_crimes_pardate <- read.csv2("data/processed/nb_crime_par_date_2001_2019.csv", sep=",")

time_series <- ts(nb_crimes_pardate$Freq,start=1)
#quelle est la frequence?
freq <- findfrequency(time_series)
#on en prend desormais compte
time_series <- ts(nb_crimes_pardate$Freq, start = 1, frequency = freq)

#on check la stationnarité
adf.test(time_series)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  time_series
## Dickey-Fuller = -6.4988, Lag order = 13, p-value = 0.01
## alternative hypothesis: stationary

component <- decompose(time_series)

library(highcharter)
vect <- cbind(c(1:length(as.vector(component$trend))),as.vector(component$trend))
highchart() %>%
  hc_chart(type = "line")%>%
  hc_xAxis(seq(0,300,by=50))%>%
  hc_title(text = "Tendance")%>%
  hc_add_series(data = vect,
                name = "tendance", color = "cornflowerblue")

#si on veut verifier que le residu est bien gaussien
#hist(component$random)

La tendance est bien décroissante et nous avons aussi observé la saisonnalité au cours de l’étude. Nous voyons donc que le nombre de crimes diminue entre 2001 et 2019 mais garde une saisonnalité.

2.2.3 Quels facteurs entrent en jeu pour expliquer les pics au nouvel an ?

Pour répondre à cette question, nous allons créer une nouvelle matrice qui contiendra seulement les types de crimes vus précédemment, c’est-à-dire qui ont un pic significatif au nouvel an selon notre critère. Ainsi, un corrélogramme pourra peut-être expliquer ces variations.

ind <- as.vector(crimes2001[,3])%in%as.vector(var_nv_an)
crimes_nv_an <- crimes2001[which(ind==TRUE),]
nb_crimes_nv_an_pardate <- table(as.Date(crimes_nv_an$Date, format="%d/%m/%Y"))
nb_crimes_nv_an_pardate <- as.data.frame(nb_crimes_nv_an_pardate)
dy_crime_nv_an <- my_dygraph(nb_crimes_nv_an_pardate, "Les 6 types de crimes les plus présents au nouvel an")
dy_crime_nv_an

Il est très intéressant de voir ici que la tendance descendante a disparue. Ce qui signifie que les crimes qui causent nos pics au nouvel an ne sont malheureusement pas en déclin au fil des années. Nous déduisons donc que le type de crime qui faisait descendre notre courbe n’a pas été gardé dans notre matrice.

Une autre hypothèse aurait été une moyennisation entre les crimes mais il est peu probable car cette moyennisation aurait lieu sur 6 variables contre les 35 au départ.

Nous n’avons pas pu établir de corrélations avec des facteurs externes pouvant expliquer ces pics au nouvel an, car nous n’avons pas trouvé de données de facteurs externes prenant en compte l’aspect temporel.

2.3 Analyse de données des jours

Dans cette partie nous allons voir si le jour a un impact significatif sur la criminalité à Chicago.

Voici des diagrammes en barres associés à certains types de crimes survenus à Chicago. Nous avons pu afficher ces diagrammes à l’aide du package highcharter avec l’aide de codes disponibles sur le site suivant : http://jkunst.com/highcharter.

Nous avons fait un test d’ajustement du \(\chi^2_6\) sur nos jours de la semaine, nous rejetons l’hypothèse d’homogénéité de la distribution. Il est vraisemblable que nous ayons plus de chances de nous faire enlever le vendredi à Chicago et plus de chances de mourir le week-end…

Tous types de crimes confondus

library(highcharter)
all_ <- table(jourch)
highchart() %>%
  hc_chart(type = "column")%>%
  hc_title(text = "Tous types de crimes confondus")%>%
  hc_xAxis(categories = c("Lundi", "Mardi", "Mercredi", "Jeudi",
                          "Vendredi", "Samedi", "Dimanche"))%>%
  hc_add_series(data = all_[c(3,4,5,2,7,6,1)],
                name = "Fr\U00E9quence", color = "cornflowerblue")

Uniquement les meurtres

meurtre <- which(crimes2001[,3] == "HOMICIDE")
tab1 <- table(jourch[meurtre,])
highchart() %>%
  hc_chart(type = "column")%>%
  hc_title(text = "Tous les meurtres")%>%
  hc_xAxis(categories = c("Lundi", "Mardi", "Mercredi", "Jeudi",
                          "Vendredi", "Samedi", "Dimanche"))%>%
  hc_add_series(data = tab1[c(3,4,5,2,7,6,1)],
                name = "Fr\U00E9quence", color = "peru")

#test significativité pour meurtre
ho <- rep(1359.714, 7)
obs <- table(jourch[meurtre,])
X2 <- sum((ho-obs)^2/ho)
p_val <- pchisq(X2, df = 6, lower.tail = F)
#ou
chisq.test(as.numeric(unname(table(jourch[meurtre,]))))$p.value

## [1] 1.142409e-38

Uniquement les agressions sexuelles

aggsex <- which(crimes2001[,3] == "SEX OFFENSE")
tab2 <- table(jourch[aggsex,])
highchart() %>%
  hc_chart(type = "column")%>%
  hc_title(text = "Toutes les agressions sexuelles")%>%
  hc_xAxis(categories = c("Lundi", "Mardi", "Mercredi", "Jeudi",
                          "Vendredi", "Samedi", "Dimanche"))%>%
  hc_add_series(data = tab2[c(3,4,5,2,7,6,1)],
                name = "Fr\U00E9quence", color = "peru")

Uniquement les enlèvements

kidnap <- which(crimes2001[,3] == "KIDNAPPING")
tab3 <- table(jourch[kidnap,])
highchart() %>%
  hc_chart(type = "column")%>%
  hc_title(text = "Tous les enl\U00E8vements")%>%
  hc_xAxis(categories = c("Lundi", "Mardi", "Mercredi", "Jeudi",
                          "Vendredi", "Samedi", "Dimanche"))%>%
  hc_add_series(data = tab3[c(3,4,5,2,7,6,1)],
                name = "Fr\U00E9quence", color = "peru")

Graphiquement, nous observons une petite différence pour le vendredi par rapport aux autres jours de la semaine concernant les enlèvements. Afin de confirmer s’il y a un différence significative, faisons un test de significativé.

#test significativité pour kidnapping
ho <- rep(956, 7)
obs <- table(jourch[kidnap,])
X2 <- sum((ho-obs)^2/ho)
p_val <- pchisq(X2, df = 6, lower.tail = F)
#ou
chisq.test(as.numeric(unname(table(jourch[kidnap,]))))$p.value

## [1] 3.049975e-33

Uniquement les enlèvements le vendredi (horaire)

Affichons maintenant un cas bien plus précis. Nous avons ici représenté le nombre d’enlèvements uniquement le vendredi par tranche horaire. Nous avons donc une répartition horaire des enlèvements le vendredi à Chicago. Nous souhaitons connaître si la variable horaire a un impact sur ce type de crime à Chicago le vendredi. Pour répondre à cette interrogation, nous effectuons un test de significativité du \(\chi^2_6\).

kidnap_heure <- which(crimes2001[,3] == "KIDNAPPING" & jourch == "vendredi")
tab4 <- table(heure[kidnap_heure,])

highchart() %>%
  hc_chart(type = "column")%>%
  hc_title(text = "Enl\U00E8vements le vendredi (horaire)")%>%
  hc_xAxis(categories = names(tab4))%>%
  hc_add_series(data = tab4,
                name = "Fr\U00E9quence", color = "peru")

En constatant nos résultats, il semblerait qu’il y ait plus de chances de se faire kidnapper entre 17h et 19h le vendredi.

3 Analyse de données structurelles

Dans cette partie, nous allons prendre en compte l’aspect spatial des données et perdre l’aspect temporel des crimes, car les facteurs que nous inclurons n’ont justement pas cette aspect temporel.
Pourquoi avons-nous choisi les communes comme granularité pour notre étude ?
Le plus gros problème auquel nous avons dû faire face a été de mettre toutes nos données à cette granularité. En effet, nous avions parfois des données par code postal ou par district policier ou par quartier.
Nous avons alors du faire des recherches peu évidentes pour trouver les correspondances.
Nous utilisons d’abord toutes les données de crimes à Chicago de 2001 à 2019. Nous faisons ensuite une contingence par commune et affichons les résultats sur la carte.

Austin est le lieu où il y a le plus de crimes (tous types de crimes confondus) à Chicago.

3.1 Création de notre matrice statistique

3.2 Ajout des facteurs socio-géo-économiques par commune

Au départ, nous avons voulu créer notre matrice statistique avec des lignes dont la variable à expliquer est le nombre de crimes par code postal et non par commune.

Cependant les données que nous avons obtenus sur le site de la ville de Chicago, décrivaient les codes postaux. Nous avons donc effectué des recherches afin de récupérer les communes associées aux codes postaux. Après maintes recherches, nous avons trouvé les communes et leurs codes postaux en ligne (cela nous fait gagner énormement de temps) sur le site suivant : http://robparal.blogspot.com/2013/07/chicago-community-area-and-zip-code.html

Il semblerait que ces données soient les plus récentes, en l’occurrence 2010. Nous allons pouvoir compter nos facteurs externes par commune.

# les codes postaux associés aux communes
zipequ <- read.csv("data/raw/zipequ.csv", sep = ",")
zipequ <- zipequ[,c(1,2)]
#exemple codes postaux associés à ohare
#print("Les codes postaux concernant Chicago O'Hare")
#zipequ[which(zipequ[,1]==76),2]

Nous ajoutons donc nos différents facteurs externes à notre matrice statistique à savoir :

Le nombre de bibliothèques ;
Le nombre de stations de police ;
Les données socio-économiques ;
Le nombre de parcs ;
Le nombre de terrains de basket ;
Le nombre de terrains de foot ;
Le nombre d’hôpitaux ;
Le nombre de distributeurs de préservatifs.

################## ajout des bibliothèques ################## 
#nombre de bibliothèque par commune
nblib <- rep(0, length(contourChica$community))
for(i in 1:length(librairie$ZIP)){
  ind <- zipequ[which(zipequ[,2]==librairie$ZIP[i]),1]
  nblib[ind] <- nblib[ind]+1
}
# on réordonne en fonction de contours chica pour que les ids coincident
nblib <- nblib[community_num]
# ajout à la matrice statistique
nb_crimes <- as.vector(unname(nb_crimes))
Mat <- data.frame("nombre de crimes" = nb_crimes, "nombre de bibliothèques" = nblib)

################## ajout des stations de police ##################
#station de police par zipcode
station <- read.csv("data/raw/Police_Stations.csv")[,6]
#nombre de station de police par commune
nbstation <- rep(0, length(contourChica$community))
for(i in 1:length(station)){
  ind <- zipequ[which(zipequ[,2]==station[i]),1]
  nbstation[ind] <- nbstation[ind] + 1
}
# on réordonne en fonction des numeros de commune pour que les ids coincident
nbstation <- nbstation[community_num]
# ajout à la matrice
Mat["nombre de stations de police"] <- nbstation

################## ajout des données socio-éco ##################
crime2008_2012 <- c()
ind <- c(which(crimes2001$Year==2008),
         which(crimes2001$Year==2009),
         which(crimes2001$Year==2010),
         which(crimes2001$Year==2011),
         which(crimes2001$Year==2012))

crime2008_2012 <- crimes2001[ind,]

nb_crimes_2008_2012 <- table(crime2008_2012[,11])
nb_crimes_2008_2012 <- nb_crimes_2008_2012[-1]
nb_crimes_2008_2012 <- nb_crimes_2008_2012[community_num]
Mat2008_2012 <- Mat
Mat2008_2012$nombre.de.crimes <- nb_crimes_2008_2012

fact <- read.csv("data/raw/fact_soc.csv")
fact <- fact[community_num,]

Mat2008_2012["pourcentage de maisons surpeuplées"] <- fact$PERCENT.OF.HOUSING.CROWDED
Mat2008_2012["pourcentage de menages sous le seuil de pauvreté"] <- fact$PERCENT.HOUSEHOLDS.BELOW.POVERTY
Mat2008_2012["=16 ans sans emploi"] <- fact$PERCENT.AGED.16..UNEMPLOYED
Mat2008_2012[">25 ans sans diplôme"] <- fact$PERCENT.AGED.25..WITHOUT.HIGH.SCHOOL.DIPLOMA
Mat2008_2012["pourcentage age <18and >64"] <- fact$PERCENT.AGED.UNDER.18.OR.OVER.64
Mat2008_2012["Revenu par habitant"] <- fact$PER.CAPITA.INCOME
Mat2008_2012["Score social (attention dépendance)"] <- fact$HARDSHIP.INDEX

################## ajout des parcs,terrains de foot et basket ##################
parks <- read.csv("data/raw/park.csv")
#nombre de parcs par commune
nbpark <- rep(0,length(contourChica$community))
for(i in 1:length(parks$ZIP)){
  ind <- zipequ[which(zipequ[,2]==parks$ZIP[i]),1]
  nbpark[ind] <- nbpark[ind] + 1
}
#on réordonne en fonction de contours chica pour que les ids coincident
nbpark <- nbpark[community_num]

#nombre de terrain de basket
nbbasket <- rep(0,length(contourChica$community))
for(i in 1:length(parks$ZIP)){
  ind <- zipequ[which(zipequ[,2]==parks$ZIP[i]),1]
  nbbasket[ind] <- nbbasket[ind] + parks$BASKETBALL[i]
}
#on réordonne en fonction de contours chica pour que les ids coincident
nbbasket <- nbbasket[community_num]

#nombre terrain de foot
nbfoot <- rep(0,length(contourChica$community))
for(i in 1:length(parks$ZIP)){
  ind <- zipequ[which(zipequ[,2]==parks$ZIP[i]),1]
  nbfoot[ind] <- nbfoot[ind] + parks$FOOTBALL_S[i]
}
#on réordonne en fonction de contours chica pour que les ids coincident
nbfoot <- nbfoot[community_num]

#ajout à la matrice statistique
Mat2008_2012["nombre de terrains de foot"] <- nbfoot
Mat2008_2012["nombre de terrains de basket"] <- nbbasket
Mat2008_2012["nombre de parcs"] <- nbpark

################## ajout des hopitaux ##################
nbhosp <- rep(0,length(contourChica$area_numbe))
for(i in 1:nrow(hosp)){
  ind <- which(contourChica$area_numbe==hosp$AREA_NUMBE.C.2[i])
  nbhosp[ind] <- nbhosp[ind] + 1
}

Mat2008_2012["nombre d'hopitaux"] <- nbhosp

################## ajout des distributeurs de préservatifs ##################
#nombre de distributeurs
nbcondom <- rep(0,length(contourChica$community))
for(i in 1:nrow(condom)){
  ind <- zipequ[which(zipequ[,2]==condom$ZIP.Code[i]),1]
  nbcondom[ind] <- nbcondom[ind] + 1
}

#on réordonne en fonction de contours chica pour que les ids coincident
nbcondom <- nbcondom[community_num]

Mat2008_2012["nombre de distributeurs de condom"] <- nbcondom

Parmis nos facteurs externes, nous avons des données socio-économiques datées entre 2008 et 2012. Notre étude dans cette partie se réduit donc sur cette période. Dans ces données socio-économiques, il y a un facteur qui est un score socio-économique. En quelques mots, ce score est calculé à partir des 6 variables transformées en pourcentage. Ces 6 variables sont les suivantes :

Le revenu par habitant ;
Le pourcentage de maison surpeuplée ;
Le nombre de personnes de plus de 25 ans sans diplôme ;
Le pourcentage de personnes de <18 et >64 ans ;
Le nombre de personnes de 16 ans sans emploi ;
Le pourcentage de maison vivant sous le seuil de pauvreté.

Ce score est un score de mauvaise qualité économique, appliqué à chaque commune. Pour plus détails sur ce score, nous vous renvoyons vers le site suivant : https://greatcities.uic.edu/wp-content/uploads/2016/07/GCI-Hardship-Index-Fact-SheetV2.pdf.

Voici un petit aperçu des scores socio-économiques par commune à l’aide du package leaflet. Pour cet aperçu, nous avons récupéré les shapefiles de Chicago et les avons transformés sur R.

Voici à quoi ressemble notre matrice :

Nom Commune	nombre.de.crimes	nombre.de.bibliothèques	nombre de stations de police	pourcentage de maisons surpeuplées	pourcentage de menages sous le seuil de pauvreté	=16 ans sans emploi	>25 ans sans diplôme	pourcentage age <18and >64	Revenu par habitant	Score social (attention dépendance)	nombre de terrains de foot	nombre de terrains de basket	nombre de parcs	nombre d’hopitaux	nombre de distributeurs de condom
DOUGLAS	15810	7	3	1.8	29.6	18.2	14.3	30.7	23791	47	24	102	56	0	10
OAKLAND	4242	0	1	1.3	39.7	28.7	18.4	40.4	19252	78	3	24	17	0	4
FULLER PARK	6193	5	1	3.2	51.2	33.9	26.6	44.9	10432	97	16	48	21	0	5
GRAND BOULEVARD	24231	7	2	3.3	29.3	24.3	15.9	39.5	23472	57	20	77	50	1	13
KENWOOD	10818	2	1	2.4	21.7	15.7	11.3	35.4	35911	26	4	29	29	0	8
LINCOLN SQUARE	12638	6	1	3.4	10.9	8.2	13.4	25.5	37524	17	22	52	58	3	12

3.3 Corrélation

Les graphiques suivants ont été réalisés en s’inspirant grandement de ce site web :
http://www.sthda.com/french/wiki/visualiser-une-matrice-de-correlation-par-un-correlogramme

Nous observons les corrélations entre nos variables. Si elles ne sont pas significatives alors elles sont barrées. Nous pouvons remarquer des corrélations logiques :

Le revenu par habitant est corrélé négativement au pourcentage de <18 >64 ans ;
Le pourcentage de personnes de 25 ans sans le bac est corrélé positivement au pourcentage de maison surpeuplée.

3.4 Explication du nombre de crimes

3.4.1 Régression sur notre matrice

Nous voulons dans cette partie effectuer une régression et éliminer certaines variables par critère AIC pour voir lesquelles contribuent au modèle.
Nous allons enlever le score socio-économique qui explique toujours bien la criminalité mais si nous voulons plus de granularité sur les variables explicatives, il nous faut le retirer de l’étude.

library(MASS);library(knitr);library(kableExtra)

var_sel_crime <- c()
reg <- lm(nombre.de.crimes~., data = Mat2008_2012[,-10])
regfinale <- stepAIC(reg, direction = "backward", trace = F)
a <- summary(regfinale)
affichage <- rownames(a$coefficients[which(a$coefficients[,4]<0.05),])

kable(affichage,col.names = "Variables sélectionnées par lm")%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variables sélectionnées par lm
`pourcentage de maisons surpeuplées`
`=16 ans sans emploi`
`nombre d'hopitaux`

var_sel_crime <- c(var_sel_crime,affichage)

Nous observons que parmis les variables, le pourcentage de maison surpeuplée, le nombre d’enfants de 16 ans sans emploi et le nombre d’hôpitaux sont des variables qui expliquent la criminalité à Chicago.

Nous allons maintenant prendre en compte le fait que nos données sont de type “comptage”, nous observons un nombre de meurtre par commune.
Notre variable nombre de crime a-t-elle une répartition de type Poisson ?

En regardant les deux répartitions et en prenant en compte le type de nos données, il est raisonnable de penser que notre variable nombre de crimes suit une loi de Poisson de paramètre \(\lambda \in [0,1]\). Nous allons à présent faire une régression LASSO en prenant en compte notre distribution de Poisson.

library(glmnet); library(kableExtra)

lasso <- glmnet(x = as.matrix(Mat2008_2012[,-c(1,10)]),
                y = as.numeric(Mat2008_2012[,1]/sd(Mat2008_2012[,1])),
                family = "poisson")
plot(lasso, xvar = "lambda", label = T, main = "Sélection Lasso des variables")

kable(names(which(log(lasso$beta[,10])!="-Inf")),col.names = c("Variable sélectionnées par la régression Lasso"))%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variable sélectionnées par la régression Lasso
pourcentage de menages sous le seuil de pauvreté
=16 ans sans emploi
nombre d’hopitaux
nombre de distributeurs de condom

var_sel_crime <- c(var_sel_crime,names(which(log(lasso$beta[,10])!="-Inf")))

Utilisation des modèles linéaires généralisés :

glm <- glm(nombre.de.crimes~., data = Mat2008_2012[,-10], family = "poisson")
summary(glm)

## 
## Call:
## glm(formula = nombre.de.crimes ~ ., family = "poisson", data = Mat2008_2012[, 
##     -10])
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -194.13   -75.18   -20.72    52.33   278.74  
## 
## Coefficients:
##                                                      Estimate Std. Error
## (Intercept)                                         9.267e+00  1.006e-02
## nombre.de.bibliothèques                            -1.353e-01  7.655e-04
## `nombre de stations de police`                     -2.377e-02  1.445e-03
## `pourcentage de maisons surpeuplées`                9.167e-02  4.965e-04
## `pourcentage de menages sous le seuil de pauvreté` -1.503e-02  1.311e-04
## `=16 ans sans emploi`                               7.886e-02  2.245e-04
## `>25 ans sans diplôme`                             -5.413e-03  2.030e-04
## `pourcentage age <18and >64`                       -2.917e-02  2.090e-04
## `Revenu par habitant`                               9.360e-06  1.052e-07
## `nombre de terrains de foot`                       -2.831e-03  1.596e-04
## `nombre de terrains de basket`                      4.766e-03  6.634e-05
## `nombre de parcs`                                   1.229e-02  1.017e-04
## `nombre d'hopitaux`                                 1.463e-01  1.033e-03
## `nombre de distributeurs de condom`                 2.881e-02  1.765e-04
##                                                    z value Pr(>|z|)    
## (Intercept)                                         920.78   <2e-16 ***
## nombre.de.bibliothèques                            -176.80   <2e-16 ***
## `nombre de stations de police`                      -16.45   <2e-16 ***
## `pourcentage de maisons surpeuplées`                184.64   <2e-16 ***
## `pourcentage de menages sous le seuil de pauvreté` -114.68   <2e-16 ***
## `=16 ans sans emploi`                               351.22   <2e-16 ***
## `>25 ans sans diplôme`                              -26.67   <2e-16 ***
## `pourcentage age <18and >64`                       -139.55   <2e-16 ***
## `Revenu par habitant`                                88.97   <2e-16 ***
## `nombre de terrains de foot`                        -17.73   <2e-16 ***
## `nombre de terrains de basket`                       71.84   <2e-16 ***
## `nombre de parcs`                                   120.88   <2e-16 ***
## `nombre d'hopitaux`                                 141.65   <2e-16 ***
## `nombre de distributeurs de condom`                 163.22   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 1147450  on 76  degrees of freedom
## Residual deviance:  597169  on 63  degrees of freedom
## AIC: 598090
## 
## Number of Fisher Scoring iterations: 5

Un problème apparaît, notre modèle ne sélectionne pas de variable, il les garde toutes. Il semblerait que nous soyons en présence de surdispersion. Nous nous inspirons donc des codes de ce forum https://stats.stackexchange.com/questions/66586/is-there-a-test-to-determine-whether-glm-overdispersion-is-significant pour tester s’il y a présence ou non de surdispersion.

library(AER)
fit <- glm(nombre.de.crimes~., data = Mat2008_2012[,-10], family="poisson") 
dispersiontest(fit, trafo = 1)

## 
##  Overdispersion test
## 
## data:  fit
## z = 4.7568, p-value = 9.833e-07
## alternative hypothesis: true alpha is greater than 0
## sample estimates:
##    alpha 
## 8048.289

Nous sommes bien en présence de surdispersion. Nous changeons donc notre modèle Poisson pour le modèle Quasi-Poisson qui est adapté pour ce type de modèle.

library(kableExtra)

fit.surdisp <- glm(nombre.de.crimes~., data = Mat2008_2012[,-10],
                   family = "quasipoisson") 
a <- summary(fit.surdisp)
affichage <- rownames(a$coefficients[which(a$coefficients[,4]<0.05),])

kable(affichage,col.names = "Variables sélectionnées par glm Quasi-Poisson")%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variables sélectionnées par glm Quasi-Poisson
(Intercept)
`=16 ans sans emploi`

var_sel_crime <- c(var_sel_crime,affichage)

3.4.2 Variables sélectionnées par nos modèles pour expliquer les crimes

library(kableExtra)

var_sel_crime <- str_remove_all(var_sel_crime,"`")
kable(unique(var_sel_crime), col.names = c(""))%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")


pourcentage de maisons surpeuplées
=16 ans sans emploi
nombre d’hopitaux
pourcentage de menages sous le seuil de pauvreté
nombre de distributeurs de condom
(Intercept)

Les meurtres à Chicago semblent être expliqués par des variables socio-économiques comme :

Le pourcentage de maisons surpeuplées ;
Le nombre de personnes de 16 ans sans emploi ;
Le nombre de ménages vivant sous le seuil de pauvreté.

Viennent ensuite des variables plus atypique :

Le nombre d’hôpitaux;
Le nombre de distributeurs de préservatifs.

3.5 Explication du nombre de meurtres

Nous nous intéressons maintenant aux meutres et plus aux crimes en général.

Nous considérons ici les meurtres en tant qu’homicide et non du point de vue de la législation française, puisque les données sont américaines.

crime2008_2012 <- c()
ind <- c(which(crimes2001$Year==2008),
         which(crimes2001$Year==2009),
         which(crimes2001$Year==2010),
         which(crimes2001$Year==2011),
         which(crimes2001$Year==2012))

crime2008_2012 <- crimes2001[ind,]
crime2008_2012 <- crime2008_2012[which(crime2008_2012[,3]=="HOMICIDE"),]

compteur <- rep(0,77)
for(i in 1:length(crime2008_2012[,11])){
  compteur[crime2008_2012$Community.Area[i]]=compteur[crime2008_2012$Community.Area[i]]+1
}

nb_meurtres_2008_2012 <- compteur
nb_meurtres_2008_2012 <- nb_meurtres_2008_2012[community_num]
names(nb_meurtres_2008_2012) <- contourChica$area_numbe

Représentation sur la carte :

labels <- sprintf(fmt = "<strong>%s</strong><br/> nombre meurtre : %g",
                  contourChica$community,nb_meurtres_2008_2012)%>%lapply(htmltools::HTML)
bins <- seq(0, max(nb_meurtres_2008_2012), by = 10)


pal <- colorBin("YlOrRd", domain = nb_meurtres_2008_2012, bins = bins)

leaflet(contourChica,width = "100%")%>%
  addTiles()%>%
  addPolygons(weight = 2, opacity = 1, color = "white",
              fillColor = ~pal(nb_meurtres_2008_2012), dashArray = "3",
              fillOpacity = 0.7,
              highlight = highlightOptions(weight = 5, color = "#666",
                                           dashArray = "",
                                           fillOpacity = 0.7,
                                           bringToFront = TRUE),
              label = labels,
              labelOptions = labelOptions(style = list("font-weight" = "normal", 
                                                       padding = "3px 8px"),
                                          textsize = "15px", direction = "auto")
              )%>%addLegend(pal = pal,values = nb_meurtres_2008_2012, opacity = 0.7, 
                            title = "Nombre de meurtres <br> entre 2008 et 2012 :", 
                            position = "bottomright")

Austin est encore une fois la commune la plus touchée.

3.5.1 Régression sur notre matrice

Nous voulons dans cette partie effectuer une régression et éliminer certaines variables par critère AIC pour voir lesquelles contribuent au modèle.

library(MASS); library(knitr); library(kableExtra)

var_sel_meurtre <- c()

Mat_meurtre <- Mat2008_2012
Mat_meurtre$nombre.de.crimes <- nb_meurtres_2008_2012
names(Mat_meurtre)[1] <- "nombre.de.meurtre"

reg <- lm(nombre.de.meurtre~., data = Mat_meurtre[,-10])
regfinale <- stepAIC(reg, direction = "backward", trace = F)
a <- summary(regfinale)
affichage <- rownames(a$coefficients[which(a$coefficients[,4]<0.05),])

kable(affichage,col.names = "Variables sélectionnées par lm")%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variables sélectionnées par lm
(Intercept)
nombre.de.bibliothèques
`pourcentage de maisons surpeuplées`
`=16 ans sans emploi`
`nombre de parcs`
`nombre d'hopitaux`

var_sel_meurtre <- c(var_sel_meurtre,affichage)

Comme précédemment, nous nous posons la question :
Notre variable nombre de meutres a-t-elle une répartition de type Poisson?

Nous gardons encore une fois la distribution de Poisson pour la variable nombre de meurtres.

library(glmnet);library(kableExtra)
lasso <- glmnet(x = as.matrix(Mat_meurtre[,-c(1,10)]),
                y = as.numeric(Mat_meurtre[,1]/sd(Mat_meurtre[,1])),
                family = "poisson")
plot(lasso, xvar = "lambda", label = T, main = "Sélection Lasso des variables")

kable(names(which(log(lasso$beta[,10])!="-Inf")),col.names = c("Variable sélectionnées par la régression Lasso"))%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variable sélectionnées par la régression Lasso
pourcentage de maisons surpeuplées
pourcentage de menages sous le seuil de pauvreté
=16 ans sans emploi
nombre de distributeurs de condom

var_sel_meurtre <- c(var_sel_meurtre,names(which(log(lasso$beta[,10])!="-Inf")))

Utilisons les modèles généralisés :

glm <- glm(nombre.de.meurtre~., data = Mat_meurtre[,-10], family = "poisson")
summary(glm)

## 
## Call:
## glm(formula = nombre.de.meurtre ~ ., family = "poisson", data = Mat_meurtre[, 
##     -10])
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -6.6614  -2.6451  -0.6148   1.7835   7.9311  
## 
## Coefficients:
##                                                      Estimate Std. Error
## (Intercept)                                         2.809e+00  4.384e-01
## nombre.de.bibliothèques                            -2.641e-01  2.388e-02
## `nombre de stations de police`                     -4.706e-02  4.096e-02
## `pourcentage de maisons surpeuplées`                1.359e-01  1.488e-02
## `pourcentage de menages sous le seuil de pauvreté` -3.317e-02  3.624e-03
## `=16 ans sans emploi`                               1.024e-01  5.849e-03
## `>25 ans sans diplôme`                             -1.682e-02  6.237e-03
## `pourcentage age <18and >64`                       -1.374e-02  7.488e-03
## `Revenu par habitant`                              -3.823e-05  6.285e-06
## `nombre de terrains de foot`                        6.861e-03  4.734e-03
## `nombre de terrains de basket`                      1.309e-02  1.828e-03
## `nombre de parcs`                                   1.188e-02  3.163e-03
## `nombre d'hopitaux`                                 3.731e-01  3.862e-02
## `nombre de distributeurs de condom`                 4.243e-02  6.095e-03
##                                                    z value Pr(>|z|)    
## (Intercept)                                          6.408 1.48e-10 ***
## nombre.de.bibliothèques                            -11.057  < 2e-16 ***
## `nombre de stations de police`                      -1.149 0.250594    
## `pourcentage de maisons surpeuplées`                 9.136  < 2e-16 ***
## `pourcentage de menages sous le seuil de pauvreté`  -9.153  < 2e-16 ***
## `=16 ans sans emploi`                               17.501  < 2e-16 ***
## `>25 ans sans diplôme`                              -2.697 0.007007 ** 
## `pourcentage age <18and >64`                        -1.834 0.066592 .  
## `Revenu par habitant`                               -6.082 1.19e-09 ***
## `nombre de terrains de foot`                         1.449 0.147284    
## `nombre de terrains de basket`                       7.163 7.90e-13 ***
## `nombre de parcs`                                    3.757 0.000172 ***
## `nombre d'hopitaux`                                  9.661  < 2e-16 ***
## `nombre de distributeurs de condom`                  6.961 3.37e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 2724.57  on 76  degrees of freedom
## Residual deviance:  785.62  on 63  degrees of freedom
## AIC: 1160
## 
## Number of Fisher Scoring iterations: 5

Le modèle sélectionne trop de variables. Testons encore si nous sommes en présence de surdispersion :

library(AER)

fit <- glm(nombre.de.meurtre~., data = Mat_meurtre[,-10],family="poisson") 
dispersiontest(fit, trafo = 1)

## 
##  Overdispersion test
## 
## data:  fit
## z = 4.4452, p-value = 4.391e-06
## alternative hypothesis: true alpha is greater than 0
## sample estimates:
##    alpha 
## 9.974256

Nous sommes bien encore présence de surdispersion. Nous changeons donc notre modèle Poisson pour le modèle Quasi-Poisson.

library(kableExtra)
fit.surdisp <- glm(nombre.de.meurtre~., data = Mat_meurtre[,-10], family="quasipoisson") 
a <- summary(fit.surdisp)
affichage <- rownames(a$coefficients[which(a$coefficients[,4]<0.05),])

kable(affichage,col.names = "Variables sélectionnées par glm Quasi-Poisson")%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")

Variables sélectionnées par glm Quasi-Poisson
nombre.de.bibliothèques
`pourcentage de maisons surpeuplées`
`pourcentage de menages sous le seuil de pauvreté`
`=16 ans sans emploi`
`nombre d'hopitaux`

var_sel_meurtre <- c(var_sel_meurtre,affichage)

3.5.2 Variables sélectionnées par nos modèles pour expliquer les meurtres

library(knitr); library(kableExtra)

var_sel_meurtre <- str_remove_all(var_sel_meurtre,"`")
kable(unique(var_sel_meurtre),col.names = c("")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>%
  scroll_box(width = "100%")


(Intercept)
nombre.de.bibliothèques
pourcentage de maisons surpeuplées
=16 ans sans emploi
nombre de parcs
nombre d’hopitaux
pourcentage de menages sous le seuil de pauvreté
nombre de distributeurs de condom

Les meurtres (homicides) à Chicago semblent être expliqués par des variables socio-économiques comme :

Le pourcentage de maisons surpeuplées ;
Le nombre de personnes de 16 ans sans emploi ;
Le pourcentage de ménages vivant sous le seuil de pauvreté.

Viennent ensuite des variables plus atypique :

Le nombre de bibliothèques ;
Le nombre de parcs ;
Le nombre d’hôpitaux ;
Le nombre de distributeurs de préservatifs.

Projet Open Data : La criminalité à Chicago

Rodrigue Govan et Jason Siffre

1 Introduction

2 Analyse de données temporelles

2.1 Visualisation de nos données

2.2 Analyse de données au nouvel an

2.2.1 Les types de crimes qui contribuent aux pics de criminalité au nouvel an

Uniquement les agressions impliquant des enfants

Uniquement les agressions sexuelles

Uniquement les crimes liés aux armes

Uniquement les vols

2.2.2 Utilisation des séries temporelles

2.2.3 Quels facteurs entrent en jeu pour expliquer les pics au nouvel an ?

2.3 Analyse de données des jours

Tous types de crimes confondus

Uniquement les meurtres

Uniquement les agressions sexuelles

Uniquement les enlèvements

Uniquement les enlèvements le vendredi (horaire)

3 Analyse de données structurelles

3.1 Création de notre matrice statistique

3.2 Ajout des facteurs socio-géo-économiques par commune

3.3 Corrélation

3.4 Explication du nombre de crimes

3.4.1 Régression sur notre matrice

3.4.2 Variables sélectionnées par nos modèles pour expliquer les crimes

3.5 Explication du nombre de meurtres

3.5.1 Régression sur notre matrice

3.5.2 Variables sélectionnées par nos modèles pour expliquer les meurtres