INTERACT Montréal Participant VERITAS Summary - W2 - new and returning

1 VERITAS dataset description

Unlike the Eligibility or Health questionnaires, which can mostly be encoded as a flat table, the VERITAS questionnaire implicitly records a series of entities and their relationships:

• Places: list of geocoded locations visited by participants, along with the following characteristics: category, name, visit frequency, transportation mode
• Social contacts: people and/or groups frequented by participants
• Relationships: between social contacts (who knows who / who belongs to which group) as well as between locations and social contacts (places visited along with whom)

The diagram below illustrates the various entities collected throught the VERITAS questionnaire:

VERITAS entities

New participants and returning participants are presented separately below, as they were presented tow slightly different question flows.

2 Basic descriptive statistics for new participants

2.1 Section 1: Residence and Neighbourhood

2.1.1 Now, let’s start with your home. What is your address?

home_location <- locations[locations$location_category == 1, ]

## version ggmap
mtl_aoi <- st_bbox(home_location[home_location$interact_id != 401905010, ]) # Drop this returning participant who moved to Toronto
names(mtl_aoi) <- c("left", "bottom", "right", "top")
mtl_aoi[["left"]] <- mtl_aoi[["left"]] - .07
mtl_aoi[["right"]] <- mtl_aoi[["right"]] + .07
mtl_aoi[["top"]] <- mtl_aoi[["top"]] + .01
mtl_aoi[["bottom"]] <- mtl_aoi[["bottom"]] - .01

bm <- get_stadiamap(mtl_aoi, zoom = 11, maptype = "stamen_toner_lite") %>%
  ggmap(extent = "device")
bm + geom_sf(data = st_jitter(home_location, .008), inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

NB: Home locations have been randomly shifted from their original position to protect privacy.

# Number of participants by municipalites
home_by_municipalites <- st_join(home_location, municipalities["NAME"])
home_by_mun_cnt <- as.data.frame(home_by_municipalites) %>%
  group_by(NAME) %>%
  dplyr::count() %>%
  arrange(desc(n), NAME)
home_by_mun_cnt$Shape <- NULL
kable(home_by_mun_cnt, caption = "Number of participants by municipalities") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of participants by municipalities

NAME	n
Montréal	176
Longueuil	9
Laval	8
Brossard	4
Pointe-Claire	3
Dollard-Des Ormeaux	2
Dorval	2
Kirkland	2
Candiac	1
Rosemère	1
Saint-Lambert	1
Toronto	1
Westmount	1

2.1.2 When did you move to your current address?

# N of addresses by date of move
year_of_move <- veritas_main[c("interact_id", "home_move_date")]
year_of_move$home_move_date <- year(ymd(year_of_move$home_move_date))
ggplot(data = year_of_move) +
  geom_histogram(aes(x = home_move_date))

# recode date of move
year_of_move$home_move_date_recode <- as.character(year_of_move$home_move_date)
year_of_move$home_move_date_recode[year_of_move$home_move_date <= 2005] <- "2005 - 2001"
year_of_move$home_move_date_recode[year_of_move$home_move_date <= 2000] <- "2000 - 1991"
year_of_move$home_move_date_recode[year_of_move$home_move_date <= 1990] <- paste("1990 -", min(year_of_move$home_move_date))

year_of_move_cnt <- year_of_move %>%
  group_by(home_move_date_recode) %>%
  dplyr::count() %>%
  arrange(desc(home_move_date_recode))
kable(year_of_move_cnt, caption = "Year of move to current address") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Year of move to current address

home_move_date_recode	n
2020	31
2019	43
2018	17
2017	14
2016	14
2015	5
2014	6
2013	5
2012	8
2011	7
2010	4
2009	3
2008	3
2007	2
2006	3
2005 - 2001	14
2000 - 1991	18
1990 - 1959	14

2.1.3 If you were asked to draw the boundaries of your neighbourhood, what would they be?

prn <- poly_geom[poly_geom$area_type == "neighborhood", ]

## version ggmap
bm + geom_sf(data = prn, inherit.aes = FALSE, fill = alpha("blue", 0.05), color = alpha("blue", 0.3))

# Min, max, median & mean area of PRN
prn$area_m2 <- st_area(prn$geom)
kable(t(as.matrix(summary(prn$area_m2))),
  caption = "Area (in square meters) of the perceived residential neighborhood",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived residential neighborhood

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
936.7	1549311	2917435	5860509	5402688	99161934

NB only 176 valid neighborhoods were collected, as many participants struggled to draw polygons on the map.

2.1.4 How attached are you to your neighbourhood?

# extract and recode
.ngh_att <- veritas_main[veritas_main$neighbourhood_attach != 99, c("interact_id", "neighbourhood_attach")] %>%
  dplyr::rename(neighbourhood_attach_code = neighbourhood_attach)
.ngh_att$neighbourhood_attach <- factor(ifelse(.ngh_att$neighbourhood_attach_code == 1, "1 [Not attached at all]",
  ifelse(.ngh_att$neighbourhood_attach_code == 6, "6 [Very attached]",
    .ngh_att$neighbourhood_attach_code
  )
))

# histogram of attachment
ggplot(data = .ngh_att) +
  geom_histogram(aes(x = neighbourhood_attach), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "neighbourhood_attach")

.ngh_att_cnt <- .ngh_att %>%
  group_by(neighbourhood_attach) %>%
  dplyr::count() %>%
  arrange(neighbourhood_attach)
kable(.ngh_att_cnt, caption = "Neigbourhood attachment") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Neigbourhood attachment

neighbourhood_attach	n
1 [Not attached at all]	13
2	15
3	14
4	39
5	66
6 [Very attached]	60

2.1.5 On average, how many hours per day do you spend outside of your home?

# histogram of n hours out
ggplot(data = veritas_main) +
  geom_histogram(aes(x = hours_out))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$hours_out))),
  caption = "Hours/day outside home",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Hours/day outside home

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	3	4.8	7.5	24

2.1.6 Of this time spent outside your home, on average how many hours do you spend outside your neighbourhood?

# histogram of n hours out
ggplot(data = veritas_main) +
  geom_histogram(aes(x = hours_out_neighb))

# Min, max, median & mean hours/day out of neighborhood
kable(t(as.matrix(summary(veritas_main$hours_out_neighb))),
  caption = "Hours/day outside neighbourhood",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Hours/day outside neighbourhood

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	1	2.9	4.5	20

2.1.7 Are there one or more areas close to where you live that you tend to avoid because you do not feel safe there (for any reason)?

# extract and recode
.unsafe <- veritas_main[c("interact_id", "unsafe_area")] %>% dplyr::rename(unsafe_area_code = unsafe_area)
.unsafe$unsafe_area <- factor(ifelse(.unsafe$unsafe_area_code == 1, "1 [Yes]",
  ifelse(.unsafe$unsafe_area_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .unsafe) +
  geom_histogram(aes(x = unsafe_area), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "unsafe_area")

.unsafe_cnt <- .unsafe %>%
  group_by(unsafe_area) %>%
  dplyr::count() %>%
  arrange(unsafe_area)
kable(.unsafe_cnt, caption = "Unsafe areas") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Unsafe areas

unsafe_area	n
1 [Yes]	36
2 [No]	175

# map
unsafe <- poly_geom[poly_geom$area_type == "unsafe area", ]

## version ggmap
bm + geom_sf(data = unsafe, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
unsafe$area_m2 <- st_area(unsafe$geom)
kable(t(as.matrix(summary(unsafe$area_m2))),
  caption = "Area (in square meters) of the perceived unsafe area",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived unsafe area

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
5994.4	86160	328280.3	847568.3	986583.9	6752730

2.1.8 Do you spend the night somewhere other than your home at least once per week?

# extract and recode
.o_res <- veritas_main[c("interact_id", "other_resid")] %>% dplyr::rename(other_resid_code = other_resid)
.o_res$other_resid <- factor(ifelse(.o_res$other_resid_code == 1, "1 [Yes]",
  ifelse(.o_res$other_resid_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .o_res) +
  geom_histogram(aes(x = other_resid), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "other_resid")

.o_res_cnt <- .o_res %>%
  group_by(other_resid) %>%
  dplyr::count() %>%
  arrange(other_resid)
kable(.o_res_cnt, caption = "Other residence") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Other residence

other_resid	n
1 [Yes]	37
2 [No]	174

2.2 Section 2: Occupation

2.2.1 Are you currently working?

# extract and recode
.work <- veritas_main[c("interact_id", "working")] %>% dplyr::rename(working_code = working)
.work$working <- factor(ifelse(.work$working_code == 1, "1 [Yes]",
  ifelse(.work$working_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .work) +
  geom_histogram(aes(x = working), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "working")

.work_cnt <- .work %>%
  group_by(working) %>%
  dplyr::count() %>%
  arrange(working)
kable(.work_cnt, caption = "Currently working") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Currently working

working	n
1 [Yes]	143
2 [No]	68

2.2.2 Where do you work?

work_location <- locations[locations$location_category == 3, ]

bm + geom_sf(data = work_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

2.2.3 On average, how many hours per week do you work?

# histogram of n hours out
ggplot(data = veritas_main[veritas_main$working == 1, ]) +
  geom_histogram(aes(x = work_hours))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$work_hours[veritas_main$working == 1]))),
  caption = "Work hours/week",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Work hours/week

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	28	35	31.7	40	60

2.2.4 Are you currently a registered student?

# extract and recode
.study <- veritas_main[c("interact_id", "studying")] %>% dplyr::rename(studying_code = studying)
.study$studying <- factor(ifelse(.study$studying_code == 1, "1 [Yes]",
  ifelse(.study$studying_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .study) +
  geom_histogram(aes(x = studying), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Studying")

.study_cnt <- .study %>%
  group_by(studying) %>%
  dplyr::count() %>%
  arrange(studying)
kable(.study_cnt, caption = "Currently studying") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Currently studying

studying	n
1 [Yes]	40
2 [No]	171

2.2.5 Where do you study?

study_location <- locations[locations$location_category == 4, ]

bm + geom_sf(data = study_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

2.2.6 On average, how many hours per week do you study?

# histogram of n hours out
ggplot(data = veritas_main[veritas_main$studying == 1, ]) +
  geom_histogram(aes(x = study_hours))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$study_hours[veritas_main$studying == 1]))),
  caption = "study hours/week",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

study hours/week

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	8.8	16.5	17.6	26.2	40

2.3 Section 3: Shopping activities

The following questions are used to generate the locations grouped into this section:

1. Do you shop for groceries at a supermarket at least once per month?
2. Do you shop at a public/farmer’s market at least once per month?
3. Do you shop at a bakery at least once per month?
4. Do you go to a specialty food store at least once per month? For example: a cheese shop, fruit and vegetable store, butcher’s shop, natural and health food store.
5. Do you go to a convenience store at least once per month?
6. Do you go to a liquor store at least once per month?

shop_lut <- data.frame(
  location_category_code = c(5, 6, 7, 8, 9, 10),
  location_category = factor(c(
    " 5 [Supermarket]",
    " 6 [Public/farmer’s market]",
    " 7 [Bakery]",
    " 8 [Specialty food store]",
    " 9 [Convenience store/Dépanneur]",
    "10 [Liquor store/SAQ]"
  ))
)
shop_location <- locations[locations$location_category %in% shop_lut$location_category_code, ] %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(shop_lut, by = "location_category_code")

# map
bm + geom_sf(data = shop_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = shop_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Shopping locations by categories")

.location_category_cnt <- as.data.frame(shop_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
5 [Supermarket]	555
6 [Public/farmer’s market]	72
7 [Bakery]	127
8 [Specialty food store]	131
9 [Convenience store/Dépanneur]	88
10 [Liquor store/SAQ]	136

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(shop_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE to build list of all combination iid/shopping categ
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = shop_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_shop_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)
.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_shop_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of shopping locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of shopping locations by participant and category

location_category	min	mean	median	max
5 [Supermarket]	0	2.63	3	5
6 [Public/farmer’s market]	0	0.34	0	2
7 [Bakery]	0	0.60	0	4
8 [Specialty food store]	0	0.62	0	5
9 [Convenience store/Dépanneur]	0	0.42	0	4
10 [Liquor store/SAQ]	0	0.64	0	4

2.4 Section 4: Services

The following questions are used to generate the locations grouped into this section:

1. Where is the bank you go to most often located?
2. Where is the hair salon or barber shop you go to most often?
3. Where is the post office where you go to most often?
4. Where is the drugstore you go to most often?
5. If you need to visit a doctor or other healthcare provider, where do you go most often?

serv_lut <- data.frame(
  location_category_code = c(11, 12, 13, 14, 15),
  location_category = factor(c(
    "11 [Bank]",
    "12 [Hair salon/barbershop]",
    "13 [Post office]",
    "14 [Drugstore]",
    "15 [Doctor/healthcare provider]"
  ))
)
serv_location <- locations[locations$location_category %in% serv_lut$location_category_code, ] %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(serv_lut, by = "location_category_code")

# map
bm + geom_sf(data = serv_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = serv_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Service locations by categories")

.location_category_cnt <- as.data.frame(serv_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
11 [Bank]	147
12 [Hair salon/barbershop]	90
13 [Post office]	127
14 [Drugstore]	181
15 [Doctor/healthcare provider]	123

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(serv_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = serv_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_serv_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)
.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_serv_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of shopping locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of shopping locations by participant and category

location_category	min	mean	median	max
11 [Bank]	0	0.70	1	1
12 [Hair salon/barbershop]	0	0.43	0	1
13 [Post office]	0	0.60	1	1
14 [Drugstore]	0	0.86	1	1
15 [Doctor/healthcare provider]	0	0.58	0	5

2.5 Section 5: Transportation

2.5.1 Do you use public transit from your home?

# extract and recode
.transp <- veritas_main[c("interact_id", "public_transit")] %>% dplyr::rename(public_transit_code = public_transit)
.transp$public_transit <- factor(ifelse(.transp$public_transit_code == 1, "1 [Yes]",
  ifelse(.transp$public_transit_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .transp) +
  geom_histogram(aes(x = public_transit), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "public_transit")

.transp_cnt <- .transp %>%
  group_by(public_transit) %>%
  dplyr::count() %>%
  arrange(public_transit)
kable(.transp_cnt, caption = "Use public transit") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Use public transit

public_transit	n
1 [Yes]	87
2 [No]	124

2.5.2 Where are the public transit stops that you access from your home?

transp_location <- locations[locations$location_category == 16, ]

bm + geom_sf(data = transp_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

2.6 Section 6: Leisure activities

The following questions are used to generate the locations grouped into this section:

1. Do you participate in any (individual or group) sports or leisure-time physical activities at least once per month?
2. Do you visit a park at least once per month?
3. Do you participate in or attend as a spectator a cultural or non-sport leisure activity at least once per month? For example: singing or drawing lessons, book or poker club, concert or play.
4. Do you volunteer at least once per month?
5. Do you engage in any religious or spiritual activities at least once per month?
6. Do you go to a restaurant, café, bar or other food and drink establishment at least once per month?
7. Do you get take-out food at least once per month?
8. Do you regularly go for walks?

leisure_lut <- data.frame(
  location_category_code = c(17, 18, 19, 20, 21, 22, 23, 24),
  location_category = factor(c(
    "17 [Leisure-time physical activity]",
    "18 [Park]",
    "19 [Cultural activity]",
    "20 [Volunteering place]",
    "21 [Religious or spiritual activity]",
    "22 [Restaurant, café, bar, etc. ]",
    "23 [Take-out]",
    "24 [Walk]"
  ))
)
leisure_location <- locations[locations$location_category %in% leisure_lut$location_category_code, ] %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(leisure_lut, by = "location_category_code")

# map
bm + geom_sf(data = leisure_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = leisure_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Leisure locations by categories")

.location_category_cnt <- as.data.frame(leisure_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
17 [Leisure-time physical activity]	166
18 [Park]	304
19 [Cultural activity]	23
20 [Volunteering place]	45
21 [Religious or spiritual activity]	12
22 [Restaurant, café, bar, etc. ]	128
23 [Take-out]	201
24 [Walk]	290

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(leisure_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = leisure_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_leisure_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)

.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_leisure_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of leisure locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of leisure locations by participant and category

location_category	min	mean	median	max
17 [Leisure-time physical activity]	0	0.79	1	5
18 [Park]	0	1.44	1	5
19 [Cultural activity]	0	0.11	0	3
20 [Volunteering place]	0	0.21	0	2
21 [Religious or spiritual activity]	0	0.06	0	1
22 [Restaurant, café, bar, etc. ]	0	0.61	0	5
23 [Take-out]	0	0.95	1	5
24 [Walk]	0	1.37	1	5

2.7 Section 7: Other places/activities

2.7.1 Are there other places that you go to at least once per month that we have not mentioned? For example: a mall, a daycare, a hardware store, or a community center.

# extract and recode
.other <- veritas_main[c("interact_id", "other")] %>% dplyr::rename(other_code = other)
.other$other <- factor(ifelse(.other$other_code == 1, "1 [Yes]",
  ifelse(.other$other_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .other) +
  geom_histogram(aes(x = other), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "other")

.other_cnt <- .other %>%
  group_by(other) %>%
  dplyr::count() %>%
  arrange(other)
kable(.other_cnt, caption = "Other places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Other places

other	n
1 [Yes]	51
2 [No]	160

2.7.2 Can you locate this place?

other_location <- locations[locations$location_category == 25, ]

bm + geom_sf(data = other_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

2.8 Section 8: Areas of change

2.8.1 Can you locate areas where you have noticed an improvement of the urban environment?

# extract and recode
.improv <- veritas_main[c("interact_id", "improvement_none")] %>% dplyr::rename(improvement_none_code = improvement_none)
.improv$improvement_none <- factor(ifelse(.improv$improvement_none_code == 1, "1 [TRUE]",
  ifelse(.improv$improvement_none_code == 0, "0 [FALSE]", "N/A")
))

# histogram of answers
ggplot(data = .improv) +
  geom_histogram(aes(x = improvement_none), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "improvement_none")

.improv_cnt <- .improv %>%
  group_by(improvement_none) %>%
  dplyr::count() %>%
  arrange(improvement_none)
kable(.improv_cnt, caption = "No area of improvement") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

No area of improvement

improvement_none	n
0 [FALSE]	126
1 [TRUE]	85

# polgon extraction
improv <- poly_geom[poly_geom$area_type == "improvement", ]

# Map
bm + geom_sf(data = improv, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
improv <- improv %>%
  mutate(area_m2 = st_area(.))
kable(t(as.matrix(summary(improv$area_m2))),
  caption = "Area (in square meters) of the perceived improvement areas",
  digits = 1
) %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived improvement areas

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
1007.3	38981.7	130712	411569.2	474487.7	10044797

2.8.2 Can you locate areas where you have noticed a deterioration of the urban environment?

# extract and recode
.deter <- veritas_main[c("interact_id", "deterioration_none")] %>% dplyr::rename(deterioration_none_code = deterioration_none)
.deter$deterioration_none <- factor(ifelse(.deter$deterioration_none_code == 1, "1 [TRUE]",
  ifelse(.deter$deterioration_none_code == 0, "0 [FALSE]", "N/A")
))

# histogram of answers
ggplot(data = .deter) +
  geom_histogram(aes(x = deterioration_none), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "deterioration_none")

.deter_cnt <- .deter %>%
  group_by(deterioration_none) %>%
  dplyr::count() %>%
  arrange(deterioration_none)
kable(.deter_cnt, caption = "No area of deterioration") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

No area of deterioration

deterioration_none	n
0 [FALSE]	57
1 [TRUE]	154

# polgon extraction
deter <- poly_geom[poly_geom$area_type == "deterioration", ]

# Map
bm + geom_sf(data = deter, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
deter <- deter %>%
  mutate(area_m2 = st_area(.))
kable(t(as.matrix(summary(deter$area_m2))),
  caption = "Area (in square meters) of the perceived deterioration areas",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived deterioration areas

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
89.4	12193.5	41008.4	551680.1	203165.4	13377805

2.9 Section 9: Social contact

2.9.1 Do you visit anyone at his or her home at least once per month?

# extract and recode
.visiting <- veritas_main[c("interact_id", "visiting")] %>% dplyr::rename(visiting_code = visiting)
.visiting$visiting <- factor(ifelse(.visiting$visiting_code == 1, "1 [Yes]",
  ifelse(.visiting$visiting_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .visiting) +
  geom_histogram(aes(x = visiting), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "visiting")

.visiting_cnt <- .visiting %>%
  group_by(visiting) %>%
  dplyr::count() %>%
  arrange(visiting)
kable(.visiting_cnt, caption = "Social contact") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Social contact

visiting	n
1 [Yes]	93
2 [No]	118

2.9.2 Great, we are almost done completing this questionnaire. You have documented all your activity places on a map, and specified with whom you generally do these activities. These last few questions concern the people you documented earlier.

# compute statistics on groups / participant
# > one needs to account for participants who did not report any group
.gr_iid_cnt <- as.data.frame(group[c("interact_id")]) %>%
  group_by(interact_id) %>%
  dplyr::count()

# (cont'd) find iid combination without match in veritas group
.no_gr_iid <- anti_join(veritas_main[c("interact_id")], .gr_iid_cnt, by = "interact_id") %>%
  mutate(n = 0)
.gr_iid_cnt <- bind_rows(.gr_iid_cnt, .no_gr_iid)

kable(t(as.matrix(summary(.gr_iid_cnt$n))),
  caption = "Number of groups per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of groups per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	0	0.3	0	5

# compute statistics on people / participant
# > one needs to account for participants who did not report any group
.pl_iid_cnt <- as.data.frame(people[c("interact_id")]) %>%
  group_by(interact_id) %>%
  dplyr::count()

# (cont'd) find iid combination without match in veritas group
.no_pl_iid <- anti_join(veritas_main[c("interact_id")], .pl_iid_cnt, by = "interact_id") %>%
  mutate(n = 0)
.pl_iid_cnt <- bind_rows(.pl_iid_cnt, .no_pl_iid)

kable(t(as.matrix(summary(.pl_iid_cnt$n))),
  caption = "Number of people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	2	3.4	4	33

# histogram
.sc_iid_cnt <- .pl_iid_cnt %>% mutate(soc_type = "people")
.sc_iid_cnt <- .gr_iid_cnt %>%
  mutate(soc_type = "group") %>%
  bind_rows(.sc_iid_cnt)

ggplot(data = .sc_iid_cnt) +
  geom_histogram(aes(x = n, y = stat(count), fill = soc_type), position = "dodge") +
  labs(x = "Social network size by element type", fill = element_blank())

2.9.2.1 Among these people, who do you discuss important matters with?

# extract number of important people / participant
.n_important <- important %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_imp <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_important, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_important = n.y) %>%
  mutate(pct = 100 * n_important / n_people)

kable(t(as.matrix(summary(.n_people_imp$n_important))),
  caption = "Number of important people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of important people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	1	2.2	3	24

kable(t(as.matrix(summary(.n_people_imp$pct))),
  caption = "% of important people among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of important people among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	50	100	74.4	100	100	34

2.9.2.2 Among these people, who do you like to socialize with?

# extract number of important people / participant
.n_socialize <- socialize %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_soc <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_socialize, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_socialize = n.y) %>%
  mutate(pct = 100 * n_socialize / n_people)

kable(t(as.matrix(summary(.n_people_soc$n_socialize))),
  caption = "Number of people with whom to socialize per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of people with whom to socialize per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	1	2.7	4	32

kable(t(as.matrix(summary(.n_people_soc$pct))),
  caption = "% of people with whom to  socialize among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of people with whom to socialize among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	75	100	84.4	100	100	34

2.9.2.3 Among these people, who do you meet often with but do not necessarily feel close to?

# extract number of important people / participant
.n_not_close <- not_close %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_not_close <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_not_close, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_not_close = n.y) %>%
  mutate(pct = 100 * n_not_close / n_people)

kable(t(as.matrix(summary(.n_people_not_close$n_not_close))),
  caption = "Number of not so close people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of not so close people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	0	0.6	0	24

kable(t(as.matrix(summary(.n_people_not_close$pct))),
  caption = "% of not so close people among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of not so close people among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	0	0	15.8	20	100	34

2.9.2.4 Among these people, who knows whom?

# extract number of who knows who relationships
.n_relat <- relationship %>%
  filter(relationship_type == 1) %>%
  dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_relat <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_relat, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_relat = n.y) %>%
  mutate(pct = 100 * n_relat * 2 / (n_people * (n_people - 1))) # potential number of relationships = N x (N -1) / 2

kable(t(as.matrix(summary(.n_people_relat$n_relat))),
  caption = "Number of relationships « who knows who » per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of relationships « who knows who » per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	1	6.7	6	250

kable(t(as.matrix(summary(.n_people_relat$pct))),
  caption = "% of relationships « who knows who » per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of relationships « who knows who » per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	50	88.3	73.7	100	100	97

2.10 Derived metrics

2.10.1 Existence of improvement and deterioration areas by participant

Combination of improvement and/or deterioration areas per participant

# cross tab of improvement vs deteriation areas
.improv <- improv[c("interact_id")] %>%
  mutate(improv = "Improvement")
.deter <- deter[c("interact_id")] %>%
  mutate(deter = "Deterioration")
.ct_impr_deter <- veritas_main[c("interact_id")] %>%
  transmute(interact_id = as.character(interact_id)) %>%
  left_join(.improv, by = "interact_id") %>%
  left_join(.deter, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), "N/A"))

kable(table(.ct_impr_deter$improv, .ct_impr_deter$deter), caption = "Improvement vs. deterioration") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left", row_label_position = "r") %>%
  column_spec(1, bold = T)

Improvement vs. deterioration

	Deterioration	N/A
Improvement	39	75
N/A	15	82

2.10.2 Transportation mode preferences

Based on the answers to the question Usually, how do you go there? (Check all that apply.).

# code  en
# 1 By car and you drive
# 2 By car and someone else drives
# 3 By taxi/Uber
# 4 On foot
# 5 By bike
# 6 By bus
# 7 By subway
# 8 By train
# 99    Other

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.tm <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1) %>%
  left_join(loc_labels)

.tm_grouped <- .tm %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), "By car (driver)" = sum(location_tmode_1),
    "By car (passenger)" = sum(location_tmode_2),
    "By taxi/Uber" = sum(location_tmode_3),
    "On foot" = sum(location_tmode_4),
    "By bike" = sum(location_tmode_5),
    "By bus" = sum(location_tmode_6),
    "By train" = sum(location_tmode_7),
    "By metro" = sum(location_tmode_8),
    "Other" = sum(location_tmode_99)
  )

kable(.tm_grouped, caption = "Transportation mode preferences") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Transportation mode preferences

description	N	By car (driver)	By car (passenger)	By taxi/Uber	On foot	By bike	By bus	By train	By metro	Other
2 [Other residence]	42	19	13	0	8	7	4	1	8	1
3 [Work]	180	43	7	7	52	33	23	1	39	53
4 [School/College/University]	43	5	2	0	9	4	5	0	7	26
5 [Supermarket]	555	200	68	0	288	56	21	1	14	4
6 [Public/farmer’s market]	72	15	10	0	36	18	1	0	3	0
7 [Bakery]	127	24	8	0	90	14	1	0	3	0
8 [Specialty food store]	131	36	3	0	95	20	4	1	1	0
9 [Convenience store/Dépanneur]	88	12	2	0	72	10	1	0	0	0
10 [Liquor store/SAQ]	136	52	13	0	61	14	2	1	1	1
11 [Bank]	147	45	10	0	92	16	2	0	4	2
12 [Hair salon/barbershop]	90	36	2	0	42	12	8	0	10	1
13 [Post office]	127	36	4	0	81	12	4	1	0	2
14 [Drugstore]	181	48	6	1	132	19	5	0	1	3
15 [Doctor/healthcare provider]	123	48	10	1	38	18	13	2	20	1
16 [Public transit stop]	195	0	2	1	120	8	33	3	62	2
17 [Leisure-time physical activity]	166	37	11	0	85	25	5	0	3	21
18 [Park]	304	32	19	1	219	61	6	0	8	6
19 [Cultural activity]	23	4	0	0	9	4	3	0	4	6
20 [Volunteering place]	45	15	1	0	16	10	3	0	2	11
21 [Religious/spiritual activity]	12	0	1	0	6	1	1	0	1	4
22 [Restaurant, café, bar, etc.]	128	18	17	0	73	25	8	0	10	0
23 [Take-out]	201	70	26	0	92	11	6	0	1	11
24 [Walk]	290	22	11	0	249	24	6	0	5	7
25 [Other place]	96	31	21	0	30	30	6	0	9	1

# graph
.tm1 <- .tm %>%
  filter(location_tmode_1 == 1) %>%
  mutate(tm = "[1] By car (driver)")
.tm2 <- .tm %>%
  filter(location_tmode_2 == 1) %>%
  mutate(tm = "[2] By car (passenger)")
.tm3 <- .tm %>%
  filter(location_tmode_3 == 1) %>%
  mutate(tm = "[3] By taxi/Uber")
.tm4 <- .tm %>%
  filter(location_tmode_4 == 1) %>%
  mutate(tm = "[4] On foot")
.tm5 <- .tm %>%
  filter(location_tmode_5 == 1) %>%
  mutate(tm = "[5] By bike")
.tm6 <- .tm %>%
  filter(location_tmode_6 == 1) %>%
  mutate(tm = "[6] By bus")
.tm7 <- .tm %>%
  filter(location_tmode_7 == 1) %>%
  mutate(tm = "[7] By train")
.tm8 <- .tm %>%
  filter(location_tmode_8 == 1) %>%
  mutate(tm = "[8] By metro")
.tm99 <- .tm %>%
  filter(location_tmode_99 == 1) %>%
  mutate(tm = "[99] Other")
.tm <- bind_rows(.tm1, .tm2) %>%
  bind_rows(.tm3) %>%
  bind_rows(.tm4) %>%
  bind_rows(.tm5) %>%
  bind_rows(.tm6) %>%
  bind_rows(.tm7) %>%
  bind_rows(.tm8) %>%
  bind_rows(.tm99)

# histogram of answers
ggplot(data = .tm) +
  geom_bar(aes(x = fct_rev(description), fill = tm), position = "fill") +
  scale_fill_brewer(palette = "Set3", name = "Transport modes") +
  scale_y_continuous(labels = percent) +
  labs(y = "Proportion of transportation mode by location category", x = element_blank()) +
  coord_flip() +
  theme(legend.position = "bottom", legend.justification = c(0, 0), legend.text = element_text(size = 8)) +
  guides(fill = guide_legend(nrow = 3))

2.10.3 Visiting places alone

Based on the answers to the question Do you usually go to this place alone or with other people?.

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.alone <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1) %>%
  left_join(loc_labels) %>%
  mutate(location_alone_recode = case_when(
    location_alone2 == 1 ~ 1,
    location_alone2 == 2 ~ 0
  ))

.alone_grouped <- .alone %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), "Visited alone" = sum(location_alone_recode),
    "Visited alone (%)" = round(sum(location_alone_recode) * 100.0 / n(), digits = 1)
  )

kable(.alone_grouped, caption = "Visiting places alone") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Visiting places alone

description	N	Visited alone	Visited alone (%)
2 [Other residence]	42	14	33.3
3 [Work]	180	104	57.8
4 [School/College/University]	43	27	62.8
5 [Supermarket]	555	389	70.1
6 [Public/farmer’s market]	72	35	48.6
7 [Bakery]	127	81	63.8
8 [Specialty food store]	131	103	78.6
9 [Convenience store/Dépanneur]	88	74	84.1
10 [Liquor store/SAQ]	136	100	73.5
11 [Bank]	147	127	86.4
12 [Hair salon/barbershop]	90	87	96.7
13 [Post office]	127	122	96.1
14 [Drugstore]	181	156	86.2
15 [Doctor/healthcare provider]	123	105	85.4
16 [Public transit stop]	195	174	89.2
17 [Leisure-time physical activity]	166	99	59.6
18 [Park]	304	128	42.1
19 [Cultural activity]	23	6	26.1
20 [Volunteering place]	45	27	60.0
21 [Religious/spiritual activity]	12	5	41.7
22 [Restaurant, café, bar, etc.]	128	44	34.4
23 [Take-out]	201	129	64.2
24 [Walk]	290	150	51.7
25 [Other place]	96	45	46.9

# histogram of answers
ggplot(data = .alone) +
  geom_bar(aes(x = fct_rev(description), fill = factor(location_alone2)), position = "fill") +
  scale_fill_brewer(palette = "Set3", name = "Visiting places", labels = c("Alone", "With someone")) +
  scale_y_continuous(labels = percent) +
  labs(y = "Proportion of places visited alone", x = element_blank()) +
  coord_flip()

2.10.4 Visit frequency

Based on the answers to the question How often do you go there?.

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.freq <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1) %>%
  left_join(loc_labels)

.freq_grouped <- .freq %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), min = min(location_freq_visit),
    max = max(location_freq_visit),
    mean = mean(location_freq_visit),
    median = median(location_freq_visit),
    sd = sd(location_freq_visit)
  )

kable(.freq_grouped, caption = "Visit frequency (expressed in times/year)") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Visit frequency (expressed in times/year)

description	N	min	max	mean	median	sd
2 [Other residence]	42	1	312	61	52	7.097930e+01
3 [Work]	180	0	64197530280	356653426	240	4.785001e+09
4 [School/College/University]	43	0	364	221	260	1.362780e+02
5 [Supermarket]	555	1	364	49	36	5.014406e+01
6 [Public/farmer’s market]	72	1	312	37	24	4.785760e+01
7 [Bakery]	127	1	364	33	24	4.432183e+01
8 [Specialty food store]	131	1	260	33	24	3.651178e+01
9 [Convenience store/Dépanneur]	88	1	364	59	24	7.779341e+01
10 [Liquor store/SAQ]	136	1	208	21	12	2.891526e+01
11 [Bank]	147	0	104	15	12	1.599096e+01
12 [Hair salon/barbershop]	90	1	264	9	5	2.751774e+01
13 [Post office]	127	0	588	23	12	6.053707e+01
14 [Drugstore]	181	2	260	35	24	4.239677e+01
15 [Doctor/healthcare provider]	123	0	4680	43	2	4.216133e+02
16 [Public transit stop]	195	1	520	97	40	1.239157e+02
17 [Leisure-time physical activity]	166	0	364	108	52	1.098557e+02
18 [Park]	304	1	728	76	36	9.795641e+01
19 [Cultural activity]	23	0	156	19	12	3.162990e+01
20 [Volunteering place]	45	1	364	62	48	8.301227e+01
21 [Religious/spiritual activity]	12	1	372	90	24	1.328064e+02
22 [Restaurant, café, bar, etc.]	128	1	520	29	12	6.466491e+01
23 [Take-out]	201	0	208	19	12	2.490042e+01
24 [Walk]	290	1	728	84	36	1.056391e+02
25 [Other place]	96	1	260	35	12	6.256701e+01

# graph
ggplot(data = .freq) +
  geom_boxplot(aes(x = fct_rev(description), y = location_freq_visit)) +
  scale_y_continuous(limits = c(0, 365)) +
  labs(y = "Visits/year (Frequency over 1 visit/day not shown)", x = element_blank()) +
  coord_flip()

2.10.5 Spatial indicators: Camille Perchoux’s toolbox

Below is a list of indicators proposed by Camille Perchoux in her paper Assessing patterns of spatial behavior in health studies: Their socio-demographic determinants and associations with transportation modes (the RECORD Cohort Study).

-- Reading Camille tbx indics from Essence table
SELECT interact_id,
  n_acti_places, n_weekly_vst, n_acti_types,
  cvx_perimeter, cvx_surface,
  min_length, max_length, median_length, 
  pct_visits_neighb, 
  n_acti_prn, pct_visits_prn, prn_area_km2
FROM essence_table.essence_perchoux_tbx
WHERE city_id = 'Montréal' AND wave_id = 2 AND status = 'new'

2.10.5.1 Indicators related to the lifestyle

Indicators	Measurement approach
Number of activity places (n_acti_places)	Count of activity places
Number of visits to places per week (n_weekly_vst)	Number of activity places per individual multiplied by the frequency of visit per week to each location, excluding the residence
Number of activity types (n_acti_types)	6 types of activities considered: 1-Residential; 2-Occupation; 3-Shopping activities; 4-Services; 5-Transportation; 6-Leisure activities (NB original categories were as follow: 1-Residential; 2-work; 3-food and other services; 4-transport station/stop; 5-recreational activity; 6-social activity)

LLindic <- ess.tab.camille %>%
  select("interact_id", "n_acti_places", "n_weekly_vst", "n_acti_types")
.llmtx <- as.matrix(summary(LLindic[c("n_acti_places", "n_weekly_vst", "n_acti_types")], digits = 1))
.llmtx <- apply(.llmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.llmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ")
kable(.llmtx, caption = "Lifestyle statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Lifestyle statistics

	n_acti_places	n_weekly_vst	n_acti_types
Min.	3	1e+00	2
1st Qu.	12	1e+01	5
Median	17	2e+01	5
Mean	18	6e+06	5
3rd Qu.	23	2e+01	5
Max.	44	1e+09	6

2.10.5.2 Indicators related to the geometry of the activity space

Indicators	Measurement approach
Perimeter of the convex hull (cvx_perimeter)	Perimeter of the smallest polygon containing all the activity locations of the participant (unit: km)
Surface of the convex hull (cvx_surface)	Surface of the smallest polygon containing all the activity locations of the participant (unit: km2)
Minimal road network distance from the residence to an activity place (min_length)	Minimal distance from the residence to an activity place using the road network (in meters)
Maximal road network distance from the residence to an activity place (max_length)	Maximal distance from the residence to an activity place using the road network (in meters)
Median road network distance from the residence to all activity places (median_length)	Median distance from home to all activity places using the road network (in meters)

ASindic <- ess.tab.camille %>%
  select("interact_id", "cvx_perimeter", "cvx_surface", "min_length", "max_length", "median_length")
.asmtx <- as.matrix(summary(ASindic[c("cvx_perimeter", "cvx_surface", "min_length", "max_length", "median_length")], digits = 1))
.asmtx <- apply(.asmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.asmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ")
.asmtx[is.na(.asmtx)] <- 0
kable(.asmtx, caption = "Activity space statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Activity space statistics

	cvx_perimeter	cvx_surface	min_length	max_length	median_length
Min.	3	3e-02	0	8e+02	16
1st Qu.	14	6e+00	3	6e+03	793
Median	24	2e+01	60	1e+04	1347
Mean	80	7e+02	362	3e+04	2039
3rd Qu.	52	9e+01	222	2e+04	2264
Max.	1496	6e+04	31436	2e+05	33423

2.10.5.3 Indicators related to the importance of the residential neighborhood

Indicators	Measurement approach
Percentage of visits to places in the residential neighborhood (pct_visits_neighb)	Count of visits to places within the 500 m road network buffer centered on the residence divided by the total number of visits to places
Number of activity locations in the PRN (n_acti_prn)	Count of activity locations in the PRN
Percentage of visits in the PRN (pct_visits_prn)	Count of visits to places in the PRN divided by the total number of visits to places
Surface of the PRN (prn_area_km2)	Unit: km2

RNindic <- ess.tab.camille %>%
  select("interact_id", "pct_visits_neighb", "n_acti_prn", "pct_visits_prn", "prn_area_km2")
RNindic <- RNindic[RNindic$interact_id %in% prn$interact_id, ]
.rnmtx <- as.matrix(summary(RNindic[c("pct_visits_neighb", "n_acti_prn", "pct_visits_prn", "prn_area_km2")], digits = 1))
.rnmtx <- apply(.rnmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.rnmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ", "N/A.")
.rnmtx[is.na(.rnmtx)] <- 0
kable(.rnmtx, caption = "Residential neighbourhood statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Residential neighbourhood statistics

	pct_visits_neighb	n_acti_prn	pct_visits_prn	prn_area_km2
Min.	0	0	0	9e-04
1st Qu.	19	4	36	2e+00
Median	39	8	68	3e+00
Mean	40	9	60	6e+00
3rd Qu.	61	11	86	5e+00
Max.	100	34	100	1e+02
N/A.	100	0	0	0

Only participants with valid PRN considered in Residential Neighbourhood indicators (= 176 participants).

2.10.6 Social indicators: Alexandre Naud’s toolbox

See Alex’s document for a more comprehensive presentation of the social indicators.

-- Reading Alex tbx indics from Essence table
SELECT interact_id,
  people_degree, 
  socialize_size, socialize_meet, socialize_chat,
  important_size, group_degree, simmelian
FROM essence_table.essence_naud_social
WHERE city_id = 'Montréal' AND wave_id = 2 AND status = 'new'

2.10.6.1 Number of people in the network (people_degree)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = people_degree))

kable(t(as.matrix(summary(ess.tab.alex$people_degree))), caption = "people_degree") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

people_degree

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	2	3.421801	4	33

2.10.6.2 Simmelian Brokerage (simmelian)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = simmelian))

kable(t(as.matrix(summary(ess.tab.alex$simmelian))), caption = "simmelian") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

simmelian

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
1	1	2.5	3.890909	4.9375	17.88889	81

2.10.6.3 Number of people with whom the participant like to socialize (socialize_size)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = socialize_size))

kable(t(as.matrix(summary(ess.tab.alex$socialize_size))), caption = "socialize_size") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_size

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	1	2.701422	4	32

2.10.6.4 Weekly face-to-face interactions among people with whom the participant like to socialize (socialize_meet)

ggplot(filter(ess.tab.alex, socialize_meet < 100)) +
  geom_histogram(aes(x = socialize_meet)) +
  annotate(geom = "text", x = 75, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$socialize_meet))), caption = "socialize_meet") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_meet

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	44.5	364	25091.16	481	5200168

2.10.6.5 Weekly ICT interactions among people with whom the participant like to socialize (socialize_chat)

ggplot(filter(ess.tab.alex, socialize_chat < 100)) +
  geom_histogram(aes(x = socialize_chat)) +
  annotate(geom = "text", x = 55, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$socialize_chat))), caption = "socialize_chat") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_chat

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	364	625.4313	714	7800

2.10.6.6 Number of people with whom the participant discuss important matters (important_size)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = important_size))

kable(t(as.matrix(summary(ess.tab.alex$important_size))), caption = "important_size") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

important_size

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	1	2.236967	3	24

2.10.6.7 Number of people in all groups (group_degree)

ggplot(filter(ess.tab.alex, group_degree < 100)) +
  geom_histogram(aes(x = group_degree)) +
  annotate(geom = "text", x = 20, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$group_degree))), caption = "group_degree") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

group_degree

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	0	1.2891	0	23

3 Basic descriptive statistics for returning participants

3.1 Section 1: Residence and Neighbourhood

3.1.1 Now, let’s start with your home. What is your address?

home_location <- locations[locations$location_category == 1, ]

## version ggmap
mtl_aoi <- st_bbox(home_location)
names(mtl_aoi) <- c("left", "bottom", "right", "top")
mtl_aoi[["left"]] <- mtl_aoi[["left"]] - .07
mtl_aoi[["right"]] <- mtl_aoi[["right"]] + .07
mtl_aoi[["top"]] <- mtl_aoi[["top"]] + .01
mtl_aoi[["bottom"]] <- mtl_aoi[["bottom"]] - .01

bm <- get_stadiamap(mtl_aoi, zoom = 11, maptype = "stamen_toner_lite") %>%
  ggmap(extent = "device")
bm + geom_sf(data = st_jitter(home_location, .008), inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3) # see https://github.com/r-spatial/sf/issues/336

NB: Home locations have been randomly shifted from their original position to protect privacy.

# Number of participants by municipalites
home_by_municipalites <- st_join(home_location, municipalities["NAME"])
home_by_mun_cnt <- as.data.frame(home_by_municipalites) %>%
  group_by(NAME) %>%
  dplyr::count() %>%
  arrange(desc(n), NAME)
home_by_mun_cnt$Shape <- NULL
kable(home_by_mun_cnt, caption = "Number of participants by municipalities") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of participants by municipalities

NAME	n
Montréal	186
Longueuil	16
Laval	12
Brossard	5
Saint-Lambert	3
Mont-Royal	2
Beaconsfield	1
Côte-Saint-Luc	1
Dollard-Des Ormeaux	1
Dorval	1
Kirkland	1
Pointe-Claire	1

3.1.2 If you were asked to draw the boundaries of your neighbourhood, what would they be?

prn <- poly_geom[poly_geom$area_type == "neighborhood", ]

## version ggmap
bm + geom_sf(data = prn, inherit.aes = FALSE, fill = alpha("blue", 0.05), color = alpha("blue", 0.3))

# Min, max, median & mean area of PRN
prn$area_m2 <- st_area(prn$geom)
kable(t(as.matrix(summary(prn$area_m2))),
  caption = "Area (in square meters) of the perceived residential neighborhood",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived residential neighborhood

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
691.6	1589080	2602137	4158914	4789060	26444211

NB only 197 valid neighborhoods were collected, as many participants struggled to draw polygons on the map.

3.1.3 How attached are you to your neighbourhood?

# extract and recode
.ngh_att <- veritas_main[veritas_main$neighbourhood_attach != 99, c("interact_id", "neighbourhood_attach")] %>% dplyr::rename(neighbourhood_attach_code = neighbourhood_attach)
.ngh_att$neighbourhood_attach <- factor(ifelse(.ngh_att$neighbourhood_attach_code == 1, "1 [Not attached at all]",
  ifelse(.ngh_att$neighbourhood_attach_code == 6, "6 [Very attached]",
    .ngh_att$neighbourhood_attach_code
  )
))

# histogram of attachment
ggplot(data = .ngh_att) +
  geom_histogram(aes(x = neighbourhood_attach), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "neighbourhood_attach")

.ngh_att_cnt <- .ngh_att %>%
  group_by(neighbourhood_attach) %>%
  dplyr::count() %>%
  arrange(neighbourhood_attach)
kable(.ngh_att_cnt, caption = "Neigbourhood attachment") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Neigbourhood attachment

neighbourhood_attach	n
1 [Not attached at all]	3
2	9
3	15
4	46
5	74
6 [Very attached]	80

3.1.4 On average, how many hours per day do you spend outside of your home?

# histogram of n hours out
ggplot(data = veritas_main) +
  geom_histogram(aes(x = hours_out))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$hours_out))),
  caption = "Hours/day outside home",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Hours/day outside home

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	2	3	4.2	6	20

3.1.5 Of this time spent outside your home, on average how many hours do you spend outside your neighbourhood?

# histogram of n hours out
ggplot(data = veritas_main) +
  geom_histogram(aes(x = hours_out_neighb))

# Min, max, median & mean hours/day out of neighborhood
kable(t(as.matrix(summary(veritas_main$hours_out_neighb))),
  caption = "Hours/day outside neighbourhood",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Hours/day outside neighbourhood

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	1	2.5	3	20

3.1.6 Are there one or more areas close to where you live that you tend to avoid because you do not feel safe there (for any reason)?

# extract and recode
.unsafe <- veritas_main[c("interact_id", "unsafe_area")] %>% dplyr::rename(unsafe_area_code = unsafe_area)
.unsafe$unsafe_area <- factor(ifelse(.unsafe$unsafe_area_code == 1, "1 [Yes]",
  ifelse(.unsafe$unsafe_area_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .unsafe) +
  geom_histogram(aes(x = unsafe_area), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "unsafe_area")

.unsafe_cnt <- .unsafe %>%
  group_by(unsafe_area) %>%
  dplyr::count() %>%
  arrange(unsafe_area)
kable(.unsafe_cnt, caption = "Unsafe areas") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Unsafe areas

unsafe_area	n
1 [Yes]	35
2 [No]	195

# map
unsafe <- poly_geom[poly_geom$area_type == "unsafe area", ]

## version ggmap
bm + geom_sf(data = unsafe, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
unsafe$area_m2 <- st_area(unsafe$geom)
kable(t(as.matrix(summary(unsafe$area_m2))),
  caption = "Area (in square meters) of the perceived unsafe area",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived unsafe area

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
3915.6	109117.6	326816.3	1809849	658754.3	35405879

3.1.7 Do you spend the night somewhere other than your home at least once per week?

# extract and recode
.o_res <- veritas_main[c("interact_id", "other_resid")] %>% dplyr::rename(other_resid_code = other_resid)
.o_res$other_resid <- factor(ifelse(.o_res$other_resid_code == 1, "1 [Yes]",
  ifelse(.o_res$other_resid_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .o_res) +
  geom_histogram(aes(x = other_resid), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "other_resid")

.o_res_cnt <- .o_res %>%
  group_by(other_resid) %>%
  dplyr::count() %>%
  arrange(other_resid)
kable(.o_res_cnt, caption = "Other residence") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Other residence

other_resid	n
1 [Yes]	31
2 [No]	199

3.2 Section 2: Occupation

3.2.1 Are you currently working?

# extract and recode
.work <- veritas_main[c("interact_id", "working")] %>% dplyr::rename(working_code = working)
.work$working <- factor(ifelse(.work$working_code == 1, "1 [Yes]",
  ifelse(.work$working_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .work) +
  geom_histogram(aes(x = working), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "working")

.work_cnt <- .work %>%
  group_by(working) %>%
  dplyr::count() %>%
  arrange(working)
kable(.work_cnt, caption = "Currently working") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Currently working

working	n
1 [Yes]	154
2 [No]	76

3.2.2 Where do you work?

work_location <- locations[locations$location_category == 3, ]

bm + geom_sf(data = work_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

3.2.3 On average, how many hours per week do you work?

# histogram of n hours out
ggplot(data = veritas_main[veritas_main$working == 1, ]) +
  geom_histogram(aes(x = work_hours))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$work_hours[veritas_main$working == 1]))),
  caption = "Work hours/week",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Work hours/week

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	30	35	33.8	40	60

3.2.4 Are you currently a registered student?

# extract and recode
.study <- veritas_main[c("interact_id", "studying")] %>% dplyr::rename(studying_code = studying)
.study$studying <- factor(ifelse(.study$studying_code == 1, "1 [Yes]",
  ifelse(.study$studying_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .study) +
  geom_histogram(aes(x = studying), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Studying")

.study_cnt <- .study %>%
  group_by(studying) %>%
  dplyr::count() %>%
  arrange(studying)
kable(.study_cnt, caption = "Currently studying") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Currently studying

studying	n
1 [Yes]	27
2 [No]	203

3.2.5 Where do you study?

study_location <- locations[locations$location_category == 4, ]

bm + geom_sf(data = study_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

3.2.6 On average, how many hours per week do you study?

# histogram of n hours out
ggplot(data = veritas_main[veritas_main$studying == 1, ]) +
  geom_histogram(aes(x = study_hours))

# Min, max, median & mean hours/day out
kable(t(as.matrix(summary(veritas_main$study_hours[veritas_main$studying == 1]))),
  caption = "study hours/week",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

study hours/week

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
4	8	14	22.1	32.5	60

3.3 Section 3: Shopping activities

3.3.1 In Date of Previous Data Collection Wave, you reported shopping at these locations. Do you still visit these places?

shop_lut <- data.frame(
  location_category_code = c(5, 6, 7, 8, 9, 10),
  location_category = factor(c(
    " 5 [Supermarket]",
    " 6 [Public/farmer’s market]",
    " 7 [Bakery]",
    " 8 [Specialty food store]",
    " 9 [Convenience store/Dépanneur]",
    "10 [Liquor store/SAQ]"
  ))
)
shop_location <- locations[locations$location_category %in% shop_lut$location_category_code, ] %>%
  filter(location_current == 1) %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(shop_lut, by = "location_category_code")

# map
bm + geom_sf(data = shop_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = shop_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Shopping locations by categories")

.location_category_cnt <- as.data.frame(shop_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
5 [Supermarket]	522
6 [Public/farmer’s market]	77
7 [Bakery]	134
8 [Specialty food store]	182
9 [Convenience store/Dépanneur]	78
10 [Liquor store/SAQ]	116

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(shop_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE to build list of all combination iid/shopping categ
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = shop_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_shop_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)
.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_shop_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of shopping locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of shopping locations by participant and category

location_category	min	mean	median	max
5 [Supermarket]	0	2.27	2	6
6 [Public/farmer’s market]	0	0.33	0	3
7 [Bakery]	0	0.58	0	5
8 [Specialty food store]	0	0.79	0	5
9 [Convenience store/Dépanneur]	0	0.34	0	3
10 [Liquor store/SAQ]	0	0.50	0	4

3.3.2 Thinking about the places where you shop, are there other supermarkets, farmers markets, bakeries, specialty stores, convenience stores or liquor stores you visit at least once per month?

# extract and recode
.grp_shopping <- veritas_main[c("interact_id", "grp_shopping_new")] %>% dplyr::rename(grp_shopping_new_code = grp_shopping_new)
.grp_shopping$grp_shopping_new <- factor(ifelse(.grp_shopping$grp_shopping_new_code == 1, "1 [Yes]",
  ifelse(.grp_shopping$grp_shopping_new_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .grp_shopping) +
  geom_histogram(aes(x = grp_shopping_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "grp_shopping_new")

.grp_shopping_cnt <- .grp_shopping %>%
  group_by(grp_shopping_new) %>%
  dplyr::count() %>%
  arrange(grp_shopping_new)
kable(.grp_shopping_cnt, caption = "New shopping places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

New shopping places

grp_shopping_new	n
1 [Yes]	133
2 [No]	97

3.4 Section 4: Services

3.4.1 In Date of Previous Data Collection Wave, you reported using services at these locations. Do you still visit these places?

serv_lut <- data.frame(
  location_category_code = c(11, 12, 13, 14, 15),
  location_category = factor(c(
    "11 [Bank]",
    "12 [Hair salon/barbershop]",
    "13 [Post office]",
    "14 [Drugstore]",
    "15 Doctor/healthcare provider]"
  ))
)
serv_location <- locations[locations$location_category %in% serv_lut$location_category_code, ] %>%
  filter(location_current == 1) %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(serv_lut, by = "location_category_code")

# map
bm + geom_sf(data = serv_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = serv_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Service locations by categories")

.location_category_cnt <- as.data.frame(serv_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
11 [Bank]	51
12 [Hair salon/barbershop]	49
13 [Post office]	68
14 [Drugstore]	169
15 Doctor/healthcare provider]	43

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(serv_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = serv_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_serv_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)
.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_serv_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of shopping locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of shopping locations by participant and category

location_category	min	mean	median	max
11 [Bank]	0	0.22	0	1
12 [Hair salon/barbershop]	0	0.21	0	1
13 [Post office]	0	0.30	0	1
14 [Drugstore]	0	0.73	1	1
15 Doctor/healthcare provider]	0	0.19	0	2

3.4.2 Thinking about the places where you use services, are there other banks, hair salons, post offices, drugstores, doctors or other healthcare providers you visit at least once per month?

NB: Variable grp_services_new has not been properly recorded in Montréal wave 2 for returning participants.

# extract and recode
.grp_services <- veritas_main[c("interact_id", "grp_services_new")] %>% dplyr::rename(grp_services_new_code = grp_services_new)
.grp_services$grp_services_new <- factor(ifelse(.grp_services$grp_services_new_code == 1, "1 [Yes]",
  ifelse(.grp_services$grp_services_new_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .grp_services) +
  geom_histogram(aes(x = grp_services_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "grp_services_new")

.grp_services_cnt <- .grp_services %>%
  group_by(grp_services_new) %>%
  dplyr::count() %>%
  arrange(grp_services_new)
kable(.grp_services_cnt, caption = "New services places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

3.5 Section 5: Transportation

3.5.1 In Date of Previous Data Collection Wave, you reported accessing these public transit stops from your home. Do you still access these places?

transp_location <- locations[locations$location_category == 16, ] %>% filter(location_current == 1)

bm + geom_sf(data = transp_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

3.5.2 Are there other public transit stops you access from your home at least once per month?

NB: Variable grp_ptransit_new has not been properly recorded in Montréal wave 2 for returning participants.

# extract and recode
.grp_ptransit <- veritas_main[c("interact_id", "grp_ptransit_new")] %>% dplyr::rename(grp_ptransit_new_code = grp_ptransit_new)
.grp_ptransit$grp_ptransit_new <- factor(ifelse(.grp_ptransit$grp_ptransit_new_code == 1, "1 [Yes]",
  ifelse(.grp_ptransit$grp_ptransit_new_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .grp_ptransit) +
  geom_histogram(aes(x = grp_ptransit_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "grp_ptransit_new")

.grp_ptransit_cnt <- .grp_ptransit %>%
  group_by(grp_ptransit_new) %>%
  dplyr::count() %>%
  arrange(grp_ptransit_new)
kable(.grp_ptransit_cnt, caption = "New transit places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

3.6 Section 6: Leisure activities

3.6.1 In Date of Previous Data Collection Wave, you reported doing leisure activities at these locations. Do you still visit these places?

leisure_lut <- data.frame(
  location_category_code = c(17, 18, 19, 20, 21, 22, 23, 24),
  location_category = factor(c(
    "17 [Leisure-time physical activity]",
    "18 [Park]",
    "19 [Cultural activity]",
    "20 [Volunteering place]",
    "21 [Religious or spiritual activity]",
    "22 [Restaurant, café, bar, etc. ]",
    "23 [Take-out]",
    "24 [Walk]"
  ))
)
leisure_location <- locations[locations$location_category %in% leisure_lut$location_category_code, ] %>%
  dplyr::rename(location_category_code = location_category) %>%
  inner_join(leisure_lut, by = "location_category_code")

# map
bm + geom_sf(data = leisure_location, inherit.aes = FALSE, aes(color = location_category), size = 1.5, alpha = .3) +
  scale_color_brewer(palette = "Accent") +
  theme(legend.position = "bottom", legend.text = element_text(size = 8), legend.title = element_blank())

# compute number of shopping locations by category
ggplot(data = leisure_location) +
  geom_histogram(aes(x = location_category), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "Leisure locations by categories")

.location_category_cnt <- as.data.frame(leisure_location[c("location_category")]) %>%
  group_by(location_category) %>%
  dplyr::count() %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Shopping locations by categories") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Shopping locations by categories

location_category	n
17 [Leisure-time physical activity]	74
18 [Park]	171
19 [Cultural activity]	14
20 [Volunteering place]	19
21 [Religious or spiritual activity]	11
22 [Restaurant, café, bar, etc. ]	86
23 [Take-out]	37
24 [Walk]	142

# compute statistics on shopping locations by participants and categories
# > one needs to account for participants who did not report location for some categories
.loc_iid_category_cnt <- as.data.frame(leisure_location[c("interact_id", "location_category")]) %>%
  group_by(interact_id, location_category) %>%
  dplyr::count()

# (cont'd) simulate SQL JOIN TABLE ON TRUE
.dummy <- data_frame(
  interact_id = character(),
  location_category = character()
)
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- data_frame(
    interact_id = as.character(iid),
    location_category = leisure_lut$location_category
  )
  .dummy <- rbind(.dummy, .dmy)
}

# (cont'd) find iid/categ combination without match in veritas locations
.no_leisure_iid <- dplyr::setdiff(.dummy, .loc_iid_category_cnt[c("location_category", "interact_id")]) %>%
  mutate(n = 0)

.loc_iid_category_cnt <- bind_rows(.loc_iid_category_cnt, .no_leisure_iid)

.location_category_cnt <- .loc_iid_category_cnt %>%
  group_by(location_category) %>%
  dplyr::summarise(min = min(n), mean = round(mean(n), 2), median = median(n), max = max(n)) %>%
  arrange(location_category)
kable(.location_category_cnt, caption = "Number of leisure locations by participant and category") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of leisure locations by participant and category

location_category	min	mean	median	max
17 [Leisure-time physical activity]	0	0.32	0	4
18 [Park]	0	0.74	0	5
19 [Cultural activity]	0	0.06	0	3
20 [Volunteering place]	0	0.08	0	3
21 [Religious or spiritual activity]	0	0.05	0	1
22 [Restaurant, café, bar, etc. ]	0	0.37	0	4
23 [Take-out]	0	0.16	0	3
24 [Walk]	0	0.62	0	4

3.6.2 Thinking about the places where you do leisure activities, are there other parks, gyms, movie theaters, concert halls, churchs, temples, restaurants, cafés, bars or any places where you do leisure activities and that you visit at least once per month?

NB: Variable grp_leisure_new has not been properly recorded in Montréal wave 2 for returning participants.

# extract and recode
.grp_leisure <- veritas_main[c("interact_id", "grp_leisure_new")] %>% dplyr::rename(grp_leisure_new_code = grp_leisure_new)
.grp_leisure$grp_leisure_new <- factor(ifelse(.grp_leisure$grp_leisure_new_code == 1, "1 [Yes]",
  ifelse(.grp_leisure$grp_leisure_new_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .grp_leisure) +
  geom_histogram(aes(x = grp_leisure_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "grp_leisure_new")

.grp_leisure_cnt <- .grp_leisure %>%
  group_by(grp_leisure_new) %>%
  dplyr::count() %>%
  arrange(grp_leisure_new)
kable(.grp_leisure_cnt, caption = "New leisure places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

3.7 Section 7: Other places/activities

3.7.1 Here are the other places you reported regularly visiting in Date of Previous Data Collection Wave. Do you still visit these places?

other_location <- locations[locations$location_category == 25, ] %>% filter(location_current == 1)

bm + geom_sf(data = other_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

3.7.2 Are there other places that you go to at least once per month that we have not mentioned? For example: a mall, a daycare, a hardware store, or a community center.

NB: Variable other_new has not been properly recorded in Montréal wave 2 for returning participants.

# extract and recode
.other <- veritas_main[c("interact_id", "other_new")] %>% dplyr::rename(other_new_code = other_new)
.other$other_new <- factor(ifelse(.other$other_new_code == 1, "1 [Yes]",
  ifelse(.other$other_new_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .other) +
  geom_histogram(aes(x = other_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "other_new")

.other_cnt <- .other %>%
  group_by(other_new) %>%
  dplyr::count() %>%
  arrange(other_new)
kable(.other_cnt, caption = "New other places") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

3.8 Section 8: Areas of change

3.8.1 Can you locate areas where you have noticed an improvement of the urban environment?

# extract and recode
.improv <- veritas_main[c("interact_id", "improvement_none")] %>% dplyr::rename(improvement_none_code = improvement_none)
.improv$improvement_none <- factor(ifelse(.improv$improvement_none_code == 1, "1 [TRUE]",
  ifelse(.improv$improvement_none_code == 0, "0 [FALSE]", "N/A")
))

# histogram of answers
ggplot(data = .improv) +
  geom_histogram(aes(x = improvement_none), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "improvement_none")

.improv_cnt <- .improv %>%
  group_by(improvement_none) %>%
  dplyr::count() %>%
  arrange(improvement_none)
kable(.improv_cnt, caption = "No area of improvement") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

No area of improvement

improvement_none	n
0 [FALSE]	142
1 [TRUE]	88

# polgon extraction
improv <- poly_geom[poly_geom$area_type == "improvement", ]

# Map
bm + geom_sf(data = improv, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
improv <- improv %>%
  mutate(area_m2 = st_area(.))
kable(t(as.matrix(summary(improv$area_m2))),
  caption = "Area (in square meters) of the perceived improvement areas",
  digits = 1
) %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived improvement areas

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
657.9	39919.3	138711.5	330809.3	323790.9	6122787

3.8.2 Can you locate areas where you have noticed a deterioration of the urban environment?

# extract and recode
.deter <- veritas_main[c("interact_id", "deterioration_none")] %>% dplyr::rename(deterioration_none_code = deterioration_none)
.deter$deterioration_none <- factor(ifelse(.deter$deterioration_none_code == 1, "1 [TRUE]",
  ifelse(.deter$deterioration_none_code == 0, "0 [FALSE]", "N/A")
))

# histogram of answers
ggplot(data = .deter) +
  geom_histogram(aes(x = deterioration_none), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "deterioration_none")

.deter_cnt <- .deter %>%
  group_by(deterioration_none) %>%
  dplyr::count() %>%
  arrange(deterioration_none)
kable(.deter_cnt, caption = "No area of deterioration") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

No area of deterioration

deterioration_none	n
0 [FALSE]	73
1 [TRUE]	157

# polgon extraction
deter <- poly_geom[poly_geom$area_type == "deterioration", ]

# Map
bm + geom_sf(data = deter, inherit.aes = FALSE, fill = alpha("blue", 0.3), color = alpha("blue", 0.5))

# Min, max, median & mean area of PRN
deter <- deter %>%
  mutate(area_m2 = st_area(.))
kable(t(as.matrix(summary(deter$area_m2))),
  caption = "Area (in square meters) of the perceived deterioration areas",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Area (in square meters) of the perceived deterioration areas

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
614.6	31916.9	100362.3	270458.8	300859.8	3679787

3.9 Section 9: Social contact

3.9.1 In Date of Previous Data Collection Wave, you reported visiting people at their home. Do you still visit these places?

visiting_location <- locations[locations$location_category == 26, ] %>% filter(location_current == 1)

bm + geom_sf(data = visiting_location, inherit.aes = FALSE, color = "blue", size = 1.8, alpha = .3)

3.9.2 Do you visit anyone else at his or her home at least once per month?

NB: Variable visiting_new has not been properly recorded in Montréal wave 2 for returning participants.

# extract and recode
.visiting <- veritas_main[c("interact_id", "visiting_new")] %>% dplyr::rename(visiting_code = visiting_new)
.visiting$visiting_new <- factor(ifelse(.visiting$visiting_code == 1, "1 [Yes]",
  ifelse(.visiting$visiting_code == 2, "2 [No]", "N/A")
))

# histogram of answers
ggplot(data = .visiting) +
  geom_histogram(aes(x = visiting_new), stat = "count") +
  scale_x_discrete(labels = function(lbl) str_wrap(lbl, width = 20)) +
  labs(x = "visiting_new")

.visiting_cnt <- .visiting %>%
  group_by(visiting_new) %>%
  dplyr::count() %>%
  arrange(visiting_new)
kable(.visiting_cnt, caption = "Social contact") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

3.9.3 Great, we are almost done completing this questionnaire. You have documented all your activity places on a map, and specified with whom you generally do these activities. These last few questions concern the people you documented earlier.

# compute statistics on groups / participant
# > one needs to account for participants who did not report any group
.gr_iid_cnt <- as.data.frame(group[c("interact_id")]) %>%
  group_by(interact_id) %>%
  dplyr::count()

# (cont'd) find iid combination without match in veritas group
.no_gr_iid <- anti_join(veritas_main[c("interact_id")], .gr_iid_cnt, by = "interact_id") %>%
  mutate(n = 0)
.gr_iid_cnt <- bind_rows(.gr_iid_cnt, .no_gr_iid)

kable(t(as.matrix(summary(.gr_iid_cnt$n))),
  caption = "Number of groups per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of groups per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	1	1.1	2	7

# compute statistics on people / participant
# > one needs to account for participants who did not report any group
.pl_iid_cnt <- as.data.frame(people[c("interact_id")]) %>%
  group_by(interact_id) %>%
  dplyr::count()

# (cont'd) find iid combination without match in veritas group
.no_pl_iid <- anti_join(veritas_main[c("interact_id")], .pl_iid_cnt, by = "interact_id") %>%
  mutate(n = 0)
.pl_iid_cnt <- bind_rows(.pl_iid_cnt, .no_pl_iid)

kable(t(as.matrix(summary(.pl_iid_cnt$n))),
  caption = "Number of people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	3	6	6.6	9	25

# histogram
.sc_iid_cnt <- .pl_iid_cnt %>% mutate(soc_type = "people")
.sc_iid_cnt <- .gr_iid_cnt %>%
  mutate(soc_type = "group") %>%
  bind_rows(.sc_iid_cnt)

ggplot(data = .sc_iid_cnt) +
  geom_histogram(aes(x = n, y = stat(count), fill = soc_type), position = "dodge") +
  labs(x = "Social network size by element type", fill = element_blank())

3.9.3.1 Among these people, who do you discuss important matters with?

# extract number of important people / participant
.n_important <- important %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_imp <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_important, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_important = n.y) %>%
  mutate(pct = 100 * n_important / n_people)

kable(t(as.matrix(summary(.n_people_imp$n_important))),
  caption = "Number of important people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of important people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	3	3.9	5	18

kable(t(as.matrix(summary(.n_people_imp$pct))),
  caption = "% of important people among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of important people among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	50	66.7	64.7	93.7	100	6

3.9.3.2 Among these people, who do you like to socialize with?

# extract number of important people / participant
.n_socialize <- socialize %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_soc <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_socialize, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_socialize = n.y) %>%
  mutate(pct = 100 * n_socialize / n_people)

kable(t(as.matrix(summary(.n_people_soc$n_socialize))),
  caption = "Number of people with whom to socialize per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of people with whom to socialize per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	2	4	4.8	7	18

kable(t(as.matrix(summary(.n_people_soc$pct))),
  caption = "% of people with whom to  socialize among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of people with whom to socialize among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	60	85.2	76.4	100	100	6

3.9.3.3 Among these people, who do you meet often with but do not necessarily feel close to?

# extract number of important people / participant
.n_not_close <- not_close %>% dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_not_close <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_not_close, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_not_close = n.y) %>%
  mutate(pct = 100 * n_not_close / n_people)

kable(t(as.matrix(summary(.n_people_not_close$n_not_close))),
  caption = "Number of not so close people per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of not so close people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	0	0.8	1	10

kable(t(as.matrix(summary(.n_people_not_close$pct))),
  caption = "% of not so close people among social contact per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of not so close people among social contact per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	0	0	13	20	100	6

3.9.3.4 Among these people, who knows whom?

# extract number of who knows who relationships
.n_relat <- relationship %>%
  filter(relationship_type == 1) %>%
  dplyr::count(interact_id)
.n_people <- people %>% dplyr::count(interact_id)

.n_people_relat <- left_join(veritas_main[c("interact_id")], .n_people, by = "interact_id") %>%
  left_join(.n_relat, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), 0)) %>%
  dplyr::rename(n_people = n.x, n_relat = n.y) %>%
  mutate(pct = 100 * n_relat * 2 / (n_people * (n_people - 1))) # potential number of relationships = N x (N -1) / 2

kable(t(as.matrix(summary(.n_people_relat$n_relat))),
  caption = "Number of relationships « who knows who » per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of relationships « who knows who » per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	6.5	13.7	18	113

kable(t(as.matrix(summary(.n_people_relat$pct))),
  caption = "% of relationships « who knows who » per participant",
  digits = 1
) %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

% of relationships « who knows who » per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
0	33.3	53.3	56.6	86.2	100	31

3.10 Derived metrics

3.10.1 Existence of improvement and deterioration areas by participant

Combination of improvement and/or deterioration areas per participant

# cross tab of improvement vs deteriation areas
.improv <- improv[c("interact_id")] %>%
  mutate(improv = "Improvement")
.deter <- deter[c("interact_id")] %>%
  mutate(deter = "Deterioration")
.ct_impr_deter <- veritas_main[c("interact_id")] %>%
  transmute(interact_id = as.character(interact_id)) %>%
  left_join(.improv, by = "interact_id") %>%
  left_join(.deter, by = "interact_id") %>%
  mutate_all(~ replace(., is.na(.), "N/A"))

kable(table(.ct_impr_deter$improv, .ct_impr_deter$deter), caption = "Improvement vs. deterioration") %>%
  kable_styling(bootstrap_options = "striped", full_width = T, position = "left", row_label_position = "r") %>%
  column_spec(1, bold = T)

Improvement vs. deterioration

	Deterioration	N/A
Improvement	51	74
N/A	17	88

3.10.2 Transportation mode preferences

Based on the answers to the question Usually, how do you go there? (Check all that apply.).

# code  en
# 1 By car and you drive
# 2 By car and someone else drives
# 3 By taxi/Uber
# 4 On foot
# 5 By bike
# 6 By bus
# 7 By subway
# 8 By train
# 99    Other

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.tm <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1) %>%
  left_join(loc_labels)

.tm_grouped <- .tm %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), "By car (driver)" = sum(location_tmode_1),
    "By car (passenger)" = sum(location_tmode_2),
    "By taxi/Uber" = sum(location_tmode_3),
    "On foot" = sum(location_tmode_4),
    "By bike" = sum(location_tmode_5),
    "By bus" = sum(location_tmode_6),
    "By train" = sum(location_tmode_7),
    "By metro" = sum(location_tmode_8),
    "Other" = sum(location_tmode_99)
  )

kable(.tm_grouped, caption = "Transportation mode preferences") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Transportation mode preferences

description	N	By car (driver)	By car (passenger)	By taxi/Uber	On foot	By bike	By bus	By train	By metro	Other
2 [Other residence]	36	24	9	0	4	3	2	0	2	2
3 [Work]	260	53	8	2	66	48	25	0	40	96
4 [School/College/University]	41	9	1	0	10	2	5	0	5	19
5 [Supermarket]	522	180	47	0	311	62	24	0	7	8
6 [Public/farmer’s market]	77	22	5	0	41	22	6	0	4	1
7 [Bakery]	134	19	4	1	108	12	7	0	1	2
8 [Specialty food store]	182	30	5	0	128	38	6	0	2	1
9 [Convenience store/Dépanneur]	78	6	0	0	73	3	0	0	0	1
10 [Liquor store/SAQ]	116	38	6	0	69	6	6	0	2	3
11 [Bank]	51	11	0	0	34	9	3	0	2	0
12 [Hair salon/barbershop]	49	19	1	1	18	10	5	0	4	1
13 [Post office]	68	16	2	0	51	5	2	0	1	0
14 [Drugstore]	169	39	3	0	124	14	5	0	1	0
15 [Doctor/healthcare provider]	43	17	1	3	12	11	5	0	3	2
16 [Public transit stop]	154	1	2	0	133	2	24	0	19	1
17 [Leisure-time physical activity]	74	15	4	0	41	23	4	0	3	2
18 [Park]	171	7	0	0	153	37	2	0	1	2
19 [Cultural activity]	14	4	2	0	6	1	3	0	0	2
20 [Volunteering place]	19	7	0	0	8	5	1	0	1	3
21 [Religious/spiritual activity]	11	3	0	0	6	1	0	0	1	1
22 [Restaurant, café, bar, etc.]	86	14	10	0	60	6	4	0	1	1
23 [Take-out]	37	13	6	0	18	1	0	0	0	1
24 [Walk]	142	10	1	0	129	20	4	0	3	0
25 [Other place]	189	62	14	0	105	14	10	0	7	2

# graph
.tm1 <- .tm %>%
  filter(location_tmode_1 == 1) %>%
  mutate(tm = "[1] By car (driver)")
.tm2 <- .tm %>%
  filter(location_tmode_2 == 1) %>%
  mutate(tm = "[2] By car (passenger)")
.tm3 <- .tm %>%
  filter(location_tmode_3 == 1) %>%
  mutate(tm = "[3] By taxi/Uber")
.tm4 <- .tm %>%
  filter(location_tmode_4 == 1) %>%
  mutate(tm = "[4] On foot")
.tm5 <- .tm %>%
  filter(location_tmode_5 == 1) %>%
  mutate(tm = "[5] By bike")
.tm6 <- .tm %>%
  filter(location_tmode_6 == 1) %>%
  mutate(tm = "[6] By bus")
# .tm7 <- .tm %>%
#   filter(location_tmode_7 == 1) %>%
#   mutate(tm = "[7] By train")
.tm8 <- .tm %>%
  filter(location_tmode_8 == 1) %>%
  mutate(tm = "[8] By metro")
.tm99 <- .tm %>%
  filter(location_tmode_99 == 1) %>%
  mutate(tm = "[99] Other")
.tm <- bind_rows(.tm1, .tm2) %>%
  bind_rows(.tm3) %>%
  bind_rows(.tm4) %>%
  bind_rows(.tm5) %>%
  bind_rows(.tm6) %>%
  #  bind_rows(.tm7) %>%
  bind_rows(.tm8) %>%
  bind_rows(.tm99)

# histogram of answers
ggplot(data = .tm) +
  geom_bar(aes(x = fct_rev(description), fill = tm), position = "fill") +
  scale_fill_brewer(palette = "Set3", name = "Transport modes") +
  scale_y_continuous(labels = percent) +
  labs(y = "Proportion of transportation mode by location category", x = element_blank()) +
  coord_flip() +
  theme(legend.position = "bottom", legend.justification = c(0, 0), legend.text = element_text(size = 8)) +
  guides(fill = guide_legend(nrow = 3))

3.10.3 Visiting places alone

Based on the answers to the question Do you usually go to this place alone or with other people?.

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.alone <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1 & location_current == 1) %>%
  left_join(loc_labels) %>%
  mutate(location_alone_recode = case_when(
    location_alone2 == 1 ~ 1,
    location_alone2 == 2 ~ 0
  ))

.alone_grouped <- .alone %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), "Visited alone" = sum(location_alone_recode),
    "Visited alone (%)" = round(sum(location_alone_recode) * 100.0 / n(), digits = 1)
  )

kable(.alone_grouped, caption = "Visiting places alone") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Visiting places alone

description	N	Visited alone	Visited alone (%)
2 [Other residence]	36	9	25.0
3 [Work]	260	123	47.3
4 [School/College/University]	41	29	70.7
5 [Supermarket]	522	399	76.4
6 [Public/farmer’s market]	77	43	55.8
7 [Bakery]	134	110	82.1
8 [Specialty food store]	182	140	76.9
9 [Convenience store/Dépanneur]	78	73	93.6
10 [Liquor store/SAQ]	116	93	80.2
11 [Bank]	51	50	98.0
12 [Hair salon/barbershop]	49	47	95.9
13 [Post office]	68	62	91.2
14 [Drugstore]	169	152	89.9
15 [Doctor/healthcare provider]	43	37	86.0
16 [Public transit stop]	154	135	87.7
17 [Leisure-time physical activity]	74	30	40.5
18 [Park]	171	66	38.6
19 [Cultural activity]	14	6	42.9
20 [Volunteering place]	19	13	68.4
21 [Religious/spiritual activity]	11	8	72.7
22 [Restaurant, café, bar, etc.]	86	31	36.0
23 [Take-out]	37	20	54.1
24 [Walk]	142	69	48.6
25 [Other place]	189	120	63.5

# histogram of answers
ggplot(data = .alone) +
  geom_bar(aes(x = fct_rev(description), fill = factor(location_alone2)), position = "fill") +
  scale_fill_brewer(palette = "Set3", name = "Visiting places", labels = c("N/A", "Alone", "With someone")) +
  scale_y_continuous(labels = percent) +
  labs(y = "Proportion of places visited alone", x = element_blank()) +
  coord_flip()

3.10.4 Visit frequency

Based on the answers to the question How often do you go there?.

loc_labels <- data.frame(location_category = c(2:26), description = c(
  " 2 [Other residence]",
  " 3 [Work]",
  " 4 [School/College/University]",
  " 5 [Supermarket]",
  " 6 [Public/farmer’s market]",
  " 7 [Bakery]",
  " 8 [Specialty food store]",
  " 9 [Convenience store/Dépanneur]",
  "10 [Liquor store/SAQ]",
  "11 [Bank]",
  "12 [Hair salon/barbershop]",
  "13 [Post office]",
  "14 [Drugstore]",
  "15 [Doctor/healthcare provider]",
  "16 [Public transit stop]",
  "17 [Leisure-time physical activity]",
  "18 [Park]",
  "19 [Cultural activity]",
  "20 [Volunteering place]",
  "21 [Religious/spiritual activity]",
  "22 [Restaurant, café, bar, etc.]",
  "23 [Take-out]",
  "24 [Walk]",
  "25 [Other place]",
  "26 [Social contact residence]"
))

# extract and summary stats
.freq <- locations %>%
  st_set_geometry(NULL) %>%
  filter(location_category != 1 & location_current == 1) %>%
  left_join(loc_labels)

.freq_grouped <- .freq %>%
  group_by(description) %>%
  dplyr::summarise(
    N = n(), min = min(location_freq_visit),
    max = max(location_freq_visit),
    mean = mean(location_freq_visit),
    median = median(location_freq_visit),
    sd = sd(location_freq_visit)
  )

kable(.freq_grouped, caption = "Visit frequency (expressed in times/year)") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Visit frequency (expressed in times/year)

description	N	min	max	mean	median	sd
2 [Other residence]	36	1	364	78.47222	52	98.346759
3 [Work]	260	0	365	160.48077	156	128.202255
4 [School/College/University]	41	0	364	139.12195	80	140.966697
5 [Supermarket]	522	0	260	45.28736	36	41.869436
6 [Public/farmer’s market]	77	2	208	37.11688	24	36.507019
7 [Bakery]	134	2	260	35.85075	24	37.559879
8 [Specialty food store]	182	0	208	33.25275	24	31.500800
9 [Convenience store/Dépanneur]	78	4	520	45.33333	24	63.408522
10 [Liquor store/SAQ]	116	2	104	22.97414	12	17.339305
11 [Bank]	51	2	52	16.33333	12	12.315302
12 [Hair salon/barbershop]	49	1	12	8.00000	10	4.198214
13 [Post office]	68	1	52	18.41176	12	14.718488
14 [Drugstore]	169	1	156	25.63314	12	23.543937
15 [Doctor/healthcare provider]	43	0	364	17.13953	2	55.329567
16 [Public transit stop]	154	0	520	70.05844	30	89.402756
17 [Leisure-time physical activity]	74	3	364	97.60811	52	95.956157
18 [Park]	171	2	364	92.54971	52	91.572932
19 [Cultural activity]	14	5	156	42.35714	30	42.487296
20 [Volunteering place]	19	12	208	60.63158	52	58.837073
21 [Religious/spiritual activity]	11	1	364	67.36364	48	99.721886
22 [Restaurant, café, bar, etc.]	86	1	156	23.88372	12	26.562875
23 [Take-out]	37	1	24	13.56757	12	6.296121
24 [Walk]	142	1	728	111.11268	52	113.026646
25 [Other place]	189	0	364	43.19048	24	63.038874

# graph
ggplot(data = .freq) +
  geom_boxplot(aes(x = fct_rev(description), y = location_freq_visit)) +
  scale_y_continuous(limits = c(0, 365)) +
  labs(y = "Visits/year (Frequency over 1 visit/day not shown)", x = element_blank()) +
  coord_flip()

3.10.5 Spatial indicators: Camille Perchoux’s toolbox

Below is a list of indicators proposed by Camille Perchoux in her paper Assessing patterns of spatial behavior in health studies: Their socio-demographic determinants and associations with transportation modes (the RECORD Cohort Study).

-- Reading Camille tbx indics from Essence table
SELECT interact_id,
  n_acti_places, n_weekly_vst, n_acti_types,
  cvx_perimeter, cvx_surface,
  min_length, max_length, median_length, 
  pct_visits_neighb, 
  n_acti_prn, pct_visits_prn, prn_area_km2
FROM essence_table.essence_perchoux_tbx
WHERE city_id = 'Montréal' AND wave_id = 2 AND status = 'return'

3.10.5.1 Indicators related to the lifestyle

Indicators	Measurement approach
Number of activity places (n_acti_places)	Count of activity places
Number of visits to places per week (n_weekly_vst)	Number of activity places per individual multiplied by the frequency of visit per week to each location, excluding the residence
Number of activity types (n_acti_types)	6 types of activities considered: 1-Residential; 2-Occupation; 3-Shopping activities; 4-Services; 5-Transportation; 6-Leisure activities (NB original categories were as follow: 1-Residential; 2-work; 3-food and other services; 4-transport station/stop; 5-recreational activity; 6-social activity)

LLindic <- ess.tab.camille %>%
  select("interact_id", "n_acti_places", "n_weekly_vst", "n_acti_types")
.llmtx <- as.matrix(summary(LLindic[c("n_acti_places", "n_weekly_vst", "n_acti_types")], digits = 1))
.llmtx <- apply(.llmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.llmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ")
kable(.llmtx, caption = "Lifestyle statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Lifestyle statistics

	n_acti_places	n_weekly_vst	n_acti_types
Min.	3	0.7	2
1st Qu.	9	8.6	4
Median	12	12.8	5
Mean	13	13.7	5
3rd Qu.	16	18.0	5
Max.	39	41.5	6

3.10.5.2 Indicators related to the geometry of the activity space

Indicators	Measurement approach
Perimeter of the convex hull (cvx_perimeter)	Perimeter of the smallest polygon containing all the activity locations of the participant (unit: km)
Surface of the convex hull (cvx_surface)	Surface of the smallest polygon containing all the activity locations of the participant (unit: km2)
Minimal road network distance from the residence to an activity place (min_length)	Minimal distance from the residence to an activity place using the road network (in meters)
Maximal road network distance from the residence to an activity place (max_length)	Maximal distance from the residence to an activity place using the road network (in meters)
Median road network distance from the residence to all activity places (median_length)	Median distance from home to all activity places using the road network (in meters)

ASindic <- ess.tab.camille %>%
  select("interact_id", "cvx_perimeter", "cvx_surface", "min_length", "max_length", "median_length")
.asmtx <- as.matrix(summary(ASindic[c("cvx_perimeter", "cvx_surface", "min_length", "max_length", "median_length")], digits = 1))
.asmtx <- apply(.asmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.asmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ")
.asmtx[is.na(.asmtx)] <- 0
kable(.asmtx, caption = "Activity space statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Activity space statistics

	cvx_perimeter	cvx_surface	min_length	max_length	median_length
Min.	8e-01	2e-03	0	4e+02	17
1st Qu.	9e+00	2e+00	7	4e+03	649
Median	2e+01	7e+00	106	7e+03	1055
Mean	6e+01	1e+02	218	2e+04	1626
3rd Qu.	3e+01	3e+01	276	1e+04	1894
Max.	4e+03	1e+04	4867	2e+05	11653

3.10.5.3 Indicators related to the importance of the residential neighborhood

Indicators	Measurement approach
Percentage of visits to places in the residential neighborhood (pct_visits_neighb)	Count of visits to places within the 500 m road network buffer centered on the residence divided by the total number of visits to places
Number of activity locations in the PRN (n_acti_prn)	Count of activity locations in the PRN
Percentage of visits in the PRN (pct_visits_prn)	Count of visits to places in the PRN divided by the total number of visits to places
Surface of the PRN (prn_area_km2)	Unit: km2

RNindic <- ess.tab.camille %>%
  select("interact_id", "pct_visits_neighb", "n_acti_prn", "pct_visits_prn", "prn_area_km2")
RNindic <- RNindic[RNindic$interact_id %in% prn$interact_id, ]
.rnmtx <- as.matrix(summary(RNindic[c("pct_visits_neighb", "n_acti_prn", "pct_visits_prn", "prn_area_km2")], digits = 1))
.rnmtx <- apply(.rnmtx, 1:2, function(x) strsplit(as.character(x), ":")[[1]][2])
rownames(.rnmtx) <- c("Min.   ", "1st Qu.", "Median ", "Mean   ", "3rd Qu.", "Max.   ", "N/A.")
.rnmtx[is.na(.rnmtx)] <- 0
kable(.rnmtx, caption = "Residential neighbourhood statistics") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Residential neighbourhood statistics

	pct_visits_neighb	n_acti_prn	pct_visits_prn	prn_area_km2
Min.	0	0	0	7e-04
1st Qu.	17	3	46	2e+00
Median	44	5	70	3e+00
Mean	43	6	63	4e+00
3rd Qu.	65	9	88	5e+00
Max.	100	29	100	3e+01
N/A.	59	0	0	0

Only participants with valid PRN considered in Residential Neighbourhood indicators (= 197 participants).

3.10.6 Social indicators: Alexandre Naud’s toolbox

See Alex’s document for a more comprehensive presentation of the social indicators.

-- Reading Alex tbx indics from Essence table
SELECT interact_id,
  people_degree, 
  socialize_size, socialize_meet, socialize_chat,
  important_size, group_degree, simmelian
FROM essence_table.essence_naud_social
WHERE city_id = 'Montréal' AND wave_id = 2 AND status = 'return'

3.10.6.1 Number of people in the network (people_degree)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = people_degree))

kable(t(as.matrix(summary(ess.tab.alex$people_degree))), caption = "people_degree") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

people_degree

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	2.25	5	6.143478	9	23

3.10.6.2 Simmelian Brokerage (simmelian)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = simmelian))

kable(t(as.matrix(summary(ess.tab.alex$simmelian))), caption = "simmelian") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

simmelian

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.	NA’s
1	2.333333	5	6.752312	9.142857	38.02083	21

3.10.6.3 Number of people with whom the participant like to socialize (socialize_size)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = socialize_size))

kable(t(as.matrix(summary(ess.tab.alex$socialize_size))), caption = "socialize_size") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_size

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	2	4	4.791304	7	18

3.10.6.4 Weekly face-to-face interactions among people with whom the participant like to socialize (socialize_meet)

ggplot(filter(ess.tab.alex, socialize_meet < 100)) +
  geom_histogram(aes(x = socialize_meet)) +
  annotate(geom = "text", x = 75, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$socialize_meet))), caption = "socialize_meet") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_meet

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	146	402.5	248697102	728	5.72e+10

3.10.6.5 Weekly ICT interactions among people with whom the participant like to socialize (socialize_chat)

ggplot(filter(ess.tab.alex, socialize_chat < 100)) +
  geom_histogram(aes(x = socialize_chat)) +
  annotate(geom = "text", x = 55, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$socialize_chat))), caption = "socialize_chat") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

socialize_chat

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	208.75	529	23603.55	1092	5200384

3.10.6.6 Number of people with whom the participant discuss important matters (important_size)

ggplot(ess.tab.alex) +
  geom_histogram(aes(x = important_size))

kable(t(as.matrix(summary(ess.tab.alex$important_size))), caption = "important_size") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

important_size

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	3	3.86087	5	18

3.10.6.7 Number of people in all groups (group_degree)

ggplot(filter(ess.tab.alex, group_degree < 100)) +
  geom_histogram(aes(x = group_degree)) +
  annotate(geom = "text", x = 20, y = 100, label = "X-axis: values over 100 not displayed", alpha = .5)

kable(t(as.matrix(summary(ess.tab.alex$group_degree))), caption = "group_degree") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

group_degree

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	0	2	4.278261	7	36