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:

Basic descriptive statistics

Section 1: Residence and Neighbourhood

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

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

## version with leaflet || DO NOT USE -> LEAKS COORDINATES
# leaflet(data=st_cast(home_location, 'POINT'),
#              options = leafletOptions(zoomControl = FALSE, boxZoom = FALSE, scrollWheelZoom = FALSE,
#                                       dragging = FALSE, keyboard = FALSE,
#                                       minZoom = 10.5, maxZoom = 10.5)) %>%
#   addProviderTiles(providers$CartoDB.Positron) %>%
#   addCircleMarkers(radius = 3, stroke = FALSE, fillOpacity = 0.5)

## version with tmap
# tm_shape(home_location) + tm_dots() + 
#   tm_shape(basemap) + tm_fill() + tm_borders(alpha = 0.3) + 
#   tm_shape(home_location) + tm_dots(col = "blue", size = .3, alpha = .3) + 
#   tm_layout(frame = FALSE)

## version ggmap
skt_aoi <- st_bbox(filter(home_location, interact_id != "302386742"))
names(skt_aoi) <- c('left', 'bottom', 'right', 'top')
skt_aoi[['left']] <- skt_aoi[['left']] - .05
skt_aoi[['right']] <- skt_aoi[['right']] + .05
skt_aoi[['top']] <- skt_aoi[['top']] + .01
skt_aoi[['bottom']] <- skt_aoi[['bottom']] - .01

bm <- get_stamenmap(skt_aoi, zoom = 11, maptype = "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 <- 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
Saskatoon	238
Leask No. 464	1

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
2018	72
2017	32
2016	37
2015	15
2014	14
2013	11
2012	2
2011	5
2010	5
2009	5
2008	8
2007	5
2006	4
2005 - 2001	10
2000 - 1991	10
1990 - 1977	4

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

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

# Map
# leaflet(data=prn,
#         options = leafletOptions(zoomControl = FALSE, boxZoom = FALSE, scrollWheelZoom = FALSE,
#                                  dragging = FALSE, keyboard = FALSE,
#                                  minZoom = 10.5, maxZoom = 10.5)) %>%
#   addProviderTiles(providers$CartoDB.Positron) %>%
#   addPolygons(weight = 1, smoothFactor = 0.5,
#               opacity = 0.5, fillOpacity = 0.1)

## version with tmap
# tm_shape(home_location) + tm_dots() + 
#   tm_shape(basemap) + tm_fill() + tm_borders(alpha = 0.3) + 
#   tm_shape(prn) + tm_fill(col = "blue", alpha = .05) + tm_borders(col = "blue", alpha = 0.3) + 
#   tm_layout(frame = FALSE)

## 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$Shape)
kable(t(as.matrix(summary(prn$area_m2))), caption = "Area (in square meters) of the perceived residential neighborhood") %>% 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.
43.85329	248146.7	868935.6	1119673	1592615	10149615

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

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]	31
2	38
3	27
4	64
5	43
6 [Very attached]	30

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

Hours/day outside home
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	6	8	8.016736	10	15

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

Hours/day outside neighbourhood
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	4	7	6.803347	9	15

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

unsafe_area
unsafe_area	n
1 [Yes]	61
2 [No]	178

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

# Map
# leaflet(data=unsafe,
#         options = leafletOptions(zoomControl = FALSE, boxZoom = FALSE, scrollWheelZoom = FALSE,
#                                  dragging = FALSE, keyboard = FALSE,
#                                  minZoom = 10.5, maxZoom = 10.5)) %>%
#   addProviderTiles(providers$CartoDB.Positron) %>%
#   addPolygons(weight = 1, smoothFactor = 0.5,
#               opacity = 0.5, fillOpacity = 0.1)

# tm_shape(home_location) + tm_dots() + 
#   tm_shape(basemap) + tm_fill() + tm_borders(alpha = 0.3) + 
#   tm_shape(unsafe) + tm_fill(col = "blue", alpha = .05) + tm_borders(col = "blue", alpha = 0.3) + 
#   tm_layout(frame = FALSE)

## 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$Shape)
kable(t(as.matrix(summary(unsafe$area_m2))), caption = "Area (in square meters) of the perceived unsafe area") %>% 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.
110.9819	22470.05	122264.5	1846356	760141.6	23882767

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

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

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

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

Other residence
other_resid	n
1 [Yes]	37
2 [No]	202

Section 2: Occupation

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]	167
2 [No]	72

Where do you work?

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

# leaflet(data=st_cast(work_location, 'POINT'),
#              options = leafletOptions(zoomControl = FALSE, boxZoom = FALSE, scrollWheelZoom = FALSE,
#                                       dragging = FALSE, keyboard = FALSE,
#                                       minZoom = 10.5, maxZoom = 10.5)) %>%
#   addProviderTiles(providers$CartoDB.Positron) %>%
#   addCircleMarkers(radius = 3, stroke = FALSE, fillOpacity = 0.5) %>%
#   setView(-73.65, 45.55, 10.5)

# tm_shape(home_location) + tm_dots() + 
#   tm_shape(basemap) + tm_fill() + tm_borders(alpha = 0.3) + 
#   tm_shape(work_location) + tm_dots(col = "blue", size = .3, alpha = .3) + 
#   tm_layout(frame = FALSE)

bm + geom_sf(data = work_location, inherit.aes = FALSE , color = 'blue', size = 1.8, alpha = .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") %>% kable_styling(bootstrap_options = "striped", full_width = T, position = "left")

Work hours/week
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	15	35	29.01796	40	80

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]	45
2 [Sitting and standing with some walking]	57
3 [Walking, with some handling of materials generally weighing less than 25 kg (55 lbs)]	60
4 [Walking and heavy manual work often requiring handling of materials weighing over 25 kg (50 lbs)]	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]	114
2 [No]	125

Where do you study?

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

# leaflet(data=st_cast(study_location, 'POINT'),
#              options = leafletOptions(zoomControl = FALSE, boxZoom = FALSE, scrollWheelZoom = FALSE,
#                                       dragging = FALSE, keyboard = FALSE,
#                                       minZoom = 10.5, maxZoom = 10.5)) %>%
#   addProviderTiles(providers$CartoDB.Positron) %>%
#   addCircleMarkers(radius = 3, stroke = FALSE, fillOpacity = 0.5) %>%
#   setView(-73.65, 45.55, 10.5)

# tm_shape(home_location) + tm_dots() + 
#   tm_shape(basemap) + tm_fill() + tm_borders(alpha = 0.3) + 
#   tm_shape(study_location) + tm_dots(col = "blue", size = .3, alpha = .3) + 
#   tm_layout(frame = FALSE)

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

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

study hours/week
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	12	23	26.2193	39.25	84

Section 3: Shopping activities

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

Do you shop for groceries at a supermarket at least once per month?
Do you shop at a public/farmer’s market at least once per month?
Do you shop at a bakery at least once per month?
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.
Do you go to a convenience store at least once per month?
Do you go to a liquor store at least once per month?

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

# 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]	558
6 [Public/farmer’s market]	59
7 [Bakery]	48
8 [Specialty food store]	82
9 [Convenience store/Dépanneur]	153
10 [Liquor store/SAQ]	137

# 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
.dummy <- data.frame(interact_iid = character(),
                     location_category = character())
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- distinct(.loc_iid_category_cnt[c('location_category')])
  .dmy$interact_id <- as.character(iid)
  .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	mean	median	max
5 [Supermarket]	2.33	2	5
6 [Public/farmer’s market]	0.25	0	3
7 [Bakery]	0.20	0	5
8 [Specialty food store]	0.34	0	4
9 [Convenience store/Dépanneur]	0.64	0	5
10 [Liquor store/SAQ]	0.57	0	5

Section 4: Services

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

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

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

# 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 = "Shopping 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]	124
12 [Hair salon/barbershop]	96
13 [Post office]	91
14 [Drugstore]	148
15 Doctor/healthcare provider]	195

# 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_iid = character(),
                     location_category = character())
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- distinct(.loc_iid_category_cnt[c('location_category')])
  .dmy$interact_id <- as.character(iid)
  .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	mean	median	max
11 [Bank]	0.52	1	1
12 [Hair salon/barbershop]	0.40	0	1
13 [Post office]	0.38	0	1
14 [Drugstore]	0.62	1	1
15 Doctor/healthcare provider]	0.82	1	4

Section 5: Transportation

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]	213
2 [No]	26

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)

Section 6: Leisure activities

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

Do you participate in any (individual or group) sports or leisure-time physical activities at least once per month?
Do you visit a park at least once per month?
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.
Do you volunteer at least once per month?
Do you engage in any religious or spiritual activities at least once per month?
Do you go to a restaurant, café, bar or other food and drink establishment at least once per month?
Do you get take-out food at least once per month?
Do you regularly go for walks?

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

# 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]	194
18 [Park]	166
19 [Cultural activity]	99
20 [Volunteering place]	102
21 [Religious or spiritual activity]	60
22 [Restaurant, café, bar, etc. ]	401
23 [Take-out]	200
24 [Walk]	173

# 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_iid = character(),
                     location_category = character())
for (iid in as.vector(veritas_main$interact_id)) {
  .dmy <- distinct(.loc_iid_category_cnt[c('location_category')])
  .dmy$interact_id <- as.character(iid)
  .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	mean	median	max
17 [Leisure-time physical activity]	0.81	1	5
18 [Park]	0.69	0	5
19 [Cultural activity]	0.41	0	5
20 [Volunteering place]	0.43	0	5
21 [Religious or spiritual activity]	0.25	0	3
22 [Restaurant, café, bar, etc. ]	1.68	1	5
23 [Take-out]	0.84	0	5
24 [Walk]	0.72	0	5

Section 7: Other places/activities

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]	84
2 [No]	155

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)

Section 8: Areas of change

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

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

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

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

No area of improvement
improvement_none	n
0 [FALSE]	80
1 [TRUE]	159

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

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

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

Area (in square meters) of the perceived improvement areas
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
275.5406	49351.67	101151.3	909422.3	320560.3	17566408

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

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

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

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

No area of deterioration
deterioration_none	n
0 [FALSE]	49
1 [TRUE]	190

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

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

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

Area (in square meters) of the perceived deterioration areas
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
241.6006	21382.39	196625.3	1616526	892832	28222485

Section 9: Social contact

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]	128
2 [No]	111

Where does this person live?

visiting_location <- locations[locations$location_category == 26,]

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

INTERACT Saskatoon Participant VERITAS Summary - W1

Benoit THIERRY

22 octobre, 2019

VERITAS dataset description

Basic descriptive statistics

Section 1: Residence and Neighbourhood

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

When did you move to your current address?

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

How attached are you to your neighbourhood?

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

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

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)?

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

Section 2: Occupation

Are you currently working?

Where do you work?

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

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

Are you currently a registered student?

Where do you study?

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

Section 3: Shopping activities

Section 4: Services

Section 5: Transportation

Do you use public transit from your home?

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

Section 6: Leisure activities

Section 7: Other places/activities

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.

Can you locate this place?

Section 8: Areas of change

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

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