Taux de prévalence moyen par quartier

Les données

# install.packages("sf")
# install.packages("mapsf")
library(sf)

Linking to GEOS 3.10.2, GDAL 3.4.1, PROJ 8.2.1; sf_use_s2() is TRUE

BD <- st_read("data/Couche Polygones.gpkg", quiet = TRUE)
Quartier <- st_read("data/Q.shp", quiet = TRUE)
BBOX  <- st_read("data/bbox.shp", quiet = TRUE)

# Reprojection
Quartier <- st_transform(Quartier, crs= "EPSG:32636")

Données importées

On ne garde que les zones (polygones) considérées comme “Positives”

BD_POS <- BD[ BD$Indicateur == "Positif", ]

Affichage des données utilisées (Polygone, Quartier et étendue de la grille) :

library(mapsf)

mf_map(BD_POS, col = NA)
mf_map(BBOX, col = NA, add = TRUE)
mf_map(Quartier, col="red", add = TRUE)
mf_label(Quartier, var = "id")

Création grille régulière

Construction grille régulière de 100 x 100 m :

# Création grille vectorielle - objet sfc - POINTS
gridCenters <- st_make_grid(x = BBOX ,
                            cellsize = 100,        
                            square = TRUE,
                            what = "centers")

# Ajout d'un attribut (identifiant) à l'objet sfc (= objet sf)
gridCenters <- st_sf(ID = 1:length(gridCenters), geom = gridCenters)

Affichage :

mf_map(gridCenters, col = "black", pch = 21)
mf_map(BD_POS, col = NA, add = TRUE)
mf_map(Quartier, border="red", col=NA, lwd=3, add = TRUE)

1. Homme

Sélection des polygones positifs dessinés par les Hommes (Perception.du.genre.dans.l.espace.public) :

BD_Homme <- BD_POS[ BD_POS$Perception.du.genre.dans.l.espace.public == "Homme", ]

Affichage des polygones considérés :

plot(st_geometry(BD_Homme))
plot(st_geometry(BBOX), add = TRUE)
plot(st_geometry(Quartier), border="red", col=NA, lwd=3 , add = TRUE)

Grid vs polygones

# Calcul des intersections grille - polygones
intersection_homme <- st_intersects(x = gridCenters,
                                     y = BD_Homme,
                                     sparse = TRUE)

# Ajout du nombre d'intersection détectés dans l'attribut "count"
gridCenters$count <- lengths(intersection_homme)

# Calcul pourcentage
gridCenters$pct <- gridCenters$count / length(unique(BD_Homme$Numéro.carte.mentale)) * 100
# gridCenters$pct[gridCenters$pct == 0] <- NA

Carte globale

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, type="choro", var="pct", breaks=c(0,10,20,30,40,50,60,70,80,90,100), pal = rev(hcl.colors(10, "YlOrRd")),leg_frame = TRUE, leg_bg = "white", add = TRUE)
mf_map(Quartier, border="black", lwd = 3,col=NA, add = TRUE)

Grid vs quartier

Quartier 1

intersection_quartier_1 <- st_intersects(x = Quartier[Quartier$id == 1,],
                                      y = gridCenters,
                                     sparse = TRUE)

extract_square_1 <- gridCenters[gridCenters$ID %in% intersection_quartier_1[[1]],]

Quartier 2

## Quartier 2
intersection_quartier_2 <- st_intersects(x = Quartier[Quartier$id == 2,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_2 <- gridCenters[gridCenters$ID %in% intersection_quartier_2[[1]],]

Quartier 3

## Quartier 3
intersection_quartier_3 <- st_intersects(x = Quartier[Quartier$id == 3,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_3 <- gridCenters[gridCenters$ID %in% intersection_quartier_3[[1]],]

Affichage

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, col = "black", pch = 21, add = TRUE)
mf_map(extract_square_3, border="red", col="red", add = TRUE)
mf_map(extract_square_2, border="red", col="red", add = TRUE)
mf_map(extract_square_1, border="red", col="red", add = TRUE)
mf_map(Quartier, border="black", lwd = 1,col=NA, add = TRUE)
mf_label(Quartier, var = "id", cex = 3)

Résultats

Moyenne par quartier :

print(paste0("Quartier 1 - Taux de prévalence moyen pour les hommes : ",  mean(extract_square_1$pct), " %"))

[1] "Quartier 1 - Taux de prévalence moyen pour les hommes : 76.3618190904548 %"

print(paste0("Quartier 2 - Taux de prévalence moyen pour les hommes : ",  mean(extract_square_2$pct), " %"))

[1] "Quartier 2 - Taux de prévalence moyen pour les hommes : 61.7405582922824 %"

print(paste0("Quartier 3 - Taux de prévalence moyen pour les hommes : ",  mean(extract_square_3$pct), " %"))

[1] "Quartier 3 - Taux de prévalence moyen pour les hommes : 64.367816091954 %"

2. Femmes

Sélection des polygones positifs dessinés par les Femmes (Perception.du.genre.dans.l.espace.public) :

BD_Femme <- BD_POS[ BD_POS$Perception.du.genre.dans.l.espace.public == "Femme", ]

Affichage des polygones considérés :

plot(st_geometry(BD_Femme))
plot(st_geometry(BBOX), add = TRUE)
plot(st_geometry(Quartier), border="red", col=NA, lwd=3 , add = TRUE)

Grid vs polygones

# Calcul des intersections grille - polygones
intersection_femme <- st_intersects(x = gridCenters,
                                     y = BD_Femme,
                                     sparse = TRUE)

# Ajout du nombre d'intersection détectés dans l'attribut "count"
gridCenters$count <- lengths(intersection_femme)

# Calcul pourcentage
gridCenters$pct <- gridCenters$count / length(unique(BD_Femme$Numéro.carte.mentale)) * 100
# gridCenters$pct[gridCenters$pct == 0] <- NA

Carte globale

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, type="choro", var="pct", breaks=c(0,10,20,30,40,50,60,70,80,90,100), pal = rev(hcl.colors(10, "YlOrRd")),leg_frame = TRUE, leg_bg = "white", add = TRUE)
mf_map(Quartier, border="black", lwd = 3,col=NA, add = TRUE)

Grid vs quartier

Quartier 1

intersection_quartier_1 <- st_intersects(x = Quartier[Quartier$id == 1,],
                                      y = gridCenters,
                                     sparse = TRUE)

extract_square_1 <- gridCenters[gridCenters$ID %in% intersection_quartier_1[[1]],]

Quartier 2

## Quartier 2
intersection_quartier_2 <- st_intersects(x = Quartier[Quartier$id == 2,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_2 <- gridCenters[gridCenters$ID %in% intersection_quartier_2[[1]],]

Quartier 3

## Quartier 3
intersection_quartier_3 <- st_intersects(x = Quartier[Quartier$id == 3,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_3 <- gridCenters[gridCenters$ID %in% intersection_quartier_3[[1]],]

Affichage

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, col = "black", pch = 21, add = TRUE)
mf_map(extract_square_3, border="red", col="red", add = TRUE)
mf_map(extract_square_2, border="red", col="red", add = TRUE)
mf_map(extract_square_1, border="red", col="red", add = TRUE)
mf_map(Quartier, border="black", lwd = 1,col=NA, add = TRUE)
mf_label(Quartier, var = "id", cex = 3)

Résultats

Moyenne par quartier :

print(paste0("Quartier 1 - Taux de prévalence moyen pour les femmes : ",  mean(extract_square_1$pct), " %"))

[1] "Quartier 1 - Taux de prévalence moyen pour les femmes : 76.6245909303413 %"

print(paste0("Quartier 2 - Taux de prévalence moyen pour les femmes : ",  mean(extract_square_2$pct), " %"))

[1] "Quartier 2 - Taux de prévalence moyen pour les femmes : 49.1551459293395 %"

print(paste0("Quartier 3 - Taux de prévalence moyen pour les femmes : ",  mean(extract_square_3$pct), " %"))

[1] "Quartier 3 - Taux de prévalence moyen pour les femmes : 30.2508960573477 %"

3. Non-binaire

Sélection des polygones positifs dessinés par les Non-binaire (Perception.du.genre.dans.l.espace.public) :

BD_Nbinaire <- BD_POS[ BD_POS$Perception.du.genre.dans.l.espace.public == "Non-binaire", ]

Affichage des polygones considérés :

plot(st_geometry(BD_Nbinaire))
plot(st_geometry(BBOX), add = TRUE)
plot(st_geometry(Quartier), border="red", col=NA, lwd=3 , add = TRUE)

Grid vs polygones

# Calcul des intersections grille - polygones
intersection_nbinaire <- st_intersects(x = gridCenters,
                                     y = BD_Nbinaire,
                                     sparse = TRUE)

# Ajout du nombre d'intersection détectés dans l'attribut "count"
gridCenters$count <- lengths(intersection_nbinaire)

# Calcul pourcentage
gridCenters$pct <- gridCenters$count / length(unique(BD_Nbinaire$Numéro.carte.mentale)) * 100
# gridCenters$pct[gridCenters$pct == 0] <- NA

Carte globale

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, type="choro", var="pct", breaks=c(0,10,20,30,40,50,60,70,80,90,100), pal = rev(hcl.colors(10, "YlOrRd")),leg_frame = TRUE, leg_bg = "white", add = TRUE)
mf_map(Quartier, border="black", lwd = 3,col=NA, add = TRUE)

Grid vs quartier

Quartier 1

intersection_quartier_1 <- st_intersects(x = Quartier[Quartier$id == 1,],
                                      y = gridCenters,
                                     sparse = TRUE)

extract_square_1 <- gridCenters[gridCenters$ID %in% intersection_quartier_1[[1]],]

Quartier 2

## Quartier 2
intersection_quartier_2 <- st_intersects(x = Quartier[Quartier$id == 2,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_2 <- gridCenters[gridCenters$ID %in% intersection_quartier_2[[1]],]

Quartier 3

## Quartier 3
intersection_quartier_3 <- st_intersects(x = Quartier[Quartier$id == 3,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_3 <- gridCenters[gridCenters$ID %in% intersection_quartier_3[[1]],]

Affichage

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, col = "black", pch = 21, add = TRUE)
mf_map(extract_square_3, border="red", col="red", add = TRUE)
mf_map(extract_square_2, border="red", col="red", add = TRUE)
mf_map(extract_square_1, border="red", col="red", add = TRUE)
mf_map(Quartier, border="black", lwd = 1,col=NA, add = TRUE)
mf_label(Quartier, var = "id", cex = 3)

Résultats

Moyenne par quartier :

print(paste0("Quartier 1 - Taux de prévalence moyen pour les non-binaire : ",  mean(extract_square_1$pct), " %"))

[1] "Quartier 1 - Taux de prévalence moyen pour les non-binaire : 71.5942028985507 %"

print(paste0("Quartier 2 - Taux de prévalence moyen pour les non-binaire : ",  mean(extract_square_2$pct), " %"))

[1] "Quartier 2 - Taux de prévalence moyen pour les non-binaire : 47.3333333333333 %"

print(paste0("Quartier 3 - Taux de prévalence moyen pour les non-binaire : ",  mean(extract_square_3$pct), " %"))

[1] "Quartier 3 - Taux de prévalence moyen pour les non-binaire : 36.6222222222222 %"

4. Nat. Syrienne

Sélection des polygones positifs dessinés par les personnes de nationalité syrienne (Perception.du.genre.dans.l.espace.public) :

BD_syrien <- BD_POS[ BD_POS$Nationalité == "Syrienne", ]

Affichage des polygones considérés :

plot(st_geometry(BD_syrien))
plot(st_geometry(BBOX), add = TRUE)
plot(st_geometry(Quartier), border="red", col=NA, lwd=3 , add = TRUE)

Grid vs polygones

# Calcul des intersections grille - polygones
intersection_syrien <- st_intersects(x = gridCenters,
                                     y = BD_syrien,
                                     sparse = TRUE)

# Ajout du nombre d'intersection détectés dans l'attribut "count"
gridCenters$count <- lengths(intersection_syrien)

# Calcul pourcentage
gridCenters$pct <- gridCenters$count / length(unique(BD_syrien$Numéro.carte.mentale)) * 100
# gridCenters$pct[gridCenters$pct == 0] <- NA

Carte globale

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, type="choro", var="pct", breaks=c(0,10,20,30,40,50,60,70,80,90,100), pal = rev(hcl.colors(10, "YlOrRd")),leg_frame = TRUE, leg_bg = "white", add = TRUE)
mf_map(Quartier, border="black", lwd = 3,col=NA, add = TRUE)

Grid vs quartier

Quartier 1

intersection_quartier_1 <- st_intersects(x = Quartier[Quartier$id == 1,],
                                      y = gridCenters,
                                     sparse = TRUE)

extract_square_1 <- gridCenters[gridCenters$ID %in% intersection_quartier_1[[1]],]

Quartier 2

## Quartier 2
intersection_quartier_2 <- st_intersects(x = Quartier[Quartier$id == 2,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_2 <- gridCenters[gridCenters$ID %in% intersection_quartier_2[[1]],]

Quartier 3

## Quartier 3
intersection_quartier_3 <- st_intersects(x = Quartier[Quartier$id == 3,],
                                         y = gridCenters,
                                         sparse = TRUE)

extract_square_3 <- gridCenters[gridCenters$ID %in% intersection_quartier_3[[1]],]

Affichage

mf_map(Quartier, border=NA, col=NA)
mf_map(gridCenters, col = "black", pch = 21, add = TRUE)
mf_map(extract_square_3, border="red", col="red", add = TRUE)
mf_map(extract_square_2, border="red", col="red", add = TRUE)
mf_map(extract_square_1, border="red", col="red", add = TRUE)
mf_map(Quartier, border="black", lwd = 1,col=NA, add = TRUE)
mf_label(Quartier, var = "id", cex = 3)

Résultats

Moyenne par quartier :

print(paste0("Quartier 1 - Taux de prévalence moyen pour les syrien·nes : ",  mean(extract_square_1$pct), " %"))

[1] "Quartier 1 - Taux de prévalence moyen pour les syrien·nes : 62.0553359683794 %"

print(paste0("Quartier 2 - Taux de prévalence moyen pour les syrien·nes : ",  mean(extract_square_2$pct), " %"))

[1] "Quartier 2 - Taux de prévalence moyen pour les syrien·nes : 45.4545454545455 %"

print(paste0("Quartier 3 - Taux de prévalence moyen pour les syrien·nes : ",  mean(extract_square_3$pct), " %"))

[1] "Quartier 3 - Taux de prévalence moyen pour les syrien·nes : 18.3838383838384 %"