1 Composition démographique de la cohorte

1.1 Âge

d <- mtl_data[mtl_data$age < 100 & mtl_data$age > 17,]

summary(d$age) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
18	36	46	48.1	61	84

fillCount = length(unique(d$age))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(d) +
  geom_histogram(aes(age, y=after_stat(count / sum(count)), fill=factor(age)), binwidth = 5, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

# Add a age category variable
age_classes <- c("18 - 30", "31 - 50", "51 - 65", "65+")
mtl_data <- mtl_data %>%
  mutate(age_class = case_when(age < 31 ~ age_classes[1],
                               age < 51 ~ age_classes[2],
                               age < 66 ~ age_classes[3],
                               TRUE ~ age_classes[4]),
         age_class = factor(age_class, levels = age_classes))

table(mtl_data$age_class, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Catégorie âge', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Catégorie âge	N
18 - 30	73
31 - 50	234
51 - 65	149
65+	80

ggplot(mtl_data) +
  geom_bar(aes(age_class, y=after_stat(count / sum(count)), fill=age_class), show.legend = FALSE) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

1.2 Genre

gender <- fromJSON('[
        {
          "label": "Homme",
          "value": 1
        },
        {
          "label": "Femme",
          "value": 2
        },
        {
          "label": "Homme trans",
          "value": 3
        },
        {
          "label": "Femme trans",
          "value": 4
        },
        {
          "label": "De genre queer ou non-conforme au genre",
          "value": 5
        },
        {
          "label": "Identité différente",
          "value": 99
        }]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(gender, by=c("gender"="value")) %>%
  transmute(interact_id = interact_id,
            gender = label)

# Add gender as factor to dataset (for crosstab below)
mtl_data <- mtl_data %>%
  left_join(gender, by=c("gender"="value")) %>%
  mutate(gender_label = label) %>%
  select(!label)

table(.ggpdf$gender, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Genre', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Genre	N
Homme	196
Femme	325
Homme trans	1
Femme trans	1
De genre queer ou non-conforme au genre	11
Identité différente	0
NA	2

ggplot(.ggpdf) +
  geom_bar(aes(gender, y=after_stat(count / sum(count)), fill=gender), show.legend = FALSE) +
  theme_light() +
    theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")+ xlab("")

# grouping gender non-conforming under LGBTQ2S+
gender_groups <- c("Homme", "Femme", "Minorités de genre")
mtl_data <- mtl_data %>%
  mutate(gender_group = case_when(gender == 1 ~ gender_groups[1],
                                  gender == 2 ~ gender_groups[2],
                                  TRUE ~ gender_groups[3]),
         gender_group = factor(gender_group, levels = gender_groups))

1.3 Avec qui habitez-vous présentement (dans le même logement)?

NB Plus d’une réponse possible

living_arrange <- fromJSON('[
        {
          "label": "Seul(e)?",
          "value": 1
        },
        { 
          "label": "Avec votre conjoint(e)?",
          "value": 2
        },
        {
          "label": "Avec votre/vos enfant(s)?",
          "value": 3
        },
        {
          "label": "Avec votre/vos petit(s)-enfant(s)?",
          "value": 4
        },
        {
          "label": "Avec de la parenté ou avec vos frères ou soeurs?",
          "value": 5
        },
        {
          "label": "Avec un(e) ami(e) ou des amis(es)?",
          "value": 6
        },
        {
          "label": "Avec d’autres personnes?",
          "value": 7
        }
      ]')

.ggpdf <- mtl_data %>%
  transmute(interact_id = interact_id,
            living_arrange = strsplit(str_sub(living_arrange, 2, -2), ', ')) %>%
  unnest(living_arrange) %>%
  mutate(living_arrange = as.integer(living_arrange)) %>%
  left_join(living_arrange, by=c("living_arrange"="value")) %>%
  transmute(interact_id = interact_id,
            living_arrange = case_when(is.na(living_arrange) ~ 'Living alone',
                                       TRUE ~ str_sub(label, 1, -2)))

table(.ggpdf$living_arrange, useNA = "ifany") %>%
  knitr::kable(col.names=c('Ménage', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Ménage	N
Avec d’autres personnes	9
Avec de la parenté ou avec vos frères ou soeurs	33
Avec un(e) ami(e) ou des amis(es)	25
Avec votre conjoint(e)	311
Avec votre/vos enfant(s)	166
Avec votre/vos petit(s)-enfant(s)	4
Seul(e)	151

ggplot(.ggpdf) +
  geom_bar(aes(x=living_arrange, y=after_stat(count / sum(count)), fill=living_arrange), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels=percent) + ylab("")

1.4 Quelle catégorie décrit le mieux votre revenu familial annuel brut, si vous tenez compte de toutes vos sources de revenu ?

income <- fromJSON('[
        {
          "label": "Aucun revenu",
          "value": 1
        },
        {
          "label": "1$ à 19 999$",
          "value": 2
        },
        {
          "label": "20 000$ à 29 999$",
          "value": 3
        },
        {
          "label": "30 000$ à 39 999$",
          "value": 4
        },
        {
          "label": "40 000$ à 49 999$",
          "value": 5
        },
        {
          "label": "50 000$ à 74 999$",
          "value": 6
        },
        {
          "label": "75 000$ à 99 999$",
          "value": 7
        },
        {
          "label": "100 000$ à 124 999$",
          "value": 8
        },
        {
          "label": "125 000$ à 149 999$",
          "value": 9
        },
        {
          "label": "150 000$ à 174 999$",
          "value": 10
        },
        {
          "label": "175 000$ à 199 999$",
          "value": 11
        },
        {
          "label": "200 000$ et plus",
          "value": 12
        },
        {
          "label": "Je ne sais pas / je préfère ne pas répondre",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(income, by=c("income2"="value")) %>%
  transmute(interact_id = interact_id,
            income = label)

table(.ggpdf$income, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Revenu', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Revenu	N
Aucun revenu	2
1$ à 19 999$	18
20 000$ à 29 999$	23
30 000$ à 39 999$	30
40 000$ à 49 999$	38
50 000$ à 74 999$	84
75 000$ à 99 999$	71
100 000$ à 124 999$	65
125 000$ à 149 999$	31
150 000$ à 174 999$	40
175 000$ à 199 999$	28
200 000$ et plus	55
Je ne sais pas / je préfère ne pas répondre	51

fillCount = length(unique(.ggpdf$income))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(12, "GnBu"))


ggplot(.ggpdf) +
  geom_bar(aes(y=income, x=after_stat(count / sum(count)), fill=income), show.legend = FALSE) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  scale_x_continuous(labels=percent) + xlab("")

1.5 Quel est votre niveau de scolarité ?

education <- fromJSON('[
        {
          "label": "École primaire",
          "value": 1
        },
        {
          "label": "École secondaire",
          "value": 2
        },
        {
          "label": "CEGEP, collège, technique, métier",
          "value": 3
        },
        {
          "label": "Études universitaires de 1er cycle",
          "value": 4
        },
        {
          "label": "Études universitaires de 2e et 3e cycle",
          "value": 5
        },
        {
          "label": "Je ne sais pas / préfère ne pas répondre",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(education, by=c("education"="value")) %>%
  transmute(interact_id = interact_id,
            education = label)

table(.ggpdf$education, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Scolarité', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Scolarité	N
École primaire	3
École secondaire	21
CEGEP, collège, technique, métier	93
Études universitaires de 1er cycle	187
Études universitaires de 2e et 3e cycle	230
Je ne sais pas / préfère ne pas répondre	2

ggplot(.ggpdf) +
  geom_bar(aes(education, y=after_stat(count / sum(count)), fill=education), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_x_discrete(labels = scales::label_wrap(25)) +
  scale_y_continuous(labels=percent) + ylab("")

1.6 Quel est votre statut d’emploi actuel ?

employment <- fromJSON('[
        {
          "label": "À la retraite et ne travaillant pas",
          "value": 1
        },
        {
          "label": "Employé(e) à temps plein",
          "value": 2
        },
        {
          "label": "Employé(e) à temps partiel",
          "value": 3
        },
        {
          "label": "Sans emploi et à la recherche d’un emploi",
          "value": 4
        },
        {
          "label": "Sans emploi et pas à la recherche d’un emploi",
          "value": 5
        },
        {
          "label": "Autre",
          "value": 99
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(employment, by=c("employment"="value")) %>%
  transmute(interact_id = interact_id,
            employment = label)

table(.ggpdf$employment, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Emploi', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Emploi	N
À la retraite et ne travaillant pas	104
Employé(e) à temps plein	293
Employé(e) à temps partiel	60
Sans emploi et à la recherche d’un emploi	17
Sans emploi et pas à la recherche d’un emploi	12
Autre	50

ggplot(.ggpdf) +
  geom_bar(aes(employment, y=after_stat(count / sum(count)), fill=employment), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_x_discrete(labels = scales::label_wrap(25)) +
  scale_y_continuous(labels=percent) + ylab("")

1.7 À quel(s) groupe(s) ethnique(s) ou culturel(s) appartenez-vous?

NB Plus d’une réponse possible

ethnicity <- fromJSON('[
        {
          "label": "Autochtone",
          "value": 1
        },
        {
          "label": "Asiatique",
          "value": 2
        },
        {
          "label": "Noir",
          "value": 3
        },
        {
          "label": "Blanc",
          "value": 4
        },
        {
          "label": "Latino-Américain",
          "value": 5
        },
        {
          "label": "Moyen-oriental",
          "value": 6
        },
        {
          "label": "Autre",
          "value": 7
        },
        {
          "label": "Je ne sais pas/je préfère ne pas répondre",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(group_id_w1_w2, by="interact_id") %>%
  transmute(interact_id = interact_id,
            group_id = coalesce(group_id, group_id_w1_w2)) %>%
  transmute(interact_id = interact_id,
           group_id = strsplit(str_sub(group_id, 2, -2), ', ')) %>%
  unnest(group_id) %>%
  mutate(group_id = as.integer(group_id)) %>%
  left_join(ethnicity, by=c("group_id"="value")) %>%
  transmute(interact_id = interact_id,
            ethnicity = label) %>%
  filter(!is.na(ethnicity))



table(.ggpdf$ethnicity, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Ethnicité', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Ethnicité	N
Autochtone	5
Asiatique	23
Noir	10
Blanc	470
Latino-Américain	9
Moyen-oriental	11
Autre	5
Je ne sais pas/je préfère ne pas répondre	3

ggplot(.ggpdf) +
  geom_bar(aes(ethnicity, y=after_stat(count / sum(count)), fill=ethnicity), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_x_discrete(labels = scales::label_wrap(20))+
  scale_y_continuous(labels=percent) + ylab("")

1.8 Logement

house_tenure <- fromJSON('[
        {
          "label": "Propriétaire",
          "value": 1
        },
        {
          "label": "Locataire",
          "value": 2
        },
        {
          "label": "Résident chez un parent ou un ami",
          "value": 3
        },
        {
          "label": "Résident ailleurs que chez un parent ou un ami",
          "value": 4
        },
        {
          "label": "Autre",
          "value": 99
        },
        {
          "label": "Je ne sais pas/je préfère ne pas répondre",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))


## rename -7 to NA
mtl_data$house_tenure <- replace(mtl_data$house_tenure, mtl_data$house_tenure < 0, NA)


## à revenir, 23 participants manquants NA sur house_tenure, bien qu'aucun NA dans mtl_dataw1w2 
.ggpdf <- mtl_data %>% 
  left_join(mtl_data_w2w1, by="interact_id") %>%
  select(interact_id, house_tenure, house_tenure_w1, house_tenure_w2) %>%
  transmute(interact_id = interact_id,
            house_tenure = coalesce(house_tenure, house_tenure_w2, house_tenure_w1)) %>%
  left_join(house_tenure, by=c("house_tenure"="value")) %>%
  transmute(interact_id = interact_id,
            house_tenure = label) %>%
  filter(!is.na(house_tenure))

table(.ggpdf$house_tenure, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Logement', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Logement	N
Propriétaire	306
Locataire	183
Résident chez un parent ou un ami	18
Résident ailleurs que chez un parent ou un ami	0
Autre	5
Je ne sais pas/je préfère ne pas répondre	1

ggplot(.ggpdf) +
  geom_bar(aes(house_tenure, y=after_stat(count / sum(count)), fill=house_tenure), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_x_discrete(labels = scales::label_wrap(25))+
  scale_y_continuous(labels=percent) + ylab("")

## créer une catégorie proprio / locataire ou autre 

tenures <- c("Propriétaire", "Locataire", "Autre")


# ramener sur mtl_data

colnames(.ggpdf) [2] <- "house_tenure_full"

mtl_data <- mtl_data %>% 
  left_join(.ggpdf, by="interact_id") 
  

mtl_data$tenure <- ifelse(mtl_data$house_tenure == "Propriétaire", "Propriétaire",
                           ifelse(mtl_data$house_tenure == "Locataire", "Locataire", "Autre"))

1.9 Type de logement

dwelling_type <- fromJSON('[
        {
          "label": "Maison individuelle (unifamiliale)",
          "value": 1
        },
        {
          "label": "Maison jumelée ou une maison double (côte à côte)",
          "value": 2
        },
        {
          "label": "Maison en rangée",
          "value": 3
        },
        {
          "label": "Appartement (ou condo) dans un duplex ou triplex (deux ou trois logements superposés)",
          "value": 4
        },
        {
          "label": "Appartement (ou condo) dans un immeuble de moins de 5 étages",
          "value": 5
        },
        {
          "label": "Appartement (ou condo) dans un immeuble de 5 étages et plus",
          "value": 6
        },
        {
          "label": "Maison mobile ou une roulotte",
          "value": 7
        },
        {
          "label": "Résidence pour aînés",
          "value": 8
        },
        {
          "label": "Autre",
          "value": 99
        },
        {
          "label": "Je ne sais pas/je préfère ne pas répondre",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))


## rename -7 to NA
mtl_data$dwelling_type <- replace(mtl_data$dwelling_type, mtl_data$dwelling_type < 0, NA)

.ggpdf <- mtl_data %>%
  left_join(mtl_data_w2w1, by="interact_id") %>%
  transmute(interact_id = interact_id,
            dwelling_type = coalesce(dwelling_type, dwelling_type_w2, dwelling_type_w1)) %>%
  left_join(dwelling_type, by=c("dwelling_type"="value")) %>%
  transmute(interact_id = interact_id,
            dwelling_type = label)%>%
 filter(!is.na(dwelling_type))

table(.ggpdf$dwelling_type, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Type de logement', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Type de logement	N
Maison individuelle (unifamiliale)	93
Maison jumelée ou une maison double (côte à côte)	44
Maison en rangée	35
Appartement (ou condo) dans un duplex ou triplex (deux ou trois logements superposés)	169
Appartement (ou condo) dans un immeuble de moins de 5 étages	108
Appartement (ou condo) dans un immeuble de 5 étages et plus	50
Maison mobile ou une roulotte	1
Résidence pour aînés	2
Autre	9
Je ne sais pas/je préfère ne pas répondre	2

ggplot(.ggpdf) +
  geom_bar(aes(y=dwelling_type, x=after_stat(count / sum(count)), fill=dwelling_type), show.legend = FALSE) +
  theme_light() +
  #theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_discrete(label=label_wrap(50))+
  scale_x_continuous(labels=percent) + xlab("")

1.10 Statut de participation:

mtl_data %>%
  count(questionnaire) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("hover", full_width = F)

questionnaire	n
Recruté en 2018 ou 2020	369
Recruté en 2022	167

ggplot(mtl_data) +
  geom_bar(aes(questionnaire, y=after_stat(count / sum(count)), fill=questionnaire), show.legend = FALSE) +
  theme_light() +
  #theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey")+
  scale_y_continuous(labels=percent) + ylab("")

2 Mobilité

2.1 Quel est votre mode de transport principal ?

transp_main_mode <- fromJSON('[
        {
          "label": "Marche",
          "value": 1
        },
        {
          "label": "Vélo",
          "value": 2
        },
        {
          "label": "Transport en commun",
          "value": 3
        },
        {
          "label": "Automobile",
          "value": 4
        },
        {
          "label": "Moto ou scooter",
          "value": 5
        },
        {
          "label": "Autre",
          "value": 99
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(transp_main_mode, by=c("transp_main_mode"="value")) %>%
  transmute(interact_id = interact_id,
            transp_main_mode = label)

table(.ggpdf$transp_main_mode, useNA = "ifany") %>%
  as.data.frame() %>%
  arrange(desc(Freq)) %>%
  kableExtra::kable(col.names=c('Principal mode de transport', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Principal mode de transport	N
Automobile	176
Marche	134
Transport en commun	118
Vélo	102
Moto ou scooter	3
Autre	3

mtl_data %>%
  select(transp_main_mode_txt) %>%
  filter(!is.na(transp_main_mode_txt)) %>%
  unique() %>%
  kableExtra::kable(col.names = "Autres modes précisés") %>%
  kableExtra::kable_styling("hover", full_width = F)

Autres modes précisés
AMM
Taxi
fauteuil motorisé

ggplot(count(.ggpdf, transp_main_mode)) +
  geom_bar(aes(y=reorder(transp_main_mode, -n), x=n/nrow(mtl_data), fill=reorder(transp_main_mode, -n)), stat="identity", show.legend = FALSE) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey", direction=-1) +
  scale_x_continuous(labels = percent) +
  ylab("") + xlab("")

2.2 À quelle fréquence vous déplacez-vous avec les modes suivants?

2.2.1 à pied

mtl_data$walk_freq_b2[mtl_data$walk_freq_b2==-7] <- 0
mtl_data$walk_freq_d2[mtl_data$walk_freq_d2==-7] <- 0

.ggpdf <- mtl_data %>%
  select(interact_id, walk_freq_b2, walk_freq_d2) %>%
  pivot_longer(!interact_id, names_to = "saison", values_to = "jours") %>%
  filter(!is.na(jours)) %>%
  transmute(interact_id = interact_id,
            saison = factor(case_when(saison == 'walk_freq_b2' ~ "période hivernale",
                               saison == 'walk_freq_d2' ~ "période estivale")),
# Negative frequencies are set to NA
            jours = case_when(jours >= 0 ~ jours,
                             TRUE ~ NA_integer_))


summary(.ggpdf$jours[.ggpdf$saison=="période hivernale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de marche par semaine en période hivernale") %>% 
  kableExtra::kable_styling("hover", full_width = F)

Jours de marche par semaine en période hivernale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	2	4	3.8	6	7

summary(.ggpdf$jours[.ggpdf$saison=="période estivale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de marche par semaine en période estivale") %>%
  kableExtra::kable_styling("hover", full_width = F)

Jours de marche par semaine en période estivale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	2	5	4.5	7	7

ggplot(.ggpdf) +
  geom_histogram(aes(jours, y=after_stat(count), fill=factor(jours)), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  xlab("jours de marche par semaine") +
    facet_wrap(vars(saison), ncol = 2)

2.2.2 à vélo

## transformer les NA en 0 
mtl_data$bike_freq_b2[mtl_data$bike_freq_b2==-7] <- 0
mtl_data$bike_freq_d2[mtl_data$bike_freq_d2==-7] <- 0



.ggpdf <- mtl_data %>%
  select(interact_id, bike_freq_b2, bike_freq_d2) %>%
  pivot_longer(!interact_id, names_to = "saison", values_to = "jours") %>%
  transmute(interact_id = interact_id,
            saison = factor(case_when(saison == 'bike_freq_b2' ~ "période hivernale",
                               saison == 'bike_freq_d2' ~ "période estivale")),
# Negative frequencies are set to NA
            jours = case_when(jours >= 0 ~ jours,
                             TRUE ~ NA_integer_))


summary(.ggpdf$jours[.ggpdf$saison=="période hivernale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de vélo par semaine en période hivernale") %>% 
  kableExtra::kable_styling("hover", full_width = F)

Jours de vélo par semaine en période hivernale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	0	0.4	0	7

summary(.ggpdf$jours[.ggpdf$saison=="période estivale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de vélo par semaine en période estivale") %>%
  kableExtra::kable_styling("hover", full_width = F)

Jours de vélo par semaine en période estivale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	1	2	4	7

ggplot(.ggpdf) +
  geom_histogram(aes(jours, y=after_stat(count), fill=factor(jours)), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  xlab("jours de vélo par semaine") +
  facet_wrap(vars(saison), ncol = 2)

2.2.3 en transport en commun

## transformer les NA en 0 
mtl_data$transit_freq_b2[mtl_data$transit_freq_b2==-7] <- 0
mtl_data$transit_freq_d2[mtl_data$transit_freq_d2==-7] <- 0



.ggpdf <- mtl_data %>%
  select(interact_id, transit_freq_b2, transit_freq_d2) %>%
  pivot_longer(!interact_id, names_to = "saison", values_to = "jours") %>%
  transmute(interact_id = interact_id,
            saison = factor(case_when(saison == 'transit_freq_b2' ~ "période hivernale",
                               saison == 'transit_freq_d2' ~ "période estivale")),
# Negative frequencies are set to NA
            jours = case_when(jours >= 0 ~ jours,
                             TRUE ~ NA_integer_))


summary(.ggpdf$jours[.ggpdf$saison=="période hivernale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de transport en commun par semaine en période hivernale") %>% 
  kableExtra::kable_styling("hover", full_width = F)

Jours de transport en commun par semaine en période hivernale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	2	2.4	4	7

summary(.ggpdf$jours[.ggpdf$saison=="période estivale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de transport en commun par semaine en période estivale") %>%
  kableExtra::kable_styling("hover", full_width = F)

Jours de transport en commun par semaine en période estivale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	1	1.7	3	7

ggplot(.ggpdf) +
  geom_histogram(aes(jours, y=after_stat(count), fill=factor(jours)), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  xlab("jours de transport en commun par semaine") +
  facet_wrap(vars(saison), ncol = 2)

2.2.4 en voiture

## transformer les NA en 0 
mtl_data$car_freq_b2[mtl_data$car_freq_b2==-7] <- 0
mtl_data$car_freq_d2[mtl_data$car_freq_d2==-7] <- 0



.ggpdf <- mtl_data %>%
  select(interact_id, car_freq_b2, car_freq_d2) %>%
  pivot_longer(!interact_id, names_to = "saison", values_to = "jours") %>%
  transmute(interact_id = interact_id,
            saison = factor(case_when(saison == 'car_freq_b2' ~ "période hivernale",
                               saison == 'car_freq_d2' ~ "période estivale")),
# Negative frequencies are set to NA
            jours = case_when(jours >= 0 ~ jours,
                             TRUE ~ NA_integer_))


summary(.ggpdf$jours[.ggpdf$saison=="période hivernale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de voiture par semaine en période hivernale") %>% 
  kableExtra::kable_styling("hover", full_width = F)

Jours de voiture par semaine en période hivernale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	2	2.4	4	7

summary(.ggpdf$jours[.ggpdf$saison=="période estivale"]) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max"), caption = "Jours de voiture par semaine en période estivale") %>%
  kableExtra::kable_styling("hover", full_width = F)

Jours de voiture par semaine en période estivale
Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	1	2.1	4	7

ggplot(.ggpdf) +
  geom_histogram(aes(jours, y=after_stat(count), fill=factor(jours)), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  xlab("jours de voiture par semaine") +
  facet_wrap(vars(saison), ncol = 2)

2.3 Utilisez-vous ces axes lorsque vous vous déplacez à vélo à Montréal?

Question posée uniquement aux personnes qui rapportent faire du vélo.

use <- fromJSON('[
        {
          "label": "Jamais",
          "value": 0
        },
        {
          "label": "Parfois",
          "value": 1
        },
        {
          "label": "Souvent",
          "value": 2
        },
        {
          "label": "Ne fait pas de vélo",
          "value": -7
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  pivot_longer(starts_with("rev_use"), names_to = "rev", names_prefix = "rev_use_", values_to = "use") %>%
  left_join(use, by=c("use" = "value")) %>%
  mutate(rev = str_to_title(rev),
         rev = factor(rev, levels = unique(rev))) %>%
  transmute(interact_id = interact_id,
            rev = rev,
            use = label)

count(.ggpdf, rev, use) %>%
  pivot_wider(names_from = use, values_from = n) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("hover", full_width = F)

rev	Jamais	Parfois	Souvent	Ne fait pas de vélo
Berri	108	119	67	242
Souligny	249	41	4	242
Peel	210	77	7	242
Bellechasse	128	115	51	242

 # kableExtra::add_header_above(c(" ", "Use" = 2))

# 
# ggplot(filter(.ggpdf, use!='Ne fait pas de vélo')) +
#   geom_bar(aes(use, y=after_stat(count / sum(count)), fill=use), show.legend = FALSE) +
#   theme_light() +
#   theme(axis.text.x=element_text(angle=30,hjust=1)) +
#   scale_fill_brewer(palette="GnBu", na.value = "grey")+
#   ylab("")+
#     facet_wrap(vars(rev), ncol = 2)
# 
# ## compte  
# 
# ggplot(filter(.ggpdf, use!='Ne fait pas de vélo')) +
#   geom_bar(aes(use, y=after_stat(count), fill=use), show.legend = FALSE) +
#   theme_light() +
#   theme(axis.text.x=element_text(angle=30,hjust=1)) +
#   scale_fill_brewer(palette="GnBu", na.value = "grey")+ ylab("")
#     facet_wrap(vars(rev), ncol = 2)

2.4 Proportion de cyclistes dans l’échantillon qui utilise parfois ou souvent ces segments du REV

ggplot(filter(.ggpdf, use=='Parfois' | use == 'Souvent')) +
  geom_bar(aes(rev, y=after_stat(count / sum(count)), fill=rev), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey")+
  scale_y_continuous(labels=percent) + ylab("")

2.5 Utilisation d’au moins un REV, au moins parfois par les cyclistes

Utilisation du REV demandée uniquement aux gens qui ont indiqué se déplacer à vélo.

mtl_data$used_intervention <- ifelse(
  mtl_data$rev_use_berri > 0 | 
  mtl_data$rev_use_peel > 0 | 
  mtl_data$rev_use_souligny > 0 | 
  mtl_data$rev_use_bellechasse > 0, 1, 0)


g <- mtl_data

g$used_intervention <- ifelse(
  g$rev_use_berri > 0 | 
  g$rev_use_peel > 0 | 
  g$rev_use_souligny > 0 | 
  g$rev_use_bellechasse > 0, "Oui", "Non")


table(g$used_intervention) %>%
  knitr::kable(col.names = c("Utilise au moins un axe du REV", "N")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Utilise au moins un axe du REV	N
Non	307
Oui	229

2.6 Dans le contexte actuel, utilisez-vous les éléments suivants plus, moins, ou autant qu’avant la pandémie de la COVID-19 ?

use <- fromJSON('[
        {
          "label": "Jamais",
          "value": 0
        },
        {
          "label": "Parfois",
          "value": 1
        },
        {
          "label": "Souvent",
          "value": 2
        },
        {
          "label": "Ne fait pas de vélo",
          "value": -7
        }
      ]') %>%
  mutate(label = factor(label, levels = label))


cov <- fromJSON('[
        {
          "label": "Moins",
          "value": 1
        },
        {
          "label": "Autant",
          "value": 2
        },
        {
          "label": "Plus",
          "value": 3
        }
      ]') %>%
  mutate(label = factor(label, levels = label))



vas <- fromJSON('[
        {
          "label": "Voies cyclables protégées",
          "value": "_A"
        },
        {
          "label": "Rues piétonnes",
          "value": "_B"
        },
        {
          "label": "Parcs municipaux",
          "value": "_C"
        }, 
        {
          "label": "Espaces publics",
          "value": "_D"
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  pivot_longer(starts_with("cov_decon_vas_"), names_to = "infras", names_prefix = "cov_decon_vas", values_to = "use") %>%
  left_join(cov, by=c("use" = "value")) %>%
  mutate(infras = str_to_title(infras),
         infras = factor(infras, levels = unique(infras))) %>% 
  transmute(interact_id = interact_id,
            infras = infras,
            use = label)

## rename vas
.ggpdf <- .ggpdf %>% 
    left_join(vas, by=c("infras" = "value")) 


count(.ggpdf, label, use) %>%
  pivot_wider(names_from = use, values_from = n) %>%
  kableExtra::kable() %>%
  kableExtra::kable_styling("hover", full_width = F)

label	Moins	Autant	Plus
Voies cyclables protégées	90	334	112
Rues piétonnes	57	346	133
Parcs municipaux	54	332	150
Espaces publics	89	359	88

 # kableExtra::add_header_above(c(" ", "Use" = 2))


# ggplot(filter(.ggpdf, use!='Ne fait pas de vélo')) +
#   geom_bar(aes(use, y=after_stat(count / sum(count)), fill=use), show.legend = FALSE) +
#   theme_light() +
#   theme(axis.text.x=element_text(angle=30,hjust=1)) +
#   scale_fill_brewer(palette="GnBu", na.value = "grey")+
#   ylab("")+
#     facet_wrap(vars(label), ncol = 2)


.ggpdf_pct <- .ggpdf %>% 
  group_by(infras, use, label) %>%
  summarise(n = n()) %>%
  inner_join(count(.ggpdf, infras), by = c("infras"), suffix = c("", ".tot")) %>%
  mutate(percent = n / n.tot) %>%
  select(!n) 

ggplot(.ggpdf_pct)+ 
  geom_bar(aes(x = use, y = percent, fill=use), position = position_dodge2(preserve = "single"), stat = "identity", show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey")+
  ylab("")+
    facet_wrap(vars(label), ncol = 2)

3 Santé

3.1 Activité physique

Minutes d’activité physique totale (activité modérée et vigoureuse) par jour, y compris lors du travail, des loisirs et des déplacements. Calculé à partir des variables modpa (activité physique modérée) et vigpa (activité physique vigoureuse) du questionnaire santé

.ggpdf <- mtl_data %>%
  transmute(interact_id = interact_id,
            mvpa = ((coalesce(vigpa_days, 0) * coalesce(vigpa_freq, 0) + coalesce(modpa_days, 0) * coalesce(modpa_freq, 0))  / 7)) %>%   
  filter(mvpa >= 0 & mvpa < 800) 


# Link back MVPA to main dataset
mtl_data <- mtl_data %>%
  left_join(.ggpdf, by="interact_id") 

summary(mtl_data$mvpa) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max", "NA")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max	NA
0	17.1	41.4	54.7	77.1	428.6	2

fillCount = length(unique(.ggpdf$mvpa))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(mtl_data) +
  geom_histogram(aes(mvpa, y=after_stat(count/sum(count)), fill=factor(mvpa)), binwidth=20, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  xlab("Minutes d'activité modérée ou vigouresuse en moyenne par jour, au cours des 7 derniers jours") +
  scale_y_continuous(labels = percent) + ylab("")

3.2 État de santé général

En général, diriez-vous que votre santé est…

sf1 <- fromJSON('[
        {
          "label": "Excellente",
          "value": 1
        },
        {
          "label": "Très bonne",
          "value": 2
        },
        {
          "label": "Bonne",
          "value": 3
        },
        {
          "label": "Passable",
          "value": 4
        },
        {
          "label": "Mauvaise",
          "value": 5
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(sf1, by=c("sf1"="value")) %>%
  transmute(interact_id = interact_id,
            sf1 = label)

table(.ggpdf$sf1, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('État de santé général', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

État de santé général	N
Excellente	43
Très bonne	172
Bonne	232
Passable	69
Mauvaise	20

ggplot(.ggpdf) +
  geom_bar(aes(sf1, fill=sf1, y=after_stat(count/sum(count))), show.legend = FALSE) +
  theme_light() +
  #theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

3.3 Bien-être

Niveau de satisfaction de la vie globale, où un score de 10 indique une grande satisfaction.

mtl_data <- mtl_data %>%
  mutate(pwb = rowMeans(select(., pwb_b:pwb_h), na.rm = T)) # excluding pwb_a

.ggpdf <- mtl_data %>%
  transmute(interact_id = interact_id,
            pwb = pwb,
            pwb_int = as.integer(round(pwb))) 

summary(.ggpdf$pwb) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
1.9	6.3	7.3	7	8	10

fillCount = length(unique(.ggpdf$pwb_int))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(.ggpdf) +
  geom_histogram(aes(pwb, y=after_stat(count/sum(count)), fill=factor(pwb_int)), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

3.4 Nombre d’amies et amis proches

Combien d’ami(e)s proches avez–vous? (Des personnes avec qui vous n’êtes pas parent, mais avec qui vous êtes à l’aise, à qui vous pouvez dire ce que vous pensez et à qui vous pouvez demander de l’aide)

summary(mtl_data$confide) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	3	5	5.7	7	120

fillCount = length(unique(mtl_data$confide))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(mtl_data) +
  geom_histogram(aes(confide, y=after_stat(count/sum(count)), fill=factor(confide)), binwidth=2, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

3.5 Sentiment d’appartenance

Comment décririez-vous votre sentiment d’appartenance à votre communauté locale?

belonging <- fromJSON('[
        {
          "label": "Très fort",
          "value": 1
        },
        {
          "label": "Plutôt fort",
          "value": 2
        },
        {
          "label": "Plutôt faible",
          "value": 3
        },
        {
          "label": "Très faible",
          "value": 4
        },
        {
          "label": "Je ne sais pas",
          "value": 77
        }
      ]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(belonging, by=c("belonging"="value")) %>%
  transmute(interact_id = interact_id,
            belonging = label)

table(.ggpdf$belonging, useNA = "ifany") %>%
  kableExtra::kable(col.names=c('Sentiment appartenance', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Sentiment appartenance	N
Très fort	36
Plutôt fort	224
Plutôt faible	198
Très faible	54
Je ne sais pas	24

ggplot(.ggpdf) +
  geom_bar(aes(belonging, y=after_stat(count/sum(count)), fill=belonging), show.legend = FALSE) +
  theme_light() +
  theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

3.6 Solitude

Score dérivé des 3 items suivants

À quelle fréquence diriez-vous que

vous manquez de compagnie?
vous vous sentez exclu(e)?
vous vous sentez isolé(e) des autres?

Les réponses possibles sont 1 (Presque jamais), 2 (Parfois) ou 3 (Souvent). Nous avons additionné les scores sur ces trois items pour obtenir un score de 3 à 9.

Un score élevé indique une grande solitude.

mtl_data <- mtl_data %>%
  mutate(loneliness = loneliness_a + loneliness_b + loneliness_c)

summary(mtl_data$loneliness) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
3	3	4	4.7	6	9

ggplot(mtl_data) +
  geom_bar(aes(factor(loneliness), y=after_stat(count/sum(count)), fill=factor(loneliness)), show.legend = F) +
  theme_light() +
  labs(x = "loneliness") +
  scale_fill_brewer(palette="GnBu", na.value = "grey", ) +
  scale_y_continuous(labels = percent) + ylab("")

3.7 Cohésion sociale

Score dérivé en faisant la moyenne des scores pour les 5 énoncés suivants :

C’est un voisinage tissé serré.
Les gens de ce quartier ne s’entendent généralement pas les uns avec les autres.
Les gens de ce quartier sont disposés à aider leurs voisins.
Les gens de ce quartier ne partagent pas les mêmes valeurs.
On peut faire confiance aux gens de ce quartier.

Un score élevé indique une cohésion sociale élevée.

mtl_data <- mtl_data %>%
  mutate(spat_soc_cohesion = (spat2_a + 6 - spat2_b + spat2_c + 6 - spat2_d + spat2_e) / 5)

summary(mtl_data$spat_soc_cohesion) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
1	3	3.4	3.4	4	5

ggplot(mtl_data) +
  geom_bar(aes(factor(as.integer(round(spat_soc_cohesion))), y=after_stat(count/sum(count)), fill=factor(as.integer(round(spat_soc_cohesion)))), show.legend = F) +
  theme_light() +
  labs(x = "spat_soc_cohesion") +
  scale_fill_brewer(palette="GnBu", na.value = "grey", )  +
  scale_y_continuous(labels = percent) + ylab("")

3.8 Interactions du voisinage (informelles)

Fréquence des interactions sociales informelles entre voisins (se dire bonjour ou discuter) par semaine, sur une échelle de 0 (jamais) à 7 (presque quotidiennement).

.existing_cols <- colnames(mtl_data)

mtl_data <- mtl_data %>%
  mutate(spat_talking_nghb = (coalesce(spat_a, 0) + coalesce(spat_b, 0)) /2 / 52) %>%
  select(.existing_cols, spat_talking_nghb)

summary(mtl_data$spat_talking_nghb) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	1	2	2.5	4	7

ggplot(mtl_data) +
  geom_histogram(aes(spat_talking_nghb, y=after_stat(count/sum(count)), fill=factor(as.integer(round(spat_talking_nghb)))), binwidth=1, show.legend = F) +
  theme_light() +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

3.9 Interactions du voisinage (formelles)

Fréquence des interactions sociales formelles entre voisins (visiter ou aller quelque part avec un voisin, donner ou recevoir de l’aide d’un voisin) par semaine, sur une échelle de 0 (jamais) à 7 (presque quotidiennement).

.existing_cols <- colnames(mtl_data)

mtl_data <- mtl_data %>%
  mutate(spat_interact_nghb = (coalesce(spat_c, 0) + coalesce(spat_2e, 0)) / 2 / 52) %>%
  select(.existing_cols, spat_interact_nghb)

summary(mtl_data$spat_interact_nghb) %>%
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max
0	0	0.1	0.3	0.3	3.6

fillCount = length(unique(as.integer(round(mtl_data$spat_interact_nghb))))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(mtl_data) +
  geom_histogram(aes(spat_interact_nghb, y=after_stat(count/sum(count)), fill=factor(as.integer(round(spat_interact_nghb)))), binwidth = 1, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")

4 Perception du quartier

4.1 Dans les deux dernières années, l’environnement urbain de mon quartier s’est..

#change_urbenv

var_name <- mtl_data$change_urbenv
mtl_data$var_name_f <- recode_factor(var_name, "1"="beaucoup amélioré", "2"="un peu amélioré", "3"="n'a pas changé", "4"="un peu détérioré", "5"= "beaucoup détérioré")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(var_name_f) %>%
            dplyr::summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))

##### Figure
p <- ggplot(t_1, aes(var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  guides(fill=FALSE) +
      ylab("Pourcentage") + xlab("")

plot(p)

kable(t_1)  %>%   kableExtra::kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

var_name_f	n	pct
beaucoup amélioré	83	15.49
un peu amélioré	241	44.96
n’a pas changé	143	26.68
un peu détérioré	56	10.45
beaucoup détérioré	13	2.43

4.2 Dans quelle mesure êtes vous en accord ou en désaccord avec les énoncés suivants : Dans mon quartier…

pos <- select(mtl_data, feat_urbenv_d, feat_urbenv_f, feat_urbenv_g, feat_urbenv_j, feat_urbenv_l, feat_urbenv_m, feat_urbenv_o, feat_urbenv_p) %>%
  mutate(feat_urbenv_p = (5 - feat_urbenv_p)) 
pos<- pivot_longer(pos,
   cols = starts_with("feat_urbenv_"),
   names_to = "feature",
   names_prefix = "feat_urbenv_",
   values_to = "values",
   values_drop_na = TRUE)

         
pos$values <- recode_factor(pos$values, "1" = "1. Tout à fait d’accord", "2. " = "2. Un peu d’accord", "3" = "3. Un peu en désaccord" , "4" = "4. Tout à fait en désaccord", "77" = "Je ne sais pas")

## rename 
pos$feature[pos$feature== "d"] <- "Les trottoirs sont en bon état."
pos$feature[pos$feature== "f"] <- "Il y a suffisamment d’arbres le long des rues."
pos$feature[pos$feature== "g"] <- "ll y a plusieurs espaces publics où les gens peuvent relaxer et socialiser."
# missing pos$feature[pos$feature== "h"] <- "h. Les commerces et services sont facilement accessibles."
pos$feature[pos$feature== "j"] <- "Il y a suffisamment d’options de transport en commun à proximité."
pos$feature[pos$feature== "l"] <- "Il y a plusieurs parcs à proximité."
pos$feature[pos$feature== "m"] <- "Il y a beaucoup d’espaces verdis (arbres, jardinières, plates-bandes)."
pos$feature[pos$feature== "o"] <- "Il y a un réseau de pistes cyclables connectées."
pos$feature[pos$feature== "p"] <- "Il y a de l'équipement collectif (bancs, aires de jeu, terrains de sports." ## inverser les réponses



pos <- pos %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(pos, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
  coord_flip() + 
  theme(legend.position="bottom") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  ylab("Pourcentage") + xlab("")+           
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 


 
plot(p)

# Pivot wider to spread values of n and pct across columns

df <- pos

df$pct <- NULL

df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))



kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Tout à fait d’accord	Un peu d’accord	Un peu en désaccord	Tout à fait en désaccord
Il y a beaucoup d’espaces verdis (arbres, jardinières, plates-bandes).	223	207	66	40
Il y a de l’équipement collectif (bancs, aires de jeu, terrains de sports.	258	186	63	29
Il y a plusieurs parcs à proximité.	368	131	29	8
Il y a suffisamment d’arbres le long des rues.	202	184	106	44
Il y a suffisamment d’options de transport en commun à proximité.	303	141	56	36
Il y a un réseau de pistes cyclables connectées.	268	167	60	41
Les trottoirs sont en bon état.	175	233	92	36
ll y a plusieurs espaces publics où les gens peuvent relaxer et socialiser.	230	204	74	28

4.3 Dans quelle mesure êtes vous en accord ou en désaccord avec les énoncés suivants? Dans mon quartier, il y a de plus en plus de…

#increase_urbenv_a

t_1 <- select(mtl_data, increase_urbenv_a,increase_urbenv_b, increase_urbenv_d, increase_urbenv_e, increase_urbenv_g)
t_1 <- pivot_longer(t_1,
   cols = starts_with("increase_urbenv_"),
   names_to = "feature",
   names_prefix = "increase_urbenv_",
   values_to = "values",
   values_drop_na = TRUE)

t_1$values <- recode_factor(t_1$values, "1" = "1. Tout à fait d’accord", "2. " = "2. Un peu d’accord", "3" = "3. Un peu en désaccord" , "4" = "4. Tout à fait en désaccord", "77" = "Je ne sais pas")


## rename 
t_1$feature[t_1$feature== "a"] <- "Pistes cyclables."
t_1$feature[t_1$feature== "b"] <- "Aménagements favorisant les piétons, comme des trottoirs élargis, des dos d’âne et des panneaux d’arrêts."
t_1$feature[t_1$feature== "d"] <- "Ruelles vertes."
t_1$feature[t_1$feature== "e"] <- "Espaces verdis, avec des éléments comme des arbres, des jardins, des jardinières et des bacs à fleurs."
t_1$feature[t_1$feature== "g"] <- "Rues piétonnes."


t_1 <- t_1 %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(t_1, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
    theme(legend.position="bottom") +
     coord_flip() +
 scale_fill_brewer(palette="GnBu", na.value = "grey") +
  ylab("Pourcentage") + xlab("")+      
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 


plot(p)

#kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

df <- t_1
df$pct <- NULL
df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))

kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Tout à fait d’accord	Un peu d’accord	Un peu en désaccord	Tout à fait en désaccord
Aménagements favorisant les piétons, comme des trottoirs élargis, des dos d’âne et des panneaux d’arrêts.	164	224	91	57
Espaces verdis, avec des éléments comme des arbres, des jardins, des jardinières et des bacs à fleurs.	118	244	118	56
Pistes cyclables.	200	181	97	58
Ruelles vertes.	82	180	130	144
Rues piétonnes.	90	131	120	195

4.4 Dans quelle mesure êtes vous en accord ou en désaccord avec les énoncés suivants? Depuis les deux dernières années

#changeeffects_urbenv

t_1 <- select(mtl_data, changeeffects_urbenv_ret_a,changeeffects_urbenv_ret_b, changeeffects_urbenv_ret_d, changeeffects_urbenv_ret_e)
t_1 <- pivot_longer(t_1,
   cols = starts_with("changeeffects_urbenv_ret"),
   names_to = "feature",
   names_prefix = "changeeffects_urbenv_ret_",
   values_to = "values",
   values_drop_na = TRUE)

t_1$values <- recode_factor(t_1$values, "1" = "1. Tout à fait d’accord", "2. " = "2. Un peu d’accord", "3" = "3. Un peu en désaccord" , "4" = "4. Tout à fait en désaccord", "77" = "Je ne sais pas")

## rename 
t_1$feature[t_1$feature== "a"] <- "La Ville investit dans mon quartier."
t_1$feature[t_1$feature== "b"] <- "Les changements dans mon quartier améliorent ma qualité de vie."
t_1$feature[t_1$feature== "d"] <- "Les personnes à faible revenu ont de la difficulté à rester dans ce quartier."
t_1$feature[t_1$feature== "e"] <- "Je me sens de plus en plus anonyme dans mon quartier"

t_1 <- t_1 %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(t_1, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
     coord_flip() +
    theme(legend.position="bottom") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  ylab("Pourcentage") + xlab("")+      
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 


plot(p)

df <- t_1
df$pct <- NULL
df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))

kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Tout à fait d’accord	Un peu d’accord	Un peu en désaccord	Tout à fait en désaccord	Je ne sais pas
Je me sens de plus en plus anonyme dans mon quartier	39	138	204	97	58
La Ville investit dans mon quartier.	112	256	96	58	14
Les changements dans mon quartier améliorent ma qualité de vie.	135	231	90	45	35
Les personnes à faible revenu ont de la difficulté à rester dans ce quartier.	235	171	81	25	24

4.5 Dans quelle mesure êtes vous en accord ou en désaccord avec les énoncés suivants? Les changements dans mon quartier depuis les deux dernières années font qu’il est plus facile de me déplacer :

À pied.
À vélo
En voiture
En transport en commun

#changeeffects_urbenv_trans
mtl_data$changeeffects_urbenv_trans_ret_a[mtl_data$changeeffects_urbenv_trans_ret_a==-7] <- NA
mtl_data$changeeffects_urbenv_trans_ret_b[mtl_data$changeeffects_urbenv_trans_ret_b==-7] <- NA
mtl_data$changeeffects_urbenv_trans_ret_c[mtl_data$changeeffects_urbenv_trans_ret_c==-7] <- NA
mtl_data$changeeffects_urbenv_trans_ret_d[mtl_data$changeeffects_urbenv_trans_ret_d==-7] <- NA


t_1 <- select(mtl_data, changeeffects_urbenv_trans_ret_a,changeeffects_urbenv_trans_ret_b, changeeffects_urbenv_trans_ret_c, changeeffects_urbenv_trans_ret_d)
t_1 <- pivot_longer(t_1,
   cols = starts_with("changeeffects_urbenv_trans_ret_"),
   names_to = "feature",
   names_prefix = "changeeffects_urbenv_trans_ret_",
   values_to = "values",
   values_drop_na = TRUE)

t_1$values <- recode_factor(t_1$values, "1" = "1. Tout à fait d’accord", "2. " = "2. Un peu d’accord", "3" = "3. Un peu en désaccord" , "4" = "4. Tout à fait en désaccord", "77" = "Je ne sais pas")

## rename 
t_1$feature[t_1$feature== "a"] <- "a.   À pied"
t_1$feature[t_1$feature== "b"] <- "b.   À vélo"
t_1$feature[t_1$feature== "c"] <- "c.   En voiture"
t_1$feature[t_1$feature== "d"] <- "d.   En transport en commun"

t_1 <- t_1 %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(t_1, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
     coord_flip() +
    theme(legend.position="bottom") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  ylab("Pourcentage") + xlab("")+   
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 


plot(p)

df <- t_1
df$pct <- NULL
df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))

kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Tout à fait d’accord	Un peu d’accord	Un peu en désaccord	Tout à fait en désaccord
À pied	104	222	108	59
À vélo	104	132	31	27
En voiture	28	120	200	64
En transport en commun	54	157	167	55

5 Gentrification - Questions PACER

PACER est un questionnaire validé sur la gentrification (https://pubmed.ncbi.nlm.nih.gov/34485674/)

5.1 En pensant aux changements dans votre quartier, veuillez identifier dans quelle mesure les changements suivants se sont produits…

# pacer_typechange_a


t_1 <- select(mtl_data, pacer_typechange_b, pacer_typechange_c, pacer_typechange_d, pacer_typechange_e, pacer_typechange_i)
t_1 <- pivot_longer(t_1,
   cols = starts_with("pacer_typechange_"),
   names_to = "feature",
   names_prefix = "pacer_typechange_",
   values_to = "values",
   values_drop_na = TRUE)

t_1$values <- recode_factor(t_1$values, "1"="Non", "2"="Oui un peu", "3"="Oui, c'est beaucoup le cas", "77"="Je ne sais pas")


## rename 
t_1$feature[t_1$feature== "b"] <- "Les commerces de longue date sont remplacés par des commerces différents."        
t_1$feature[t_1$feature== "c"] <- "Des épiceries plus chères ou plus chics s’installent."    
t_1$feature[t_1$feature== "d"] <- "Le coût du logement a augmenté (la location ou l'achat)"        
t_1$feature[t_1$feature== "e"] <- "Les coûts des dépenses nécessaires autres que le logement ont augmenté (par exemple, garde d'enfants, épicerie, transport en commun)"      
t_1$feature[t_1$feature== "i"] <- "Les changements entraînent des tensions ou des conflits avec mes voisins"


t_1 <- t_1 %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(t_1, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
     coord_flip() +
    theme(legend.position="bottom") +
  scale_fill_brewer(palette="GnBu", direction = -1, na.value = "grey") +
      ylab("Pourcentage") + xlab("") + 
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 


plot(p)

df <- t_1
df$pct <- NULL
df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))

kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Non	Oui un peu	Oui, c’est beaucoup le cas	Je ne sais pas
Des épiceries plus chères ou plus chics s’installent.	210	213	71	42
Le coût du logement a augmenté (la location ou l’achat)	3	92	400	41
Les changements entraînent des tensions ou des conflits avec mes voisins	342	64	25	105
Les commerces de longue date sont remplacés par des commerces différents.	104	290	91	51
Les coûts des dépenses nécessaires autres que le logement ont augmenté (par exemple, garde d’enfants, épicerie, transport en commun)	20	182	292	42

5.2 En quoi les personnes qui déménagent dans votre quartier sont-elles différentes de vous? Cochez toutes les cases qui s’appliquent.

Posée seulement aux personnes qui ont indiqué qu’il y avait beaucoup de nouvelles personnes dans le quartier (n=256).

# 1 Racial or ethnic background Origine raciale ou ethnique
# 2 Income or wealth    Revenu ou richesse
# 3 Job or employment   Emploi
# 4 Education   Éducation
# 5 They are students   Ce sont des étudiants
# 6 Family structure    Structure familiale
# 7 Age Âge
# 8 Religion    Religion
# 9 Culture and values  Culture et valeurs
# 10    The activities they enjoy   Les activités qu’elles aiment
# 99    Other   Autre, veuillez spécifier
# -7    Not applicable  Non applicable

mtl_data$pacer_differentpeople_1[mtl_data$pacer_differentpeople_1==-7] <- NA
mtl_data$pacer_differentpeople_2[mtl_data$pacer_differentpeople_2==-7] <- NA
mtl_data$pacer_differentpeople_4[mtl_data$pacer_differentpeople_4==-7] <- NA
mtl_data$pacer_differentpeople_5[mtl_data$pacer_differentpeople_5==-7] <- NA
mtl_data$pacer_differentpeople_6[mtl_data$pacer_differentpeople_6==-7] <- NA
mtl_data$pacer_differentpeople_7[mtl_data$pacer_differentpeople_7==-7] <- NA
mtl_data$pacer_differentpeople_9[mtl_data$pacer_differentpeople_9==-7] <- NA

mtl_data$pacer_differentpeople_1[mtl_data$pacer_differentpeople_1==0] <- 2
mtl_data$pacer_differentpeople_2[mtl_data$pacer_differentpeople_2==0] <- 2
mtl_data$pacer_differentpeople_4[mtl_data$pacer_differentpeople_4==0] <- 2
mtl_data$pacer_differentpeople_5[mtl_data$pacer_differentpeople_5==0] <- 2
mtl_data$pacer_differentpeople_6[mtl_data$pacer_differentpeople_6==0] <- 2
mtl_data$pacer_differentpeople_7[mtl_data$pacer_differentpeople_7==0] <- 2
mtl_data$pacer_differentpeople_9[mtl_data$pacer_differentpeople_9==0] <- 2
mtl_data$pacer_differentpeople_99[mtl_data$pacer_differentpeople_99==0] <- 2

t_1 <- select(mtl_data, pacer_differentpeople_1,pacer_differentpeople_2, pacer_differentpeople_4, pacer_differentpeople_5, pacer_differentpeople_6, pacer_differentpeople_7, pacer_differentpeople_9, pacer_differentpeople_99)
t_1 <- pivot_longer(t_1,
   cols = starts_with("pacer_differentpeople_"),
   names_to = "feature",
   names_prefix = "pacer_differentpeople_",
   values_to = "values",
   values_drop_na = TRUE)

t_1$values <- recode_factor(t_1$values, "1" = "Oui", "2" = "Non", "77" = "Je ne sais pas")


## rename 
t_1$feature[t_1$feature== "1"] <- " Origine raciale ou ethnique"    
t_1$feature[t_1$feature== "2"] <- " Revenu ou richesse"  
t_1$feature[t_1$feature== "4"] <- " Éducation"     
t_1$feature[t_1$feature== "5"] <- " Ce sont des étudiants"
t_1$feature[t_1$feature== "6"] <- " Structure familiale"  
t_1$feature[t_1$feature== "7"] <- " Âge"     
t_1$feature[t_1$feature== "9"] <- " Culture et valeurs"
t_1$feature[t_1$feature== "99"] <- "Autre"

INTERACTPaletteYN <- c("#1596FF", "#404041", "#EBF0F8") #3


t_1 <- t_1 %>% 
  group_by(feature, values) %>% 
  dplyr::summarise(n = n()) %>%
  dplyr:: mutate(pct = round(100*n/sum(n),2))

p <- ggplot(t_1, aes(x= feature, y= pct, fill= values)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
     coord_flip() +
    scale_fill_manual(values = INTERACTPaletteYN) +
      ylab("Pourcentage") +
      xlab("") + 
  scale_x_discrete(labels = function(feature) str_wrap(feature, width = 30)) 

plot(p)

df <- t_1
df$pct <- NULL
df <- df  %>% 
  pivot_wider(names_from = values, 
              values_from = c(n))

kable(df)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

feature	Oui	Non
Ce sont des étudiants	38	498
Culture et valeurs	87	449
Origine raciale ou ethnique	121	415
Revenu ou richesse	124	412
Structure familiale	86	450
Âge	99	437
Éducation	35	501
Autre	29	507

5.2.1 Les personnes ayant répondu “autre” ont spécifié avec les éléments suivants

##### Other- write-in answers 



mtl_data %>%
  select(pacer_differentpeople_txt) %>%
  filter(!is.na(pacer_differentpeople_txt)) %>%
  unique() %>%
  kableExtra::kable(col.names = "Autres différences rapportées") %>%
  kableExtra::kable_styling("hover", full_width = F)

	Autres différences rapportées
1	Beaucoup de français viennent et repartent, cela fait monter les prix des logements. Plusieurs touristes rbnb aussi font monter le prix des logements. Plusieurs familles de toutes nationalités et revenus s’installent et j’aime cette diversité et c’est agréable lorsque les personnes s’installent à plus long terme et s’impliquent dans le quartier. De plus en plus de restaurants asiatiques s’installent et j’aime cette cuisine. D’autres types de restaurants comme indiens, libanais aussi, j’aime bien! Par contre, j’aime un peu moins les condos car ça créer une barrière alors que eux se tiennent tous ensemble dans leur propre cours commune et c’est trop hermétique, à mon goût. Je préfère qu’il y ait des liens avec les voisins comme la ruelle, la rue piétonne et les parcs, par exemple, qui favorisent les rencontres entre voisins de tout acabit.
2	There is airb&b renters in my building, transient people
3	I don’t know them so can’t say. There is a building boom in this neighborhood
4	religiosity
5	Non LGBT
6	Ils n’ont pas de différence.
7	Je ne ressens pas de différence
8	Je ne connais pas assez bien le quartier pour répondre, j’y vis depuis six mois seulement
9	Heureusement!
10	langue
11	Très difficile de répondre à cette question
12	Aucune différence notable
13	Pas de différence
14	Ne sont pas différentes
15	Rien de notable
16	ils sont tous différents les uns des autres.
17	Ne sont pas différents de moi : les nouvelles personnes qui s’installent à Verdun sont comme moi
18	Rien elles sont semblables
19	J’ai déménagé dans un quartier moins riche pour acheter et je participe à la gentrification du quartier.
20	Je ne sais pas
21	Langue anglaise
22	On entend de plus en plus d’anglais.
23	langue parlée (anglais)
24	les personnes qui déménagent dans mon quartier sont plutôt semblables à moi
25	S o.
26	Je les trouve plutôt semblables, pas différents
28	ces personnes me ressemblent parce que je fais aussi partie de l’embourgeoisement de mon quartier.
29	not very different

5.3 Sur une échelle de 1 à 10, 1 étant le moins et 10 étant le plus, dans l’ensemble, combien de changement s’est produit dans votre quartier au cours des trois à cinq dernières années?

#pacer_change

var_name <- mtl_data$pacer_change
mtl_data$var_name_f <- recode_factor(var_name, "1" = "1. Moins de changement",
                                                "2" = "2", 
                                                "3" = "3", 
                                                "4" = "4", 
                                                "5" = "5", 
                                                "6" = "6", 
                                                "7" = "7",
                                                "8" = "8",
                                                "9" = "9", 
                               "10" = "10. Plus de changement")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(var_name_f) %>%
            dplyr:: summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))


fillCount = length(unique(t_1$var_name_f))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(10, "GnBu"))

##### Figure
p <- ggplot(t_1, aes(x = var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +

    guides(fill=FALSE) +
      ylab("Pourcentage") +
      xlab("") 

plot(p)

kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

var_name_f	n	pct
Moins de changement	9	1.68
2	15	2.80
3	37	6.90
4	40	7.46
5	72	13.43
6	110	20.52
7	141	26.31
8	80	14.93
9	20	3.73
Plus de changement	12	2.24

5.4 Sur une échelle de 1 à 10, 1 étant le plus lent et 10 étant le plus vite, à quelle vitesse les changements se sont-ils produits dans votre quartier au cours des trois à cinq dernières années?

#pacer_speed    
var_name <- mtl_data$pacer_speed
mtl_data$var_name_f <- recode_factor(var_name, "1" = "1. Très lent",
                                                "2" = "2", 
                                                "3" = "3", 
                                                "4" = "4", 
                                                "5" = "5", 
                                                "6" = "6", 
                                                "7" = "7",
                                                "8" = "8",
                                                "9" = "9",
                               "10" = "10. Très vite")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(var_name_f) %>%
            dplyr:: summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))


fillCount = length(unique(t_1$var_name_f))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(10, "GnBu"))

##### Figure
p <- ggplot(t_1, aes(x = var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  guides(fill=FALSE) +
      ylab("Pourcentage") 

plot(p)

kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

var_name_f	n	pct
Très lent	18	3.36
2	22	4.10
3	55	10.26
4	57	10.63
5	93	17.35
6	114	21.27
7	95	17.72
8	56	10.45
9	14	2.61
Très vite	12	2.24

5.5 Sur une échelle de 1 à 10, 1 étant pas du tout et 10 étant beaucoup, pensez-vous que votre quartier subit de la gentrification (ou embourgeoisement)?

#gentri_percep   
var_name <- mtl_data$gentri_percep
mtl_data$var_name_f <- recode_factor(var_name, "1" = "1. Pas du tout", "2" = "2", 
                                                "3" = "3", 
                                                "4" = "4", 
                                                "5" = "5", 
                                                "6" = "6", 
                                                "7" = "7",
                                                "8" = "8",
                                                "9" = "9",
                               "10" = "10. Beaucoup")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(var_name_f) %>%
            dplyr:: summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))

##### Figure
p <- ggplot(t_1, aes(x = var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=0, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  guides(fill=FALSE) +
      ylab("Pourcentage") +
      xlab("") 
plot(p)

kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

var_name_f	n	pct
Pas du tout	27	5.04
2	34	6.34
3	35	6.53
4	40	7.46
5	52	9.70
6	79	14.74
7	92	17.16
8	81	15.11
9	43	8.02
Beaucoup	53	9.89

6 Logement

6.1 Si vous aviez le choix, combien de temps vivriez-vous dans votre maison actuelle ?

#neigh_stay 

var_name <- mtl_data$neigh_stay
mtl_data$var_name_f <- recode_factor(var_name, "1" = "Je déménagerais maintenant", "2" = "Moins de 3 ans", "3" = "3 à 5 ans", "4" = "Plus de 5 ans mais moins de 10 ans", "5"= "10 ans ou plus")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(var_name_f) %>%
            dplyr::summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))

##### Figure
p <- ggplot(t_1, aes(var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=30, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
    guides(fill=FALSE) +
      ylab("Pourcentage") +
      xlab("") 
plot(p)

kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

var_name_f	n	pct
Je déménagerais maintenant	54	10.07
Moins de 3 ans	72	13.43
3 à 5 ans	65	12.13
Plus de 5 ans mais moins de 10 ans	84	15.67
10 ans ou plus	261	48.69

6.2 Dans quelle mesure êtes vous confiant(e) que vous pourriez vous reloger dans votre quartier, si vous deviez quitter votre maison actuelle ?

#neigh_relocate

var_name <- mtl_data$neigh_relocate
mtl_data$var_name_f <- recode_factor(var_name, "1" = "Très confiant(e)", "2" = "Assez confiant(e)", "3" = "Peu confiant(e)", "4" = "Pas du tout confiant(e)")
var_name_f <- mtl_data$var_name_f

##### Table
t_1 <- mtl_data %>%
          group_by(tenure, var_name_f) %>%
            dplyr::summarise(n = n()) %>%
            dplyr:: mutate(pct = round(100*n/sum(n),2))%>%
  filter(!is.na(tenure))


##### Figure
p <- ggplot(t_1, aes(var_name_f,  y = pct, fill = var_name_f)) + theme(axis.text.x = element_text(angle=30, vjust = .6)) + 
  geom_bar(stat= "identity") +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
    guides(fill=FALSE) +
      ylab("Pourcentage") +
      xlab("") +
    facet_wrap(vars(tenure), ncol = 3) 

plot(p)

kable(t_1)  %>%   kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

tenure	var_name_f	n	pct
Autre	Très confiant(e)	21	8.97
Autre	Assez confiant(e)	86	36.75
Autre	Peu confiant(e)	78	33.33
Autre	Pas du tout confiant(e)	49	20.94

6.3 Dans quelle mesure craignez-vous d’être poussé(e) ou forcé(e) à quitter votre logement dans les prochaines années?

Par exemple, à cause d’une augmentation de loyer, des rénovations majeures, une reprise de logement, une éviction ou une rénoviction.

NB Question posée uniquement aux non-propriétaires rapporté à la v3

forced <- fromJSON('[
        {
          "label": "Beaucoup",
          "value": 1
        },
        {
          "label": "Un peu",
          "value": 2
        },
        {
          "label": "Pas vraiment",
          "value": 3
        },
        {
          "label": "Pas du tout",
          "value": 4
        }]') %>%
  mutate(label = factor(label, levels = label))

.ggpdf <- mtl_data %>%
  left_join(forced, by=c("forced_leaving_home"="value")) %>%
  transmute(interact_id = interact_id,
            forced = label)

table(.ggpdf$forced) %>%
  kableExtra::kable(col.names=c('Crainte', 'N')) %>%
  kableExtra::kable_styling("hover", full_width = F)

Crainte	N
Beaucoup	24
Un peu	24
Pas vraiment	39
Pas du tout	41

.ggpdf <- .ggpdf %>%
  filter(!is.na(forced))

ggplot(.ggpdf) +
  geom_bar(aes(forced, y=after_stat(count / sum(count)), fill=forced), show.legend = FALSE) +
  theme_light() +
    theme(axis.text.x=element_text(angle=30,hjust=1)) +
  scale_fill_brewer(palette="GnBu", na.value = "grey") +
  scale_y_continuous(labels = percent) + ylab("")+ xlab("")

6.4 Coût de logement

6.4.1 Pour locataires

## locataire 

mtl_data$housing_cost_a<- replace(mtl_data$housing_cost_a, mtl_data$housing_cost_a< 0, NA)
mtl_data$housing_cost_a<- replace(mtl_data$housing_cost_a, mtl_data$housing_cost_a> 100000, NA)


summary(mtl_data$housing_cost_a) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max", "NA")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max	NA
0	715	922.5	1007.5	1228.8	2600	422

fillCount = length(unique(mtl_data$housing_cost_a))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

ggplot(mtl_data) +
  geom_histogram(aes(housing_cost_a, y=after_stat(count/sum(count)), fill=factor(housing_cost_a)), binwidth=20, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  xlab("Coût du loyer mensuel pour locataires") +
  scale_y_continuous(labels = percent) + ylab("")

6.4.2 Pour propriétaires

## proprio

mtl_data$housing_cost_b<- replace(mtl_data$housing_cost_b, mtl_data$housing_cost_b< 0, NA)


summary(mtl_data$housing_cost_b) %>% 
  as.list() %>%
  data.frame() %>%
  knitr::kable(digits = 1, col.names = c("Min", "1er Qu.", "Médiane", "Moyenne", "3e Qu.", "Max", "NA")) %>%
  kableExtra::kable_styling("hover", full_width = F)

Min	1er Qu.	Médiane	Moyenne	3e Qu.	Max	NA
0	150	1000	1192.9	1500	10000	451

fillCount = length(unique(mtl_data$housing_cost_b))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))

mtl_data$housing_cost_b<- replace(mtl_data$housing_cost_b, mtl_data$housing_cost_b > 9999, NA)

ggplot(mtl_data) +
  geom_histogram(aes(housing_cost_b, y=after_stat(count/sum(count)), fill=factor(housing_cost_b)), binwidth=20, show.legend = F) +
  theme_light() +
  scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
  xlab("Coût de l’hypothèque mensuel") +
  scale_y_continuous(labels = percent) + ylab("")

INTERACT: Résultats de la vague 3 (2022)

13 mars, 2024