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)