INTERACT Victoria 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 two 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
vic_aoi <- st_bbox(home_location)
names(vic_aoi) <- c("left", "bottom", "right", "top")
vic_aoi[["left"]] <- vic_aoi[["left"]] - .07
vic_aoi[["right"]] <- vic_aoi[["right"]] + .07
vic_aoi[["top"]] <- vic_aoi[["top"]] + .01
vic_aoi[["bottom"]] <- vic_aoi[["bottom"]] - .01

bm <- get_stadiamap(vic_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
Victoria	63
Saanich	39
Esquimalt	7
Oak Bay	5
Colwood	3
Langford	3
View Royal	3
Central Saanich	2
New Songhees 1A	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
2019	15
2018	26
2017	14
2016	10
2015	10
2014	5
2013	6
2012	3
2011	1
2010	2
2009	5
2008	4
2007	3
2006	1
2005 - 2001	7
2000 - 1991	11
1990 - 1965	3

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.
24435.5	574578.1	1122532	2156111	2270551	41824885

NB only 118 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]	5
2	9
3	10
4	32
5	35
6 [Very attached]	32

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.
1	8	10	9	11	14

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	6	8	7.3	9	12

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]	22
2 [No]	104

# 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.
11109.7	33768.7	94741.3	199977.2	248634.9	1499185

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]	8
2 [No]	118

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]	114
2 [No]	12

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.
7	35	38	36	40	60

2.2.4 Which of the following categories best describes the amount of physical activity required for your job?

# extract and recode
.work_pa <- veritas_main[veritas_main$working == 1, c("interact_id", "work_pa")] %>% dplyr::rename(work_pa_code = work_pa)
.work_pa$work_pa <- factor(ifelse(.work_pa$work_pa_code == 1, "1 [Mainly sitting with slight arm movements]",
  ifelse(.work_pa$work_pa_code == 2, "2 [Sitting and standing with some walking]",
    ifelse(.work_pa$work_pa_code == 3, "3 [Walking, with some handling of materials generally weighing less than 25 kg (55 lbs)]",
      ifelse(.work_pa$work_pa_code == 4, "4 [Walking and heavy manual work often requiring handling of materials weighing over 25 kg (50 lbs)]", "N/A")
    )
  )
))

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

.work_pa_cnt <- .work_pa %>%
  group_by(work_pa) %>%
  dplyr::count() %>%
  arrange(work_pa)
kable(.work_pa_cnt, caption = "Physical activity at work") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Physical activity at work

work_pa	n
1 [Mainly sitting with slight arm movements]	57
2 [Sitting and standing with some walking]	44
3 [Walking, with some handling of materials generally weighing less than 25 kg (55 lbs)]	13

2.2.5 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]	11
2 [No]	115

2.2.6 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.7 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.
1	6	10	18.1	22.5	65

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]	357
6 [Public/farmer’s market]	42
7 [Bakery]	66
8 [Specialty food store]	59
9 [Convenience store/Dépanneur]	27
10 [Liquor store/SAQ]	152

# 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.83	3	5
6 [Public/farmer’s market]	0	0.33	0	5
7 [Bakery]	0	0.52	0	5
8 [Specialty food store]	0	0.47	0	5
9 [Convenience store/Dépanneur]	0	0.21	0	3
10 [Liquor store/SAQ]	0	1.21	1	5

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]	113
12 [Hair salon/barbershop]	85
13 [Post office]	78
14 [Drugstore]	98
15 [Doctor/healthcare provider]	138

# 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.90	1	1
12 [Hair salon/barbershop]	0	0.67	1	1
13 [Post office]	0	0.62	1	1
14 [Drugstore]	0	0.78	1	1
15 [Doctor/healthcare provider]	0	1.10	1	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]	64
2 [No]	62

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]	162
18 [Park]	272
19 [Cultural activity]	54
20 [Volunteering place]	60
21 [Religious or spiritual activity]	14
22 [Restaurant, café, bar, etc. ]	285
23 [Take-out]	94
24 [Walk]	178

# 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	1.29	1	5
18 [Park]	0	2.16	2	5
19 [Cultural activity]	0	0.43	0	4
20 [Volunteering place]	0	0.48	0	5
21 [Religious or spiritual activity]	0	0.11	0	2
22 [Restaurant, café, bar, etc. ]	0	2.26	2	5
23 [Take-out]	0	0.75	0	5
24 [Walk]	0	1.41	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]	43
2 [No]	83

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

Participants were not asked for areas of change in Victoria

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]	70
2 [No]	56

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") %>% 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.603175	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") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of people per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	2	4	4.976191	7	22

# 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	2	2.9	4	11

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	48.3	66.7	65.9	100	100	7

NB In Victoria, 3 participants also listed groups in this catagory, hence the max value over 100%.

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	3	3.7	6	14

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	54.5	100	77.5	100	100	7

NB In Victoria, 6 participants also listed groups in this catagory, hence the max value over 100%.

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.9	1	6

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	16.8	27.9	100	7

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.2	4.5	10.5	14	123

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	52	76.2	73.4	100	100	31

2.10 Derived metrics

2.10.1 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),
    "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	Other
2 [Other residence]	9	3	4	0	1	6	1	0	1
3 [Work]	146	28	5	0	26	115	24	0	9
4 [School/College/University]	14	1	0	0	3	9	8	0	2
5 [Supermarket]	357	190	39	0	129	182	9	0	2
6 [Public/farmer’s market]	42	16	4	0	17	23	1	0	1
7 [Bakery]	66	18	3	0	32	31	2	0	1
8 [Specialty food store]	59	18	6	0	28	31	4	0	1
9 [Convenience store/Dépanneur]	27	7	1	0	16	8	1	0	1
10 [Liquor store/SAQ]	152	61	7	0	68	77	4	0	0
11 [Bank]	113	38	4	0	48	60	7	0	1
12 [Hair salon/barbershop]	85	24	0	0	37	52	6	0	0
13 [Post office]	78	27	3	0	46	43	2	0	1
14 [Drugstore]	98	38	5	0	55	52	3	0	2
15 [Doctor/healthcare provider]	138	57	10	0	30	79	17	0	1
16 [Public transit stop]	125	1	1	0	108	10	14	0	3
17 [Leisure-time physical activity]	162	61	21	0	51	84	5	0	2
18 [Park]	272	56	19	0	163	102	3	0	3
19 [Cultural activity]	54	28	8	0	10	19	4	0	1
20 [Volunteering place]	60	24	5	0	18	37	5	0	1
21 [Religious/spiritual activity]	14	5	1	0	2	10	3	0	1
22 [Restaurant, café, bar, etc.]	285	80	40	0	155	141	18	0	3
23 [Take-out]	94	42	12	0	29	25	1	0	8
24 [Walk]	178	30	13	0	146	19	2	0	2
25 [Other place]	70	27	9	1	13	43	5	0	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")
.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(.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.2 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]	9	1	11.1
3 [Work]	146	28	19.2
4 [School/College/University]	14	5	35.7
5 [Supermarket]	357	221	61.9
6 [Public/farmer’s market]	42	7	16.7
7 [Bakery]	66	44	66.7
8 [Specialty food store]	59	38	64.4
9 [Convenience store/Dépanneur]	27	18	66.7
10 [Liquor store/SAQ]	152	115	75.7
11 [Bank]	113	101	89.4
12 [Hair salon/barbershop]	85	82	96.5
13 [Post office]	78	69	88.5
14 [Drugstore]	98	77	78.6
15 [Doctor/healthcare provider]	138	114	82.6
16 [Public transit stop]	125	89	71.2
17 [Leisure-time physical activity]	162	65	40.1
18 [Park]	272	80	29.4
19 [Cultural activity]	54	7	13.0
20 [Volunteering place]	60	27	45.0
21 [Religious/spiritual activity]	14	3	21.4
22 [Restaurant, café, bar, etc.]	285	66	23.2
23 [Take-out]	94	54	57.4
24 [Walk]	178	87	48.9
25 [Other place]	70	24	34.3

# 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.3 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]	9	12	180	70.666667	52	63.466527
3 [Work]	146	2	365	200.123288	260	95.499478
4 [School/College/University]	14	0	260	104.214286	52	107.137710
5 [Supermarket]	357	0	364	57.722689	52	54.682165
6 [Public/farmer’s market]	42	2	208	28.023809	24	33.142330
7 [Bakery]	66	3	156	35.909091	24	33.702192
8 [Specialty food store]	59	1	260	51.237288	36	52.429374
9 [Convenience store/Dépanneur]	27	3	104	35.037037	24	33.419802
10 [Liquor store/SAQ]	152	2	156	27.513158	12	26.856249
11 [Bank]	113	1	156	18.699115	12	24.345315
12 [Hair salon/barbershop]	85	2	24	5.882353	4	4.351824
13 [Post office]	78	1	208	15.512821	5	33.651670
14 [Drugstore]	98	3	156	22.336735	12	25.847668
15 [Doctor/healthcare provider]	138	1	104	5.594203	3	10.962869
16 [Public transit stop]	125	0	520	41.512000	12	69.371443
17 [Leisure-time physical activity]	162	0	364	95.154321	52	73.396530
18 [Park]	272	1	728	75.992647	48	98.722392
19 [Cultural activity]	54	1	364	27.851852	12	53.145016
20 [Volunteering place]	60	1	364	50.050000	24	77.923566
21 [Religious/spiritual activity]	14	12	364	80.000000	36	111.890056
22 [Restaurant, café, bar, etc.]	285	2	520	29.771930	12	47.414050
23 [Take-out]	94	0	104	14.712766	12	14.871942
24 [Walk]	178	2	1820	100.977528	52	167.162594
25 [Other place]	70	4	260	55.585714	24	69.408994

# 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.4 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 = 'Victoria' AND wave_id = 2 AND status = 'new'

2.10.4.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.	6	5	4
1st Qu.	16	15	5
Median	22	21	5
Mean	22	23	5
3rd Qu.	28	27	6
Max.	44	62	6

2.10.4.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.	6	1	2e-01	2e+03	580
1st Qu.	17	15	9e+01	7e+03	1591
Median	28	29	3e+02	1e+04	2275
Mean	238	459	5e+02	2e+04	2802
3rd Qu.	40	66	6e+02	2e+04	3274
Max.	15708	12852	2e+04	2e+05	17381

2.10.4.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	0	0.02
1st Qu.	0.3	2	13	0.57
Median	5.1	4	30	1.12
Mean	15.0	6	32	2.16
3rd Qu.	28.1	9	44	2.27
Max.	70.5	18	100	41.82
N/A.	44	0	0	0

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

2.10.5 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 = 'Victoria' AND wave_id = 2 AND status = 'new'

2.10.5.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	4	4.976191	7	22

2.10.5.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	4.083333	7.325	8.909501	11.83088	40.85106	12

2.10.5.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	3	3.68254	6	14

2.10.5.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	355	434	42261.19	792.5	5199948

2.10.5.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	235	484	1436.69	1132	36860

2.10.5.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	2	2.920635	4	11

2.10.5.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	5	7.214286	10.75	39

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
vic_aoi <- st_bbox(home_location)
names(vic_aoi) <- c("left", "bottom", "right", "top")
vic_aoi[["left"]] <- vic_aoi[["left"]] - .07
vic_aoi[["right"]] <- vic_aoi[["right"]] + .07
vic_aoi[["top"]] <- vic_aoi[["top"]] + .01
vic_aoi[["bottom"]] <- vic_aoi[["bottom"]] - .01

bm <- get_stadiamap(vic_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
Victoria	49
Saanich	33
Esquimalt	7
Langford	2
Oak Bay	2
View Royal	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.
8476.6	720596.6	1278462	2466199	2564457	35334533

NB only 87 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]	1
2	3
3	3
4	24
5	35
6 [Very attached]	28

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.
1	6	9	8.4	10	15

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	3.2	8	6.5	9	15

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]	15
2 [No]	79

# 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.
4690	41624.9	149243.7	249137.5	352565.1	867053.9

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]	1
2 [No]	93

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]	77
2 [No]	17

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.
5	35	37	35.9	40	84

3.2.4 Which of the following categories best describes the amount of physical activity required for your job?

# extract and recode
.work_pa <- veritas_main[veritas_main$working == 1, c("interact_id", "work_pa")] %>% dplyr::rename(work_pa_code = work_pa)
.work_pa$work_pa <- factor(ifelse(.work_pa$work_pa_code == 1, "1 [Mainly sitting with slight arm movements]",
  ifelse(.work_pa$work_pa_code == 2, "2 [Sitting and standing with some walking]",
    ifelse(.work_pa$work_pa_code == 3, "3 [Walking, with some handling of materials generally weighing less than 25 kg (55 lbs)]",
      ifelse(.work_pa$work_pa_code == 4, "4 [Walking and heavy manual work often requiring handling of materials weighing over 25 kg (50 lbs)]", "N/A")
    )
  )
))

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

.work_pa_cnt <- .work_pa %>%
  group_by(work_pa) %>%
  dplyr::count() %>%
  arrange(work_pa)
kable(.work_pa_cnt, caption = "Physical activity at work") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Physical activity at work

work_pa	n
1 [Mainly sitting with slight arm movements]	35
2 [Sitting and standing with some walking]	34
3 [Walking, with some handling of materials generally weighing less than 25 kg (55 lbs)]	6
4 [Walking and heavy manual work often requiring handling of materials weighing over 25 kg (50 lbs)]	2

3.2.5 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]	2
2 [No]	92

3.2.6 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.7 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	6.8	9.5	9.5	12.2	15

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]	273
6 [Public/farmer’s market]	35
7 [Bakery]	53
8 [Specialty food store]	47
9 [Convenience store/Dépanneur]	13

# 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.90	3	5
6 [Public/farmer’s market]	0	0.37	0	4
7 [Bakery]	0	0.56	0	4
8 [Specialty food store]	0	0.50	0	5
9 [Convenience store/Dépanneur]	0	0.14	0	3
10 [Liquor store/SAQ]	0	0.00	0	0

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?

NB: Variable grp_shopping_new has not been properly recorded in Victoria wave 2 for returning participants.

# 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")

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]	72
12 [Hair salon/barbershop]	48
13 [Post office]	59
14 [Drugstore]	69
15 Doctor/healthcare provider]	86

# 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.77	1	1
12 [Hair salon/barbershop]	0	0.51	1	1
13 [Post office]	0	0.63	1	1
14 [Drugstore]	0	0.73	1	1
15 Doctor/healthcare provider]	0	0.91	1	5

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 Victoria 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 Victoria 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]	113
18 [Park]	180
19 [Cultural activity]	64
20 [Volunteering place]	37
21 [Religious or spiritual activity]	5
22 [Restaurant, café, bar, etc. ]	196
23 [Take-out]	46
24 [Walk]	168

# 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	1.20	1	5
18 [Park]	0	1.91	1	5
19 [Cultural activity]	0	0.68	0	5
20 [Volunteering place]	0	0.39	0	3
21 [Religious or spiritual activity]	0	0.05	0	1
22 [Restaurant, café, bar, etc. ]	0	2.09	2	5
23 [Take-out]	0	0.49	0	5
24 [Walk]	0	1.79	1	5

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 Victoria 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 Victoria 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

Participants were not asked for areas of change in Victoria

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 Victoria 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") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Number of groups per participant

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	1	2	2.329787	3	8

# 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") %>% 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	5	7.117021	9.75	53

# 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	2	3.3	4	19

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	33.3	57.1	57.4	83.3	100	1

NB In Victoria, 3 participants also listed groups in this catagory, hence the max value over 100%.

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	1	3.5	5	6.8	25

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	53.8	80	74.4	100	100	1

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	1	2	7

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.3	25	100	1

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	13.2	18	75

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	29.1	50	55.6	95	100	15

3.10 Derived metrics

3.10.1 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 & location_current == 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),
    "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	Other
2 [Other residence]	1	1	0	0	0	0	0	0	0
3 [Work]	106	18	2	0	15	85	13	1	12
4 [School/College/University]	2	1	0	0	0	1	1	0	0
5 [Supermarket]	273	118	35	0	88	170	4	0	4
6 [Public/farmer’s market]	35	8	3	0	13	19	1	0	0
7 [Bakery]	53	9	9	0	25	35	0	0	1
8 [Specialty food store]	47	18	6	0	18	22	0	0	0
9 [Convenience store/Dépanneur]	13	0	0	0	12	9	0	0	0
11 [Bank]	72	21	4	0	33	50	3	0	0
12 [Hair salon/barbershop]	48	8	0	0	18	29	2	0	1
13 [Post office]	59	19	1	0	31	38	0	0	0
14 [Drugstore]	69	24	3	0	35	45	3	0	0
15 [Doctor/healthcare provider]	86	30	5	0	17	60	5	0	3
16 [Public transit stop]	97	1	0	0	93	2	4	0	1
17 [Leisure-time physical activity]	113	40	17	0	29	70	5	0	3
18 [Park]	180	36	29	0	109	78	7	0	0
19 [Cultural activity]	64	19	5	0	26	39	9	0	1
20 [Volunteering place]	37	12	2	0	12	23	1	0	4
21 [Religious/spiritual activity]	5	2	1	0	2	4	0	0	0
22 [Restaurant, café, bar, etc.]	196	43	14	2	106	98	17	0	2
23 [Take-out]	46	21	14	1	18	19	1	0	2
24 [Walk]	168	24	15	0	137	61	2	0	0
25 [Other place]	57	21	8	0	17	37	3	1	2
26 [Social contact residence]	78	36	11	0	28	43	4	0	0

# 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")
.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(.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.2 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]	1	0	0.0
3 [Work]	106	24	22.6
4 [School/College/University]	2	1	50.0
5 [Supermarket]	273	190	69.6
6 [Public/farmer’s market]	35	14	40.0
7 [Bakery]	53	28	52.8
8 [Specialty food store]	47	29	61.7
9 [Convenience store/Dépanneur]	13	11	84.6
11 [Bank]	72	67	93.1
12 [Hair salon/barbershop]	48	46	95.8
13 [Post office]	59	54	91.5
14 [Drugstore]	69	61	88.4
15 [Doctor/healthcare provider]	86	76	88.4
16 [Public transit stop]	97	76	78.4
17 [Leisure-time physical activity]	113	35	31.0
18 [Park]	180	49	27.2
19 [Cultural activity]	64	13	20.3
20 [Volunteering place]	37	12	32.4
21 [Religious/spiritual activity]	5	1	20.0
22 [Restaurant, café, bar, etc.]	196	42	21.4
23 [Take-out]	46	19	41.3
24 [Walk]	168	52	31.0
25 [Other place]	57	23	40.4
26 [Social contact residence]	78	NA	NA

# 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.3 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]	1	36	36	36.00000	36	NA
3 [Work]	106	1	988	210.67925	260	123.284151
4 [School/College/University]	2	72	260	166.00000	166	132.936075
5 [Supermarket]	273	1	312	51.85348	36	58.004695
6 [Public/farmer’s market]	35	1	104	20.11429	12	23.574377
7 [Bakery]	53	2	208	29.88679	12	43.656729
8 [Specialty food store]	47	1	156	28.89362	20	29.368894
9 [Convenience store/Dépanneur]	13	4	156	38.00000	12	49.571497
11 [Bank]	72	1	60	16.15278	12	15.963567
12 [Hair salon/barbershop]	48	0	24	5.81250	4	5.114253
13 [Post office]	59	1	208	15.03390	6	27.930928
14 [Drugstore]	69	2	208	28.42029	12	36.971931
15 [Doctor/healthcare provider]	86	0	52	5.77907	2	8.430199
16 [Public transit stop]	97	0	260	23.64948	6	50.043740
17 [Leisure-time physical activity]	113	0	364	80.61947	52	88.179334
18 [Park]	180	0	364	54.72778	24	78.559079
19 [Cultural activity]	64	1	260	23.43750	9	40.063788
20 [Volunteering place]	37	2	364	76.08108	24	114.753692
21 [Religious/spiritual activity]	5	52	364	156.00000	52	147.078211
22 [Restaurant, café, bar, etc.]	196	0	520	26.09184	11	53.288203
23 [Take-out]	46	2	52	11.89130	12	10.511852
24 [Walk]	168	1	364	63.36310	24	88.074371
25 [Other place]	57	0	728	56.84211	24	106.741140
26 [Social contact residence]	78	1	364	48.84615	18	72.614277

# 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.4 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 = 'Victoria' AND wave_id = 2 AND status = 'return'

3.10.4.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.	2	4	2
1st Qu.	16	12	5
Median	21	18	5
Mean	21	20	5
3rd Qu.	25	23	6
Max.	46	56	6

3.10.4.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.	6	0	1e-02	2e+03	7e+02
1st Qu.	16	11	9e+01	6e+03	2e+03
Median	27	34	3e+02	1e+04	2e+03
Mean	66	329	2e+03	2e+04	4e+03
3rd Qu.	41	78	5e+02	2e+04	3e+03
Max.	2509	24094	2e+05	2e+05	2e+05

3.10.4.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	8e-03
1st Qu.	0	2	8	7e-01
Median	8	4	31	1e+00
Mean	16	5	29	2e+00
3rd Qu.	29	8	43	3e+00
Max.	63	26	99	4e+01
N/A.	19	0	0	0

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

3.10.5 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 = 'Victoria' AND wave_id = 2 AND status = 'return'

3.10.5.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	3	4.5	6.404255	9	36

3.10.5.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	3	9.589744	12.25945	19.26923	62.92308	1

3.10.5.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	3.5	4.978723	6	25

3.10.5.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	364	460	1220.106	734	52000

3.10.5.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	314	552	892.0851	1040	5720

3.10.5.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	2	3.255319	4	19

3.10.5.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	2.25	7	10.70213	16.5	74