Cohort
demographics
Age distribution
summary(van_data$age) %>%
as.list() %>%
data.frame() %>%
knitr::kable(digits = 1, col.names = c("Min", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max")) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Min
|
1st Qu.
|
Median
|
Mean
|
3rd Qu.
|
Max
|
|
19
|
39
|
56
|
54.3
|
68
|
87
|
fillCount = length(unique(van_data$age))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(van_data) +
geom_histogram(aes(age, y=after_stat(count / sum(count)), fill=factor(age)), binwidth = 5, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
# Add a age category variable
age_classes <- c("18 - 30", "31 - 50", "51 - 65", "65+")
van_data <- van_data %>%
mutate(age_class = case_when(age < 31 ~ age_classes[1],
age < 51 ~ age_classes[2],
age < 66 ~ age_classes[3],
TRUE ~ age_classes[4]),
age_class = factor(age_class, levels = age_classes))
table(van_data$age_class, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Age categories', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Age categories
|
N
|
|
18 - 30
|
26
|
|
31 - 50
|
60
|
|
51 - 65
|
74
|
|
65+
|
66
|
ggplot(van_data) +
geom_bar(aes(age_class, y=after_stat(count / sum(count)), fill=age_class), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
What is your current
gender identity?
gender <- fromJSON('[
{
"label": "Man",
"value": 1
},
{
"label": "Woman",
"value": 2
},
{
"label": "Trans man",
"value": 3
},
{
"label": "Trans woman",
"value": 4
},
{
"label": "Genderqueer/Gender non-conforming",
"value": 5
},
{
"label": "Different identity",
"value": 99
}]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(gender, by=c("gender"="value")) %>%
transmute(interact_id = interact_id,
gender = label)
# Add gender as factor to dataset (for crosstab below)
van_data <- van_data %>%
left_join(gender, by=c("gender"="value")) %>%
mutate(gender_label = label) %>%
select(!label)
table(.ggpdf$gender, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Gender', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Gender
|
N
|
|
Man
|
75
|
|
Woman
|
143
|
|
Trans man
|
0
|
|
Trans woman
|
0
|
|
Genderqueer/Gender non-conforming
|
8
|
|
Different identity
|
0
|
ggplot(.ggpdf) +
geom_bar(aes(gender, y=after_stat(count / sum(count)), fill=gender), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
# grouping gender non-conforming under LGBTQ2S+
gender_groups <- c("Man", "Woman", "Gender minorities")
van_data <- van_data %>%
mutate(gender_group = case_when(gender == 1 ~ gender_groups[1],
gender == 2 ~ gender_groups[2],
TRUE ~ gender_groups[3]),
gender_group = factor(gender_group, levels = gender_groups))
What is your current
living arrangement?
NB More than one possible answer
living_arrange <- fromJSON('[
{
"label": "Alone?",
"value": 1
},
{
"label": "With a spouse (or partner)?",
"value": 2
},
{
"label": "With children?",
"value": 3
},
{
"label": "With grandchildren?",
"value": 4
},
{
"label": "With relatives or siblings?",
"value": 5
},
{
"label": "With friends?",
"value": 6
},
{
"label": "With other people?",
"value": 7
}
]')
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
living_arrange = strsplit(str_sub(living_arrange, 2, -2), ', ')) %>%
unnest(living_arrange) %>%
mutate(living_arrange = as.integer(living_arrange)) %>%
left_join(living_arrange, by=c("living_arrange"="value")) %>%
transmute(interact_id = interact_id,
living_arrange = case_when(is.na(living_arrange) ~ 'Living alone',
TRUE ~ str_sub(label, 1, -2)))
table(.ggpdf$living_arrange, useNA = "ifany") %>%
knitr::kable(col.names=c('Living arrangement', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Living arrangement
|
N
|
|
Alone
|
64
|
|
With a spouse (or partner)
|
140
|
|
With children
|
58
|
|
With friends
|
10
|
|
With grandchildren
|
1
|
|
With other people
|
7
|
|
With relatives or siblings
|
7
|
ggplot(.ggpdf) +
geom_bar(aes(x=living_arrange, y=after_stat(count / sum(count)), fill=living_arrange), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("")
Which category best
describes your annual household income, taking into account all sources
of income?
income <- fromJSON('[
{
"label": "No income",
"value": 1
},
{
"label": "$1 to $9,999",
"value": 2
},
{
"label": "$10,000 to $14,999",
"value": 3
},
{
"label": "$15,000 to $19,999",
"value": 4
},
{
"label": "$20,000 to $29,999",
"value": 5
},
{
"label": "$30,000 to $39,999",
"value": 6
},
{
"label": "$40,000 to $49,999",
"value": 7
},
{
"label": "$50,000 to $99,999",
"value": 8
},
{
"label": "$100,000 to $149,999",
"value": 9
},
{
"label": "$150,000 to $199,999",
"value": 10
},
{
"label": "$200,000 or more",
"value": 11
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(income, by=c("income"="value")) %>%
transmute(interact_id = interact_id,
income = label)
table(.ggpdf$income, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Income', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Income
|
N
|
|
No income
|
0
|
|
$1 to $9,999
|
0
|
|
$10,000 to $14,999
|
4
|
|
$15,000 to $19,999
|
7
|
|
$20,000 to $29,999
|
5
|
|
$30,000 to $39,999
|
12
|
|
$40,000 to $49,999
|
9
|
|
$50,000 to $99,999
|
54
|
|
$100,000 to $149,999
|
30
|
|
$150,000 to $199,999
|
32
|
|
$200,000 or more
|
38
|
|
I don’t know/Prefer not to answer
|
35
|
ggplot(.ggpdf) +
geom_bar(aes(y=income, x=after_stat(count / sum(count)), fill=income), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_continuous(labels=percent) + xlab("")
What is your highest
education level?
education <- fromJSON('[
{
"label": "Primary/Elementary school",
"value": 1
},
{
"label": "Secondary school",
"value": 2
},
{
"label": "Trade/Technical school or college diploma",
"value": 3
},
{
"label": "University degree",
"value": 4
},
{
"label": "Graduate degree",
"value": 5
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(education, by=c("education"="value")) %>%
transmute(interact_id = interact_id,
education = label)
table(.ggpdf$education, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Education', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Education
|
N
|
|
Primary/Elementary school
|
0
|
|
Secondary school
|
20
|
|
Trade/Technical school or college diploma
|
23
|
|
University degree
|
88
|
|
Graduate degree
|
93
|
|
I don’t know/Prefer not to answer
|
2
|
ggplot(.ggpdf) +
geom_bar(aes(education, y=after_stat(count / sum(count)), fill=education), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(25)) +
scale_y_continuous(labels=percent) + ylab("")
What is your current
employment status?
employment <- fromJSON('[
{
"label": "Retired and not working",
"value": 1
},
{
"label": "Employed full-time",
"value": 2
},
{
"label": "Employed part-time",
"value": 3
},
{
"label": "Unemployed and looking for work",
"value": 4
},
{
"label": "Unemployed and not looking for work",
"value": 5
},
{
"label": "Other",
"value": 99
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(employment, by=c("employment"="value")) %>%
transmute(interact_id = interact_id,
employment = label)
table(.ggpdf$employment, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Employment', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Employment
|
N
|
|
Retired and not working
|
61
|
|
Employed full-time
|
92
|
|
Employed part-time
|
45
|
|
Unemployed and looking for work
|
4
|
|
Unemployed and not looking for work
|
6
|
|
Other
|
18
|
ggplot(.ggpdf) +
geom_bar(aes(employment, y=after_stat(count / sum(count)), fill=employment), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(25)) +
scale_y_continuous(labels=percent) + ylab("")
To which ethnic or
cultural groups did your ancestors belong?
NB More than one ethnic group possible
ethnicity <- fromJSON('[
{
"label": "Aboriginal / Indigenous",
"value": 1
},
{
"label": "Asian",
"value": 2
},
{
"label": "Black",
"value": 3
},
{
"label": "Caucasian",
"value": 4
},
{
"label": "Latin American",
"value": 5
},
{
"label": "Middle Eastern",
"value": 6
},
{
"label": "Other",
"value": 99
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(group_id_w1_w2, by="interact_id") %>%
transmute(interact_id = interact_id,
group_id = coalesce(group_id, group_id_w1_w2)) %>%
transmute(interact_id = interact_id,
group_id = strsplit(str_sub(group_id, 2, -2), ', ')) %>%
unnest(group_id) %>%
mutate(group_id = as.integer(group_id)) %>%
left_join(ethnicity, by=c("group_id"="value")) %>%
transmute(interact_id = interact_id,
ethnicity = label) %>%
filter(!is.na(ethnicity))
table(.ggpdf$ethnicity, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Ethnicity', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Ethnicity
|
N
|
|
Aboriginal / Indigenous
|
4
|
|
Asian
|
18
|
|
Black
|
0
|
|
Caucasian
|
190
|
|
Latin American
|
7
|
|
Middle Eastern
|
3
|
|
Other
|
0
|
|
I don’t know/Prefer not to answer
|
3
|
ggplot(.ggpdf) +
geom_bar(aes(ethnicity, y=after_stat(count / sum(count)), fill=ethnicity), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(20))+
scale_y_continuous(labels=percent) + ylab("")
Housing tenure
house_tenure <- fromJSON('[
{
"label": "An owner",
"value": 1
},
{
"label": "A tenant",
"value": 2
},
{
"label": "A resident in a relative or friend’s home",
"value": 3
},
{
"label": "A resident other than in a relative or friend’s home",
"value": 4
},
{
"label": "Other",
"value": 99
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
## rename -7 to NA
van_data$house_tenure <- replace(van_data$house_tenure, van_data$house_tenure < 0, NA)
.ggpdf <- van_data %>%
left_join(van_data_w2w1, by="interact_id") %>%
transmute(interact_id = interact_id,
house_tenure = coalesce(house_tenure, house_tenure_w2, house_tenure_w1)) %>%
left_join(house_tenure, by=c("house_tenure"="value")) %>%
transmute(interact_id = interact_id,
house_tenure = label) %>%
filter(!is.na(house_tenure))
table(.ggpdf$house_tenure, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Housing tenure', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Housing tenure
|
N
|
|
An owner
|
136
|
|
A tenant
|
67
|
|
A resident in a relative or friend’s home
|
7
|
|
A resident other than in a relative or friend’s home
|
1
|
|
Other
|
7
|
|
I don’t know/Prefer not to answer
|
0
|
ggplot(.ggpdf) +
geom_bar(aes(house_tenure, y=after_stat(count / sum(count)), fill=house_tenure), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(25))+
scale_y_continuous(labels=percent) + ylab("")
Dwelling
dwelling_type <- fromJSON('[
{
"label": "A single-detached house",
"value": 1
},
{
"label": "A semi-detached house",
"value": 2
},
{
"label": "A row house",
"value": 3
},
{
"label": "An apartment (or condo) in a duplex or triplex (two or three dwellings located one above the other)",
"value": 4
},
{
"label": "An apartment (or condo) in a building that has fewer than five storeys",
"value": 5
},
{
"label": "An apartment (or condo) in a building that has five or more storeys",
"value": 6
},
{
"label": "A mobile home or other movable dwelling",
"value": 7
},
{
"label": "A seniors’ home",
"value": 8
},
{
"label": "Other",
"value": 99
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
## rename -7 to NA
van_data$dwelling_type <- replace(van_data$dwelling_type, van_data$dwelling_type < 0, NA)
.ggpdf <- van_data %>%
left_join(van_data_w2w1, by="interact_id") %>%
transmute(interact_id = interact_id,
dwelling_type = coalesce(dwelling_type, dwelling_type_w2, dwelling_type_w1)) %>%
left_join(dwelling_type, by=c("dwelling_type"="value")) %>%
transmute(interact_id = interact_id,
dwelling_type = label)%>%
filter(!is.na(dwelling_type))
table(.ggpdf$dwelling_type, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Dwelling', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Dwelling
|
N
|
|
A single-detached house
|
69
|
|
A semi-detached house
|
12
|
|
A row house
|
14
|
|
An apartment (or condo) in a duplex or triplex (two or three dwellings
located one above the other)
|
13
|
|
An apartment (or condo) in a building that has fewer than five storeys
|
66
|
|
An apartment (or condo) in a building that has five or more storeys
|
36
|
|
A mobile home or other movable dwelling
|
0
|
|
A seniors’ home
|
0
|
|
Other
|
7
|
|
I don’t know/Prefer not to answer
|
1
|
ggplot(.ggpdf) +
geom_bar(aes(y=dwelling_type, x=after_stat(count / sum(count)), fill=dwelling_type), show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_discrete(label=label_wrap(50))+
scale_x_continuous(labels=percent) + xlab("")
Returning or new
participant
van_data %>%
count(questionnaire) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F)
|
questionnaire
|
n
|
|
New
|
55
|
|
Returning
|
171
|
ggplot(van_data) +
geom_bar(aes(questionnaire, y=after_stat(count / sum(count)), fill=questionnaire), show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey")+
scale_y_continuous(labels=percent) + ylab("")
Usage (all city
greenways)
Whether participant has used intervention (ie. a city greenway)
Does participant uses any of the 10 greenways?
Global
use <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
select(interact_id, starts_with("greenway_use")) %>%
select(!starts_with("greenway_use_other")) %>%
pivot_longer(starts_with("greenway_use"), names_to = "greenway", names_prefix = "greenway_use_", values_to = "use") %>%
group_by(interact_id) %>%
summarise(use_any = min(use)) %>%
left_join(use, by=c("use_any" = "value")) %>%
transmute(interact_id = interact_id,
used_intervention = label)
# Join back newly created variable
van_data <- van_data %>%
left_join(.ggpdf, by = c("interact_id" = "interact_id"))
table(.ggpdf$used_intervention) %>%
knitr::kable(col.names = c("Use", "N")) %>%
kableExtra::kable_styling("hover", full_width = F)
ggplot(.ggpdf) +
geom_bar(aes(used_intervention, y=after_stat(count / sum(count)), fill=used_intervention), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey")+
scale_y_continuous(labels=percent) + ylab("")
By age
# Used_intervention already added
rbind(table(pull(filter(van_data, age_class == age_classes[1]), used_intervention)),
table(pull(filter(van_data, age_class == age_classes[2]), used_intervention)),
table(pull(filter(van_data, age_class == age_classes[3]), used_intervention)),
table(pull(filter(van_data, age_class == age_classes[4]), used_intervention))) %>%
t() %>%
kableExtra::kable(col.names = age_classes) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Yes
|
26
|
57
|
69
|
61
|
|
No
|
0
|
3
|
5
|
5
|
.ggpdf_pct <- van_data %>%
group_by(age_class, used_intervention) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(.ggpdf_pct) +
geom_bar(aes(x = used_intervention, y = percent, fill=used_intervention), stat = "identity", show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("percent with each age group") +
facet_wrap(vars(age_class), ncol = 2)
By gender
# Used_intervention already added
rbind(table(pull(filter(van_data, gender_group == gender_groups[1]), used_intervention)),
table(pull(filter(van_data, gender_group == gender_groups[2]), used_intervention)),
table(pull(filter(van_data, gender_group == gender_groups[3]), used_intervention))) %>%
t() %>%
kableExtra::kable(col.names = gender_groups) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
Man
|
Woman
|
Gender minorities
|
|
Yes
|
72
|
134
|
7
|
|
No
|
3
|
9
|
1
|
.ggpdf_pct <- van_data %>%
group_by(gender_group, used_intervention) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(x = used_intervention, y = percent, fill=used_intervention), stat = "identity", show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("percent with each gender group") +
facet_wrap(vars(gender_group), ncol = 2)
Do you
currently travel along any of the following routes?
Global
use <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
select(!greenway_use_other_text) %>%
pivot_longer(starts_with("greenway_use"), names_to = "greenway", names_prefix = "greenway_use_", values_to = "use") %>%
left_join(use, by=c("use" = "value")) %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
transmute(interact_id = interact_id,
greenway = greenway,
use = label)
count(.ggpdf, greenway, use) %>%
pivot_wider(names_from = use, values_from = n) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F) %>%
kableExtra::add_header_above(c(" ", "Use" = 2))
|
|
Use
|
|
greenway
|
Yes
|
No
|
|
Arbutus
|
168
|
58
|
|
Centralvalley
|
55
|
171
|
|
Comoxhelmcken
|
33
|
193
|
|
Seaside
|
170
|
56
|
|
Ontario
|
70
|
156
|
|
Granville
|
46
|
180
|
|
Ridgeway
|
75
|
151
|
|
Bcparkway
|
33
|
193
|
|
Masumi
|
40
|
186
|
|
Fraser
|
64
|
162
|
|
Other
|
31
|
195
|
van_data %>%
select(greenway_use_other_text) %>%
filter(!is.na(greenway_use_other_text)) %>%
kableExtra::kable(col.names = "Other listed greenways") %>%
kableExtra::kable_styling("hover", full_width = F)
|
Other listed greenways
|
|
Union/Adanac
|
|
Seawall
|
|
Does false creek count? the seawall on both sides I often use.
|
|
Point Grey road and the western beaches greenway
|
|
adanac bikeway
|
|
Adanac
|
|
Canada Line
|
|
29th Ave/Nanton
|
|
14th Ave
|
|
Stanley Park Drive
|
|
10th avenue
|
|
Cambie Corridor
|
|
Burnaby Mountain Greenway
|
|
10th, Windsor, 45th, Trafalgar, Highbury, 3rd, 7th,
|
|
10th Ave
|
|
Stanley Park
|
|
Ladner Dyke
|
|
Richards Street
|
|
Arbutus Corridor
|
|
UBC Endowment Lands trails (unpaved trails); Memorial park
|
|
Pacific Spirit park
|
|
Seymour Demonstration Forest1
|
|
W 11th Ave (from Maple to Vine)
|
|
Richmond: Railway, Trail along shell to Dyke Road
|
|
UBC , Spanish Banks, Granville Island
|
|
UBC Endowment lands/Pacific Spirit Park
|
|
Various paths in Burnaby, New West, Coquitlam, Maple Ridge, Surrey
|
|
Cypress
|
|
Beachfront - 7th Ave to UBC then beachfront back to Kits and home
|
|
Arbutus
|
|
UBC Marine drive
|
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$greenway))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(.ggpdf, use=='Yes')) +
geom_bar(aes(greenway, y=after_stat(count / sum(count)), fill=greenway), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("")
By age
.ggpdf <- van_data %>%
select(!greenway_use_other_text) %>%
pivot_longer(starts_with("greenway_use"), names_to = "greenway", names_prefix = "greenway_use_", values_to = "use") %>%
left_join(use, by=c("use" = "value")) %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway = greenway,
use = label)
.col_header <- c(1, rep(2, length(age_classes)))
names(.col_header) <- c(" ", age_classes)
cbind(table(select(filter(.ggpdf, age_class == age_classes[1]), greenway, use)),
table(select(filter(.ggpdf, age_class == age_classes[2]), greenway, use)),
table(select(filter(.ggpdf, age_class == age_classes[3]), greenway, use)),
table(select(filter(.ggpdf, age_class == age_classes[4]), greenway, use))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = T) %>%
kableExtra::add_header_above(.col_header)
|
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
|
Yes
|
No
|
Yes
|
No
|
Yes
|
No
|
Yes
|
No
|
|
Arbutus
|
17
|
9
|
40
|
20
|
56
|
18
|
55
|
11
|
|
Centralvalley
|
11
|
15
|
19
|
41
|
14
|
60
|
11
|
55
|
|
Comoxhelmcken
|
8
|
18
|
10
|
50
|
11
|
63
|
4
|
62
|
|
Seaside
|
22
|
4
|
47
|
13
|
57
|
17
|
44
|
22
|
|
Ontario
|
14
|
12
|
23
|
37
|
21
|
53
|
12
|
54
|
|
Granville
|
8
|
18
|
13
|
47
|
14
|
60
|
11
|
55
|
|
Ridgeway
|
8
|
18
|
16
|
44
|
25
|
49
|
26
|
40
|
|
Bcparkway
|
6
|
20
|
12
|
48
|
9
|
65
|
6
|
60
|
|
Masumi
|
7
|
19
|
5
|
55
|
14
|
60
|
14
|
52
|
|
Fraser
|
6
|
20
|
10
|
50
|
22
|
52
|
26
|
40
|
|
Other
|
3
|
23
|
8
|
52
|
11
|
63
|
9
|
57
|
.ggpdf_pct <- .ggpdf %>%
filter(use == 'Yes') %>%
group_by(age_class, greenway) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$greenway))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf_pct) +
geom_bar(aes(x = greenway, y = percent, fill=greenway), stat = "identity", show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels=percent) +
facet_wrap(vars(age_class), ncol = 2) +
ylab("percent of users with each age group")
By gender
.ggpdf <- van_data %>%
select(!greenway_use_other_text) %>%
pivot_longer(starts_with("greenway_use"), names_to = "greenway", names_prefix = "greenway_use_", values_to = "use") %>%
left_join(use, by=c("use" = "value")) %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway = greenway,
use = label)
.col_header <- c(1, rep(2, length(gender_groups)))
names(.col_header) <- c(" ", gender_groups)
cbind(table(select(filter(.ggpdf, gender_group == gender_groups[1]), greenway, use)),
table(select(filter(.ggpdf, gender_group == gender_groups[2]), greenway, use)),
table(select(filter(.ggpdf, gender_group == gender_groups[3]), greenway, use))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = T) %>%
kableExtra::add_header_above(.col_header)
|
|
Man
|
Woman
|
Gender minorities
|
|
|
Yes
|
No
|
Yes
|
No
|
Yes
|
No
|
|
Arbutus
|
57
|
18
|
108
|
35
|
3
|
5
|
|
Centralvalley
|
22
|
53
|
28
|
115
|
5
|
3
|
|
Comoxhelmcken
|
12
|
63
|
20
|
123
|
1
|
7
|
|
Seaside
|
58
|
17
|
105
|
38
|
7
|
1
|
|
Ontario
|
24
|
51
|
43
|
100
|
3
|
5
|
|
Granville
|
16
|
59
|
28
|
115
|
2
|
6
|
|
Ridgeway
|
28
|
47
|
45
|
98
|
2
|
6
|
|
Bcparkway
|
14
|
61
|
17
|
126
|
2
|
6
|
|
Masumi
|
17
|
58
|
20
|
123
|
3
|
5
|
|
Fraser
|
25
|
50
|
38
|
105
|
1
|
7
|
|
Other
|
10
|
65
|
19
|
124
|
2
|
6
|
.ggpdf_pct <- .ggpdf %>%
filter(use == 'Yes') %>%
group_by(gender_group, greenway) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$greenway))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(x = greenway, y = percent, fill=greenway), stat = "identity", show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels=percent) +
facet_wrap(vars(gender_group), ncol = 2) +
ylab("percent of users within each gender group")
Do you
currently travel along any of the following routes? (x walk or roll,
cycle, micro-mobility)
By transportation modes
Global
greenway_mode <- fromJSON('[
{
"label": "Walk or roll",
"value": 1
},
{
"label": "Cycle",
"value": 2
},
{
"label": "Use micro-mobility",
"value": 3
}
]') %>%
mutate(label = factor(label, levels = label))
#shortcut: remove greenway_mode_ to let this code run
van_data = subset(van_data, select = -c(greenway_mode_arbutus_1, greenway_mode_arbutus_2, greenway_mode_arbutus_3,
greenway_mode_centralvalley_1, greenway_mode_centralvalley_2, greenway_mode_centralvalley_3,
greenway_mode_comoxhelmcken_1, greenway_mode_comoxhelmcken_2, greenway_mode_comoxhelmcken_3,
greenway_mode_seaside_1, greenway_mode_seaside_2, greenway_mode_seaside_3,
greenway_mode_ontario_1, greenway_mode_ontario_2, greenway_mode_ontario_3,
greenway_mode_granville_1,greenway_mode_granville_2, greenway_mode_granville_3,
greenway_mode_ridgeway_1, greenway_mode_ridgeway_2, greenway_mode_ridgeway_3,
greenway_mode_bcparkway_1, greenway_mode_bcparkway_2, greenway_mode_bcparkway_3,
greenway_mode_masumi_1, greenway_mode_masumi_2, greenway_mode_masumi_3,
greenway_mode_fraser_1, greenway_mode_fraser_2, greenway_mode_fraser_3,
greenway_mode_other_1, greenway_mode_other_2, greenway_mode_other_3) )
.ggpdf <- van_data %>%
select(interact_id, starts_with("greenway_mode")) %>%
pivot_longer(starts_with("greenway_mode"), names_to = "greenway", names_prefix = "greenway_mode_", values_to = "mode") %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
filter(!is.na(mode)) %>%
transmute(interact_id = interact_id,
greenway = greenway,
mode = strsplit(str_sub(mode, 2, -2), ', ')) %>%
unnest(mode) %>%
mutate(mode = as.integer(mode)) %>%
left_join(greenway_mode, by=c("mode" = "value")) %>%
transmute(interact_id = interact_id,
greenway = greenway,
mode = label)
table(select(.ggpdf, greenway, mode)) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = T)
|
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
|
Arbutus
|
127
|
106
|
0
|
|
Centralvalley
|
16
|
51
|
0
|
|
Comoxhelmcken
|
10
|
28
|
0
|
|
Seaside
|
138
|
101
|
0
|
|
Ontario
|
23
|
62
|
0
|
|
Granville
|
40
|
15
|
0
|
|
Ridgeway
|
24
|
63
|
0
|
|
Bcparkway
|
11
|
29
|
0
|
|
Masumi
|
6
|
36
|
0
|
|
Fraser
|
44
|
31
|
0
|
|
Other
|
14
|
24
|
0
|
# Compute N of participants using one specific greenway
.ggpdf2 <- van_data %>%
select(!greenway_use_other_text) %>%
pivot_longer(starts_with("greenway_use"), names_to = "greenway", names_prefix = "greenway_use_", values_to = "use")%>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
left_join(use, by=c("use" = "value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
age_class = age_class,
greenway = greenway,
use = label) %>%
filter(use == "Yes")
.ggpdf_pct <- .ggpdf %>%
group_by(greenway, mode) %>%
drop_na(mode) %>%
summarise(n = n()) %>%
inner_join(count(.ggpdf2, greenway), by = "greenway", suffix = c("", ".tot"))%>%
mutate(percent = n / n.tot) %>%
select(!n) %>%
select(!n.tot)
ggplot(.ggpdf_pct) +
geom_bar(aes(x = greenway, y = percent, fill=mode), position = position_dodge2(preserve = "single"), stat = "identity") +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) +
ylab("percent of transp. mode used for each greenway by users of that greenway")
By age
.ggpdf <- van_data %>%
select(interact_id, age_class, starts_with("greenway_mode")) %>%
pivot_longer(starts_with("greenway_mode"), names_to = "greenway", names_prefix = "greenway_mode_", values_to = "mode") %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
filter(!is.na(mode)) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway = greenway,
mode = strsplit(str_sub(mode, 2, -2), ', ')) %>%
unnest(mode) %>%
mutate(mode = as.integer(mode)) %>%
left_join(greenway_mode, by=c("mode" = "value")) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway = greenway,
mode = label)
.col_header <- c(1, rep(3, length(age_classes)))
names(.col_header) <- c(" ", age_classes)
cbind(table(select(filter(.ggpdf, age_class == age_classes[1]), greenway, mode)),
table(select(filter(.ggpdf, age_class == age_classes[2]), greenway, mode)),
table(select(filter(.ggpdf, age_class == age_classes[3]), greenway, mode)),
table(select(filter(.ggpdf, age_class == age_classes[4]), greenway, mode))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = T) %>%
kableExtra::add_header_above(.col_header)
|
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
|
Arbutus
|
13
|
14
|
0
|
30
|
27
|
0
|
39
|
39
|
0
|
45
|
26
|
0
|
|
Centralvalley
|
5
|
10
|
0
|
8
|
18
|
0
|
2
|
13
|
0
|
1
|
10
|
0
|
|
Comoxhelmcken
|
2
|
8
|
0
|
3
|
9
|
0
|
2
|
10
|
0
|
3
|
1
|
0
|
|
Seaside
|
18
|
18
|
0
|
41
|
28
|
0
|
43
|
35
|
0
|
36
|
20
|
0
|
|
Ontario
|
6
|
12
|
0
|
7
|
23
|
0
|
6
|
19
|
0
|
4
|
8
|
0
|
|
Granville
|
6
|
5
|
0
|
13
|
4
|
0
|
12
|
3
|
0
|
9
|
3
|
0
|
|
Ridgeway
|
2
|
8
|
0
|
3
|
14
|
0
|
10
|
22
|
0
|
9
|
19
|
0
|
|
Bcparkway
|
2
|
5
|
0
|
5
|
10
|
0
|
3
|
9
|
0
|
1
|
5
|
0
|
|
Masumi
|
0
|
7
|
0
|
0
|
5
|
0
|
3
|
13
|
0
|
3
|
11
|
0
|
|
Fraser
|
3
|
4
|
0
|
7
|
5
|
0
|
18
|
9
|
0
|
16
|
13
|
0
|
|
Other
|
2
|
3
|
0
|
4
|
7
|
0
|
6
|
7
|
0
|
2
|
7
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(age_class, greenway, mode) %>%
drop_na(mode) %>%
summarise(n = n()) %>%
inner_join(count(.ggpdf2, age_class, greenway), by = c("age_class", "greenway"), suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(.ggpdf_pct) +
geom_bar(aes(x = greenway, y = percent, fill=mode), position = position_dodge2(preserve = "single"), stat = "identity") +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) +
facet_wrap(vars(age_class), ncol = 2) +
ylab("percent of transp. mode used for each greenway by users of that greenway within each age group")
By gender
.ggpdf <- van_data %>%
select(interact_id, gender_group, starts_with("greenway_mode")) %>%
pivot_longer(starts_with("greenway_mode"), names_to = "greenway", names_prefix = "greenway_mode_", values_to = "mode") %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
filter(!is.na(mode)) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway = greenway,
mode = strsplit(str_sub(mode, 2, -2), ', ')) %>%
unnest(mode) %>%
mutate(mode = as.integer(mode)) %>%
left_join(greenway_mode, by=c("mode" = "value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway = greenway,
mode = label)
.col_header <- c(1, rep(3, length(gender_groups)))
names(.col_header) <- c(" ", gender_groups)
cbind(table(select(filter(.ggpdf, gender_group == gender_groups[1]), greenway, mode)),
table(select(filter(.ggpdf, gender_group == gender_groups[2]), greenway, mode)),
table(select(filter(.ggpdf, gender_group == gender_groups[3]), greenway, mode))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = T) %>%
kableExtra::add_header_above(.col_header)
|
|
Man
|
Woman
|
Gender minorities
|
|
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
Walk or roll
|
Cycle
|
Use micro-mobility
|
|
Arbutus
|
39
|
39
|
0
|
87
|
64
|
0
|
1
|
3
|
0
|
|
Centralvalley
|
4
|
21
|
0
|
8
|
25
|
0
|
4
|
5
|
0
|
|
Comoxhelmcken
|
2
|
11
|
0
|
8
|
16
|
0
|
0
|
1
|
0
|
|
Seaside
|
42
|
39
|
0
|
90
|
57
|
0
|
6
|
5
|
0
|
|
Ontario
|
6
|
20
|
0
|
16
|
39
|
0
|
1
|
3
|
0
|
|
Granville
|
15
|
4
|
0
|
24
|
10
|
0
|
1
|
1
|
0
|
|
Ridgeway
|
7
|
24
|
0
|
17
|
37
|
0
|
0
|
2
|
0
|
|
Bcparkway
|
4
|
12
|
0
|
6
|
15
|
0
|
1
|
2
|
0
|
|
Masumi
|
1
|
17
|
0
|
5
|
16
|
0
|
0
|
3
|
0
|
|
Fraser
|
14
|
14
|
0
|
30
|
16
|
0
|
0
|
1
|
0
|
|
Other
|
5
|
8
|
0
|
8
|
14
|
0
|
1
|
2
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(gender_group, greenway, mode) %>%
drop_na(mode) %>%
summarise(n = n()) %>%
inner_join(count(.ggpdf2, gender_group, greenway), by = c("gender_group", "greenway"), suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(x = greenway, y = percent, fill=mode), position = position_dodge2(preserve = "single"), stat = "identity") +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) +
facet_wrap(vars(gender_group), ncol = 2) +
ylab("percent of transp. mode used for each greenway by users of that greenway within each gender group")
How often do you
travel along the following routes per season?
Expressed separately for winter vs. other seasons, in
day(s)/month
.ggpdf <- van_data %>%
select(interact_id, starts_with("greenway_freq")) %>%
pivot_longer(starts_with("greenway_freq"), names_to = c("season","greenway"), names_pattern = "greenway_freq_(.)_(.*)", values_to = "days") %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
filter(!is.na(days)) %>%
transmute(interact_id = interact_id,
greenway = greenway,
season = factor(case_when(season == 'a' ~ "Winter",
season == 'b' ~ "Rest of year")),
# Negative frequencies are set to NA
days = case_when(days >= 0 ~ days,
TRUE ~ NA_integer_))
.ggpdf %>%
group_by(greenway, season) %>%
summarise(mean = mean(days, na.rm = T),
median = median(days, na.rm = T),
min = min(days, na.rm = T),
max = max(days, na.rm = T)) %>%
kableExtra::kable(digits=1) %>%
kableExtra::kable_styling("hover", full_width = F)
|
greenway
|
season
|
mean
|
median
|
min
|
max
|
|
Arbutus
|
Rest of year
|
8.3
|
6.0
|
0
|
30
|
|
Arbutus
|
Winter
|
5.4
|
4.0
|
0
|
30
|
|
Centralvalley
|
Rest of year
|
6.2
|
3.0
|
1
|
22
|
|
Centralvalley
|
Winter
|
4.3
|
2.0
|
0
|
22
|
|
Comoxhelmcken
|
Rest of year
|
2.9
|
2.0
|
1
|
20
|
|
Comoxhelmcken
|
Winter
|
2.1
|
1.0
|
0
|
20
|
|
Seaside
|
Rest of year
|
8.0
|
5.5
|
0
|
30
|
|
Seaside
|
Winter
|
4.8
|
3.0
|
0
|
30
|
|
Ontario
|
Rest of year
|
5.8
|
3.5
|
1
|
30
|
|
Ontario
|
Winter
|
4.0
|
2.0
|
0
|
20
|
|
Granville
|
Rest of year
|
6.3
|
4.0
|
0
|
30
|
|
Granville
|
Winter
|
3.7
|
2.0
|
0
|
20
|
|
Ridgeway
|
Rest of year
|
6.2
|
3.0
|
0
|
30
|
|
Ridgeway
|
Winter
|
4.2
|
1.0
|
0
|
30
|
|
Bcparkway
|
Rest of year
|
4.7
|
3.0
|
1
|
25
|
|
Bcparkway
|
Winter
|
2.7
|
1.0
|
0
|
14
|
|
Masumi
|
Rest of year
|
3.8
|
2.0
|
1
|
20
|
|
Masumi
|
Winter
|
2.3
|
1.0
|
0
|
20
|
|
Fraser
|
Rest of year
|
3.3
|
2.0
|
0
|
20
|
|
Fraser
|
Winter
|
2.0
|
1.0
|
0
|
20
|
|
Other
|
Rest of year
|
8.4
|
5.0
|
1
|
25
|
|
Other
|
Winter
|
6.6
|
3.0
|
0
|
25
|
ggplot(.ggpdf) +
geom_boxplot(aes(season, days, fill=season), show.legend = FALSE) +
ylim(-5, 35) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(greenway), ncol = 3)
Number
of annual visits/uses
Annual greenway use. Computed by taking the max annual frequency
visit of any single greenway
Global
.ggpdf <- van_data %>%
select(interact_id, starts_with("greenway_freq")) %>%
pivot_longer(starts_with("greenway_freq"), names_to = c("season","greenway"), names_pattern = "greenway_freq_(.)_(.*)", values_to = "days") %>%
mutate(season_days = case_when(season == 'a' ~ 3 * coalesce(days, 0),
season == 'b' ~ 9 * coalesce(days, 0))) %>%
mutate(greenway = str_to_title(greenway),
greenway = factor(greenway, levels = unique(greenway))) %>%
group_by(interact_id, greenway) %>%
summarise(annual_days = sum(season_days)) %>%
summarise(intervention_freq_use = max(annual_days)) %>%
# Adding interact_id not visiting any greenways
right_join(select(van_data, interact_id)) %>%
transmute(interact_id = interact_id,
intervention_freq_use = as.integer(coalesce(intervention_freq_use, 0)))
# Join newly created var to van_data
van_data <- van_data %>%
left_join(.ggpdf, by = c("interact_id" = "interact_id"))
summary(.ggpdf$intervention_freq_use) %>%
as.list() %>%
data.frame() %>%
knitr::kable(digits = 1, col.names = c("Min", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max")) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Min
|
1st Qu.
|
Median
|
Mean
|
3rd Qu.
|
Max
|
|
-84
|
54
|
103.5
|
123.3
|
197.2
|
360
|
fillCount = length(unique(.ggpdf$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf) +
geom_histogram(aes(intervention_freq_use, y=after_stat(count/sum(count)), fill=factor(intervention_freq_use)), binwidth=20, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
xlab("intervention_freq_use (in days/year)") +
scale_y_continuous(labels = percent) + ylab("")
# Add a freq of use category variable
bike_freq <- c("less than once a week", "1-3 times a week", "4 or more times a week")
van_data <- van_data %>%
mutate(intervention_freq_use_class = case_when(intervention_freq_use < 52 ~ bike_freq[1],
intervention_freq_use <= 52*3 ~ bike_freq[2],
TRUE ~ bike_freq[3]),
intervention_freq_use_class = factor(intervention_freq_use_class, level = bike_freq))
table(van_data$intervention_freq_use_class, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Biking frequency', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Biking frequency
|
N
|
|
less than once a week
|
56
|
|
1-3 times a week
|
87
|
|
4 or more times a week
|
83
|
ggplot(van_data) +
geom_bar(aes(intervention_freq_use_class, y=after_stat(count/sum(count)), fill=intervention_freq_use_class), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30, hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
By age
# Var intervention_freq_use already created
fillCount = length(unique(van_data$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(van_data) +
geom_histogram(aes(intervention_freq_use, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(intervention_freq_use)), binwidth = 30, show.legend = F) + # see https://stackoverflow.com/questions/68227541/ggplot-geom-bar-plot-percentages-by-group-and-facet-wrap
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(age_class), ncol = 2) +
xlab("intervention_freq_use (in days/year)") +
scale_y_continuous(labels = percent) + ylab("percent within each age group")
By gender
# Var intervention_freq_use already created
fillCount = length(unique(van_data$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(van_data, gender_group != gender_groups[3])) +
geom_histogram(aes(intervention_freq_use, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(intervention_freq_use)), binwidth = 30, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(gender_group), ncol = 2) +
xlab("intervention_freq_use (in days/year)")+
scale_y_continuous(labels = percent) + ylab("percent within each gender group")
Do you
think that building city greenways (e.g., Arbutus Greenway, Central
Valley Greenway, Comox-Helmcken Greenway, Masumi Mitsui Greenway) is a
good or bad idea for Vancouver?
Global
greenway_idea <- fromJSON('[
{
"label": "Very good idea",
"value": 1
},
{
"label": "Somewhat good idea",
"value": 2
},
{
"label": "Somewhat bad idea",
"value": 3
},
{
"label": "Very bad idea",
"value": 4
},
{
"label": "I don’t know",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(greenway_idea, by=c("greenway_idea"="value")) %>%
transmute(interact_id = interact_id,
greenway_idea = label)
table(.ggpdf$greenway_idea, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Greenway idea', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Greenway idea
|
N
|
|
Very good idea
|
203
|
|
Somewhat good idea
|
22
|
|
Somewhat bad idea
|
0
|
|
Very bad idea
|
0
|
|
I don’t know
|
1
|
ggplot(.ggpdf) +
geom_bar(aes(greenway_idea, y=after_stat(count/sum(count)), fill=greenway_idea), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey")+
scale_y_continuous(labels = percent) + ylab("")
By age
.ggpdf <- van_data %>%
left_join(greenway_idea, by=c("greenway_idea"="value")) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_idea = label)
rbind(table(pull(filter(.ggpdf, age_class == age_classes[1]), greenway_idea)),
table(pull(filter(.ggpdf, age_class == age_classes[2]), greenway_idea)),
table(pull(filter(.ggpdf, age_class == age_classes[3]), greenway_idea)),
table(pull(filter(.ggpdf, age_class == age_classes[4]), greenway_idea))) %>%
t() %>%
kableExtra::kable(col.names = age_classes) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Very good idea
|
26
|
53
|
67
|
57
|
|
Somewhat good idea
|
0
|
7
|
6
|
9
|
|
Somewhat bad idea
|
0
|
0
|
0
|
0
|
|
Very bad idea
|
0
|
0
|
0
|
0
|
|
I don’t know
|
0
|
0
|
1
|
0
|
ggplot(.ggpdf) +
geom_bar(aes(greenway_idea, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(greenway_idea)), show.legend = F) + # see https://stackoverflow.com/questions/68227541/ggplot-geom-bar-plot-percentages-by-group-and-facet-wrap
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(age_class), ncol = 2) +
scale_y_continuous(labels = percent) + ylab("percent within each age group")
By gender
.ggpdf <- van_data %>%
left_join(greenway_idea, by=c("greenway_idea"="value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_idea = label)
rbind(table(pull(filter(.ggpdf, gender_group == gender_groups[1]), greenway_idea)),
table(pull(filter(.ggpdf, gender_group == gender_groups[2]), greenway_idea)),
table(pull(filter(.ggpdf, gender_group == gender_groups[3]), greenway_idea))) %>%
t() %>%
kableExtra::kable(col.names = gender_groups) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
Man
|
Woman
|
Gender minorities
|
|
Very good idea
|
65
|
132
|
6
|
|
Somewhat good idea
|
9
|
11
|
2
|
|
Somewhat bad idea
|
0
|
0
|
0
|
|
Very bad idea
|
0
|
0
|
0
|
|
I don’t know
|
1
|
0
|
0
|
ggplot(filter(.ggpdf, gender_group != gender_groups[3])) +
geom_bar(aes(greenway_idea, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(greenway_idea)), show.legend = F)+
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(gender_group), ncol = 2) +
scale_y_continuous(labels = percent) + ylab("percent within each gender group")
Would
any of the following amenities encourage you to use City Greenways more?
Check ALL that apply.
NB more than one possible answer
Global
greenway_amenities <- fromJSON('[
{
"label": "Recycling or waste receptacles/garbage cans",
"value": 1
},
{
"label": "Benches/seating",
"value": 2
},
{
"label": "Bicycle parking",
"value": 3
},
{
"label": "Bathrooms",
"value": 4
},
{
"label": "Lighting",
"value": 5
},
{
"label": "Water fountains",
"value": 6
},
{
"label": "Picnic areas",
"value": 7
},
{
"label": "Patios/parklets",
"value": 8
},
{
"label": "Plazas",
"value": 9
},
{
"label": "Playgrounds",
"value": 10
},
{
"label": "Mobi stations",
"value": 11
},
{
"label": "Public art",
"value": 12
},
{
"label": "Shady zones",
"value": 13
},
{
"label": "Car-free routes",
"value": 14
},
{
"label": "Green infrastructure/rain gardens",
"value": 15
},
{
"label": "Community gardens",
"value": 16
},
{
"label": "Place-making and programming",
"value": 17
},
{
"label": "Other",
"value": 99
},
{
"label": "None",
"value": 18
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
greenway_amenities = strsplit(str_sub(greenway_amenities, 2, -2), ', ')) %>%
unnest(greenway_amenities) %>%
mutate(greenway_amenities = as.integer(greenway_amenities)) %>%
left_join(greenway_amenities, by=c("greenway_amenities"="value")) %>%
transmute(interact_id = interact_id,
greenway_amenities= label)
table(.ggpdf$greenway_amenities, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
knitr::kable(col.names=c('Greenway amenities', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Greenway amenities
|
N
|
|
Car-free routes
|
183
|
|
Bathrooms
|
122
|
|
Lighting
|
121
|
|
Benches/seating
|
120
|
|
Shady zones
|
114
|
|
Water fountains
|
100
|
|
Community gardens
|
94
|
|
Recycling or waste receptacles/garbage cans
|
92
|
|
Place-making and programming
|
92
|
|
Green infrastructure/rain gardens
|
88
|
|
Bicycle parking
|
82
|
|
Patios/parklets
|
68
|
|
Public art
|
67
|
|
Picnic areas
|
61
|
|
Plazas
|
46
|
|
Playgrounds
|
34
|
|
Other
|
31
|
|
Mobi stations
|
22
|
|
None
|
4
|
fillCount = length(unique(.ggpdf$greenway_amenities))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(count(.ggpdf, greenway_amenities)) +
geom_bar(aes(y=reorder(greenway_amenities, -n), x=n/nrow(van_data), fill=reorder(greenway_amenities, -n)), stat="identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
ylab("greenway_amenities") +
scale_x_continuous(labels = percent) + xlab("")
By age
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_amenities = strsplit(str_sub(greenway_amenities, 2, -2), ', ')) %>%
unnest(greenway_amenities) %>%
mutate(greenway_amenities = as.integer(greenway_amenities)) %>%
left_join(greenway_amenities, by=c("greenway_amenities"="value")) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_amenities= label)
.ggpdf %>%
count(age_class, greenway_amenities) %>%
pivot_wider(names_from = age_class, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F) %>%
kableExtra::add_header_above(c(" ", "Age class" = 4))
|
|
Age class
|
|
greenway_amenities
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Car-free routes
|
25
|
49
|
59
|
50
|
|
Shady zones
|
18
|
32
|
32
|
32
|
|
Bathrooms
|
18
|
31
|
41
|
32
|
|
Place-making and programming
|
17
|
25
|
30
|
20
|
|
Lighting
|
16
|
39
|
40
|
26
|
|
Benches/seating
|
16
|
26
|
40
|
38
|
|
Green infrastructure/rain gardens
|
16
|
23
|
26
|
23
|
|
Recycling or waste receptacles/garbage cans
|
16
|
20
|
27
|
29
|
|
Bicycle parking
|
15
|
28
|
25
|
14
|
|
Community gardens
|
13
|
17
|
29
|
35
|
|
Picnic areas
|
13
|
16
|
20
|
12
|
|
Water fountains
|
12
|
30
|
34
|
24
|
|
Patios/parklets
|
12
|
17
|
22
|
17
|
|
Public art
|
11
|
19
|
22
|
15
|
|
Plazas
|
9
|
15
|
15
|
7
|
|
Playgrounds
|
3
|
17
|
8
|
6
|
|
Mobi stations
|
3
|
7
|
8
|
4
|
|
Other
|
2
|
8
|
11
|
10
|
|
None
|
0
|
1
|
2
|
1
|
.ggpdf_pct <- .ggpdf %>%
group_by(age_class, greenway_amenities) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$greenway_amenities))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf_pct) +
geom_bar(aes(y=reorder(greenway_amenities, -percent), x=percent, fill=reorder(greenway_amenities, -percent)), stat="identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
scale_x_continuous(labels=percent) + ylab("greenway_amenities") +
facet_wrap(vars(age_class), ncol = 2) + xlab("percent within each age group")
By gender
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_amenities = strsplit(str_sub(greenway_amenities, 2, -2), ', ')) %>%
unnest(greenway_amenities) %>%
mutate(greenway_amenities = as.integer(greenway_amenities)) %>%
left_join(greenway_amenities, by=c("greenway_amenities"="value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_amenities= label)
.ggpdf %>%
count(gender_group, greenway_amenities) %>%
pivot_wider(names_from = gender_group, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F)
|
greenway_amenities
|
Man
|
Woman
|
Gender minorities
|
|
Car-free routes
|
60
|
116
|
7
|
|
Lighting
|
43
|
74
|
4
|
|
Bathrooms
|
38
|
79
|
5
|
|
Benches/seating
|
37
|
78
|
5
|
|
Water fountains
|
35
|
63
|
2
|
|
Shady zones
|
33
|
74
|
7
|
|
Recycling or waste receptacles/garbage cans
|
31
|
57
|
4
|
|
Place-making and programming
|
30
|
58
|
4
|
|
Bicycle parking
|
29
|
49
|
4
|
|
Green infrastructure/rain gardens
|
27
|
56
|
5
|
|
Patios/parklets
|
26
|
40
|
2
|
|
Community gardens
|
24
|
65
|
5
|
|
Public art
|
21
|
41
|
5
|
|
Plazas
|
20
|
25
|
1
|
|
Picnic areas
|
18
|
42
|
1
|
|
Other
|
11
|
20
|
0
|
|
Mobi stations
|
11
|
9
|
2
|
|
Playgrounds
|
9
|
25
|
0
|
|
None
|
0
|
4
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(gender_group, greenway_amenities) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$greenway_amenities))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(y = reorder(greenway_amenities, -percent), x=percent, fill=reorder(greenway_amenities, -percent)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
scale_x_continuous(labels=percent) + xlab("percent within each gender group") + ylab("greenway_amenities") +
facet_wrap(vars(gender_group), ncol = 2)
What
are your main reasons for visiting or travelling along City Greenways?
Select up to 3.
NB more than one possible answer
Global
greenway_purpose <- fromJSON('[
{
"label": "Play (e.g., games, sports, playgrounds for kids)",
"value": 1
},
{
"label": "Seating/resting/relaxing in nature or green spaces",
"value": 2
},
{
"label": "Recreation or exercise",
"value": 3
},
{
"label": "Transportation trips (getting from A to B)",
"value": 4
},
{
"label": "Outdoor meeting space to socialize or meet people",
"value": 5
},
{
"label": "Taking part in festivals or programmed activities",
"value": 6
},
{
"label": "Other",
"value": 99
},
{
"label": "Not applicable",
"value": -7
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
greenway_purpose = strsplit(str_sub(greenway_purpose, 2, -2), ', ')) %>%
unnest(greenway_purpose) %>%
mutate(greenway_purpose = as.integer(greenway_purpose)) %>%
left_join(greenway_purpose, by=c("greenway_purpose"="value")) %>%
transmute(interact_id = interact_id,
greenway_purpose= label)
table(.ggpdf$greenway_purpose, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
knitr::kable(col.names=c('Greenway reasons', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Greenway reasons
|
N
|
|
Recreation or exercise
|
191
|
|
Transportation trips (getting from A to B)
|
175
|
|
Seating/resting/relaxing in nature or green spaces
|
64
|
|
Outdoor meeting space to socialize or meet people
|
46
|
|
Play (e.g., games, sports, playgrounds for kids)
|
17
|
|
Taking part in festivals or programmed activities
|
10
|
|
Other
|
10
|
|
Not applicable
|
4
|
ggplot(count(.ggpdf, greenway_purpose)) +
geom_bar(aes(y=reorder(greenway_purpose, -n), x=n/nrow(van_data), fill=reorder(greenway_purpose, -n)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction = -1) +
scale_x_continuous(labels = percent)+
ylab("greenway_purpose") + xlab("")
By age
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_purpose = strsplit(str_sub(greenway_purpose, 2, -2), ', ')) %>%
unnest(greenway_purpose) %>%
mutate(greenway_purpose = as.integer(greenway_purpose)) %>%
left_join(greenway_purpose, by=c("greenway_purpose"="value")) %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_purpose= label)
.ggpdf %>%
count(age_class, greenway_purpose) %>%
pivot_wider(names_from = age_class, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F) %>%
kableExtra::add_header_above(c(" ", "Age class" = 4))
|
|
Age class
|
|
greenway_purpose
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Transportation trips (getting from A to B)
|
23
|
53
|
52
|
47
|
|
Recreation or exercise
|
20
|
45
|
65
|
61
|
|
Seating/resting/relaxing in nature or green spaces
|
13
|
15
|
19
|
17
|
|
Outdoor meeting space to socialize or meet people
|
10
|
9
|
17
|
10
|
|
Taking part in festivals or programmed activities
|
2
|
3
|
4
|
1
|
|
Play (e.g., games, sports, playgrounds for kids)
|
1
|
13
|
2
|
1
|
|
Other
|
0
|
3
|
4
|
3
|
|
Not applicable
|
0
|
0
|
2
|
2
|
.ggpdf_pct <- .ggpdf %>%
group_by(age_class, greenway_purpose) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(.ggpdf_pct) +
geom_bar(aes(y = reorder(greenway_purpose, -percent), x=percent, fill=reorder(greenway_purpose, -percent)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction = -1) +
scale_x_continuous(labels=percent) +
facet_wrap(vars(age_class), ncol = 2)+
ylab("greenway_purpose") + xlab("percent within each age group")
By gender
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_purpose = strsplit(str_sub(greenway_purpose, 2, -2), ', ')) %>%
unnest(greenway_purpose) %>%
mutate(greenway_purpose = as.integer(greenway_purpose)) %>%
left_join(greenway_purpose, by=c("greenway_purpose"="value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_purpose= label)
.ggpdf %>%
count(gender_group, greenway_purpose) %>%
pivot_wider(names_from = gender_group, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F)
|
greenway_purpose
|
Man
|
Woman
|
Gender minorities
|
|
Recreation or exercise
|
65
|
122
|
4
|
|
Transportation trips (getting from A to B)
|
60
|
109
|
6
|
|
Seating/resting/relaxing in nature or green spaces
|
23
|
38
|
3
|
|
Outdoor meeting space to socialize or meet people
|
11
|
32
|
3
|
|
Other
|
3
|
7
|
0
|
|
Play (e.g., games, sports, playgrounds for kids)
|
2
|
15
|
0
|
|
Taking part in festivals or programmed activities
|
2
|
7
|
1
|
|
Not applicable
|
0
|
4
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(gender_group, greenway_purpose) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(y = reorder(greenway_purpose, -percent), x=percent, fill=reorder(greenway_purpose, -percent)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction = -1) +
scale_x_continuous(labels=percent) +
facet_wrap(vars(gender_group), ncol = 2) +
ylab("greenway_purpose") + xlab("percent within each gender group")
When
using City Greenways to make transportation trips, what are your main
destinations? Select up to 3.
NB more than one possible answer
Global
greenway_trip_purpose <- fromJSON('[
{
"label": "Parks/beaches/other public space",
"value": 1
},
{
"label": "Workplace or post-secondary institution",
"value": 2
},
{
"label": "Grade school",
"value": 3
},
{
"label": "Bus stop or SkyTrain station",
"value": 4
},
{
"label": "Grocery store",
"value": 5
},
{
"label": "Retail shopping store",
"value": 6
},
{
"label": "Doctor, pharmacy, or care facility",
"value": 7
},
{
"label": "Homes of friends or family",
"value": 8
},
{
"label": "Restaurant or dining/drinking establishments",
"value": 9
},
{
"label": "Childcare facility",
"value": 10
},
{
"label": "Public facility",
"value": 11
},
{
"label": "Entertainment venues",
"value": 12
},
{
"label": "Other",
"value": 99
},
{
"label": "Not applicable",
"value": -7
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
greenway_trip_purpose = strsplit(str_sub(greenway_trip_purpose, 2, -2), ', ')) %>%
unnest(greenway_trip_purpose) %>%
mutate(greenway_trip_purpose = as.integer(greenway_trip_purpose)) %>%
left_join(greenway_trip_purpose, by=c("greenway_trip_purpose"="value")) %>%
transmute(interact_id = interact_id,
value = greenway_trip_purpose,
greenway_trip_purpose= label) %>%
filter(!is.na(greenway_trip_purpose)) # strangely enought, some trip purposes are missing
table(.ggpdf$greenway_trip_purpose, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
knitr::kable(col.names=c('Greenway trip purpose', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Greenway trip purpose
|
N
|
|
Parks/beaches/other public space
|
98
|
|
Grocery store
|
76
|
|
Retail shopping store
|
63
|
|
Restaurant or dining/drinking establishments
|
62
|
|
Workplace or post-secondary institution
|
60
|
|
Homes of friends or family
|
56
|
|
Public facility
|
39
|
|
Bus stop or SkyTrain station
|
21
|
|
Doctor, pharmacy, or care facility
|
19
|
|
Other
|
14
|
|
Not applicable
|
14
|
|
Grade school
|
12
|
|
Entertainment venues
|
11
|
|
Childcare facility
|
1
|
fillCount = length(unique(.ggpdf$greenway_trip_purpose))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(count(.ggpdf, greenway_trip_purpose)) +
geom_bar(aes(y=reorder(greenway_trip_purpose, -n), x=n/nrow(van_data), fill=reorder(greenway_trip_purpose, -n)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
scale_x_continuous(labels = percent) +
ylab("greenway_purpose") + xlab("")
By age
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
age_class = age_class,
greenway_trip_purpose = strsplit(str_sub(greenway_trip_purpose, 2, -2), ', ')) %>%
unnest(greenway_trip_purpose) %>%
mutate(greenway_trip_purpose = as.integer(greenway_trip_purpose)) %>%
left_join(greenway_trip_purpose, by=c("greenway_trip_purpose"="value")) %>%
transmute(interact_id = interact_id,
value = greenway_trip_purpose,
age_class = age_class,
greenway_trip_purpose= label) %>%
filter(!is.na(greenway_trip_purpose)) # strangely enought, some trip purposes are missing
.ggpdf %>%
count(age_class, greenway_trip_purpose) %>%
pivot_wider(names_from = age_class, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F) %>%
kableExtra::add_header_above(c(" ", "Age class" = 4))
|
|
Age class
|
|
greenway_trip_purpose
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Parks/beaches/other public space
|
18
|
26
|
28
|
26
|
|
Workplace or post-secondary institution
|
15
|
24
|
19
|
2
|
|
Grocery store
|
11
|
22
|
16
|
27
|
|
Homes of friends or family
|
9
|
18
|
16
|
13
|
|
Restaurant or dining/drinking establishments
|
6
|
16
|
25
|
15
|
|
Retail shopping store
|
5
|
14
|
25
|
19
|
|
Bus stop or SkyTrain station
|
4
|
6
|
7
|
4
|
|
Public facility
|
2
|
9
|
14
|
14
|
|
Grade school
|
1
|
8
|
3
|
0
|
|
Other
|
1
|
4
|
5
|
4
|
|
Doctor, pharmacy, or care facility
|
1
|
1
|
5
|
12
|
|
Entertainment venues
|
1
|
1
|
4
|
5
|
|
Not applicable
|
0
|
3
|
4
|
7
|
|
Childcare facility
|
0
|
1
|
0
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(age_class, greenway_trip_purpose) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
fillCount = length(unique(.ggpdf$greenway_trip_purpose))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf_pct) +
geom_bar(aes(y=reorder(greenway_trip_purpose, -percent), x=percent, fill=reorder(greenway_trip_purpose, -percent)), stat = "identity", show.legend = FALSE) + theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
scale_x_continuous(labels=percent) +
facet_wrap(vars(age_class), ncol = 2)+
ylab("greenway_trip_purpose") + xlab("percent within each age group")
By gender
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
greenway_trip_purpose = strsplit(str_sub(greenway_trip_purpose, 2, -2), ', ')) %>%
unnest(greenway_trip_purpose) %>%
mutate(greenway_trip_purpose = as.integer(greenway_trip_purpose)) %>%
left_join(greenway_trip_purpose, by=c("greenway_trip_purpose"="value")) %>%
transmute(interact_id = interact_id,
value = greenway_trip_purpose,
gender_group = gender_group,
greenway_trip_purpose= label) %>%
filter(!is.na(greenway_trip_purpose)) # strangely enought, some trip purposes are missing
.ggpdf %>%
count(gender_group, greenway_trip_purpose) %>%
pivot_wider(names_from = gender_group, values_from = n, values_fill = 0) %>%
arrange(desc(across(where(is.numeric)))) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F)
|
greenway_trip_purpose
|
Man
|
Woman
|
Gender minorities
|
|
Parks/beaches/other public space
|
28
|
67
|
3
|
|
Retail shopping store
|
27
|
36
|
0
|
|
Workplace or post-secondary institution
|
24
|
31
|
5
|
|
Grocery store
|
22
|
53
|
1
|
|
Restaurant or dining/drinking establishments
|
15
|
46
|
1
|
|
Homes of friends or family
|
15
|
36
|
5
|
|
Doctor, pharmacy, or care facility
|
12
|
7
|
0
|
|
Public facility
|
11
|
27
|
1
|
|
Bus stop or SkyTrain station
|
7
|
11
|
3
|
|
Other
|
6
|
8
|
0
|
|
Grade school
|
3
|
8
|
1
|
|
Entertainment venues
|
3
|
8
|
0
|
|
Not applicable
|
2
|
11
|
1
|
|
Childcare facility
|
0
|
1
|
0
|
.ggpdf_pct <- .ggpdf %>%
group_by(gender_group, greenway_trip_purpose) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
fillCount = length(unique(.ggpdf$greenway_trip_purpose))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(y=reorder(greenway_trip_purpose, -percent), x=percent, fill=reorder(greenway_trip_purpose, -percent)), stat = "identity", show.legend = FALSE) + theme_light() +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_manual(values = rev(getPalette(fillCount)), na.value = "grey") +
scale_x_continuous(labels=percent) +
facet_wrap(vars(gender_group), ncol = 2) +
ylab("greenway_trip_purpose") + xlab("percent within each gender group")
Are
you using City Greenways less than, more than, or the same as you did
prior to the COVID-19
Global
cov_decon_greenway <- fromJSON('[
{
"label": "Less than before COVID-19",
"value": 1
},
{
"label": "Same as before COVID-19",
"value": 2
},
{
"label": "More than before COVID-19",
"value": 3
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(cov_decon_greenway, by=c("cov_decon_greenway"="value")) %>%
transmute(interact_id = interact_id,
cov_decon_greenway = label)
table(.ggpdf$cov_decon_greenway, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Greenway use during COVID', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Greenway use during COVID
|
N
|
|
Less than before COVID-19
|
38
|
|
Same as before COVID-19
|
124
|
|
More than before COVID-19
|
64
|
ggplot(.ggpdf) +
geom_bar(aes(cov_decon_greenway, y=after_stat(count/sum(count)), fill=cov_decon_greenway), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
By age
cov_decon_greenway <- fromJSON('[
{
"label": "Less than before COVID-19",
"value": 1
},
{
"label": "Same as before COVID-19",
"value": 2
},
{
"label": "More than before COVID-19",
"value": 3
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(cov_decon_greenway, by=c("cov_decon_greenway"="value")) %>%
transmute(interact_id = interact_id,
age_class = age_class,
cov_decon_greenway = label)
rbind(table(pull(filter(.ggpdf, age_class == age_classes[1]), cov_decon_greenway)),
table(pull(filter(.ggpdf, age_class == age_classes[2]), cov_decon_greenway)),
table(pull(filter(.ggpdf, age_class == age_classes[3]), cov_decon_greenway)),
table(pull(filter(.ggpdf, age_class == age_classes[4]), cov_decon_greenway))) %>%
t() %>%
kableExtra::kable(col.names = age_classes) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
18 - 30
|
31 - 50
|
51 - 65
|
65+
|
|
Less than before COVID-19
|
3
|
7
|
14
|
14
|
|
Same as before COVID-19
|
9
|
32
|
42
|
41
|
|
More than before COVID-19
|
14
|
21
|
18
|
11
|
.ggpdf_pct <- .ggpdf %>%
group_by(age_class, cov_decon_greenway) %>%
summarise(n = n()) %>%
inner_join(count(van_data, age_class), by = "age_class", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(.ggpdf_pct) +
geom_bar(aes(x = cov_decon_greenway, y = percent, fill=cov_decon_greenway), stat = "identity", show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) +
facet_wrap(vars(age_class), ncol = 2) + ylab("percent within each age group")
By gender
cov_decon_greenway <- fromJSON('[
{
"label": "Less than before COVID-19",
"value": 1
},
{
"label": "Same as before COVID-19",
"value": 2
},
{
"label": "More than before COVID-19",
"value": 3
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(cov_decon_greenway, by=c("cov_decon_greenway"="value")) %>%
transmute(interact_id = interact_id,
gender_group = gender_group,
cov_decon_greenway = label)
rbind(table(pull(filter(.ggpdf, gender_group == gender_groups[1]), cov_decon_greenway)),
table(pull(filter(.ggpdf, gender_group == gender_groups[2]), cov_decon_greenway)),
table(pull(filter(.ggpdf, gender_group == gender_groups[3]), cov_decon_greenway))) %>%
t() %>%
kableExtra::kable(col.names = gender_groups) %>%
kableExtra::kable_styling("hover", full_width = F)
|
|
Man
|
Woman
|
Gender minorities
|
|
Less than before COVID-19
|
12
|
25
|
1
|
|
Same as before COVID-19
|
43
|
77
|
4
|
|
More than before COVID-19
|
20
|
41
|
3
|
.ggpdf_pct <- .ggpdf %>%
group_by(gender_group, cov_decon_greenway) %>%
summarise(n = n()) %>%
inner_join(count(van_data, gender_group), by = "gender_group", suffix = c("", ".tot")) %>%
mutate(percent = n / n.tot) %>%
select(!n)
ggplot(filter(.ggpdf_pct, gender_group != gender_groups[3])) +
geom_bar(aes(x = cov_decon_greenway, y = percent, fill=cov_decon_greenway), stat = "identity", show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("percent within each gender group") +
facet_wrap(vars(gender_group), ncol = 2)
Please select all
the reasons explaining why you use City Greenways more
now than prior to the COVID-19 pandemic.
NB more than one possible answer
cov_decon_greenway_more <- fromJSON('[
{
"label": "Staying active",
"value": 1
},
{
"label": "Connect to nature",
"value": 2
},
{
"label": "To meet up with people at a distance",
"value": 3
},
{
"label": "Felt safe despite COVID-19",
"value": 4
},
{
"label": "Travel to destinations like schools, shops/services, work, etc.",
"value": 5
},
{
"label": "Nearby destination for recreation/exercise",
"value": 6
},
{
"label": "Felt safe from traffic",
"value": 7
},
{
"label": "Other",
"value": 99
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
cov_decon_greenway_more = strsplit(str_sub(cov_decon_greenway_more, 2, -2), ', ')) %>%
unnest(cov_decon_greenway_more) %>%
mutate(cov_decon_greenway_more = as.integer(cov_decon_greenway_more)) %>%
left_join(cov_decon_greenway_more, by=c("cov_decon_greenway_more"="value")) %>%
transmute(interact_id = interact_id,
cov_decon_greenway_more= label) %>%
filter(!is.na(cov_decon_greenway_more))
table(.ggpdf$cov_decon_greenway_more, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
kableExtra::kable(col.names=c('Reasons to use more', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Reasons to use more
|
N
|
|
Staying active
|
53
|
|
Felt safe from traffic
|
42
|
|
Felt safe despite COVID-19
|
35
|
|
Travel to destinations like schools, shops/services, work, etc.
|
33
|
|
Nearby destination for recreation/exercise
|
30
|
|
Connect to nature
|
27
|
|
To meet up with people at a distance
|
27
|
|
Other
|
7
|
van_data %>%
select(cov_decon_greenway_more_txt) %>%
filter(!is.na(cov_decon_greenway_more_txt)) %>%
kableExtra::kable(col.names = "Other listed reasons") %>%
kableExtra::kable_styling("hover", full_width = F)
|
Other listed reasons
|
|
I was not here before covid19
|
|
For the joy of life. Many users freely smile. Such a tonic to the
fearful times.
|
|
Did not know of the greenway before pandemic
|
|
Not working at this time - more time for biking
|
|
I’m very concerned about climate change so cycle everywhere and avoid
transit.
|
|
My youngest child is now able to ride a bike. We’ve met people who also
live along the greenway.
|
|
Back to work full time
|
ggplot(count(.ggpdf, cov_decon_greenway_more)) +
geom_bar(aes(y=reorder(cov_decon_greenway_more, -n), x=n/nrow(van_data), fill=reorder(cov_decon_greenway_more, -n)), stat = "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction = -1) +
scale_x_continuous(labels = percent) +
ylab("cov_decon_greenway_more") + xlab("")
Please select all
the reasons explaining why you use City Greenways less
now than prior to the COVID-19 pandemic.
NB more than one possible answer
cov_decon_greenway_less <- fromJSON('[
{
"label": "Motor vehicle volumes along route are too high",
"value": 1
},
{
"label": "Not enough separation from vehicles on shared roadways",
"value": 2
},
{
"label": "Too crowded- lacks adequate space for walking/rolling/cycling",
"value": 3
},
{
"label": "Didn’t feel safe because of COVID-19",
"value": 4
},
{
"label": "Too far away",
"value": 5
},
{
"label": "Doesn’t go near my desired destinations",
"value": 6
},
{
"label": "Didn’t feel safe from motor vehicle traffic",
"value": 7
},
{
"label": "Other",
"value": 99
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
transmute(interact_id = interact_id,
cov_decon_greenway_less = strsplit(str_sub(cov_decon_greenway_less, 2, -2), ', ')) %>%
unnest(cov_decon_greenway_less) %>%
mutate(cov_decon_greenway_less = as.integer(cov_decon_greenway_less)) %>%
left_join(cov_decon_greenway_less, by=c("cov_decon_greenway_less"="value")) %>%
transmute(interact_id = interact_id,
cov_decon_greenway_less= label) %>%
filter(!is.na(cov_decon_greenway_less))
table(.ggpdf$cov_decon_greenway_less, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
kableExtra::kable(col.names=c('Reasons to use less', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Reasons to use less
|
N
|
|
Other
|
17
|
|
Too crowded- lacks adequate space for walking/rolling/cycling
|
11
|
|
Didn’t feel safe because of COVID-19
|
11
|
|
Too far away
|
8
|
|
Doesn’t go near my desired destinations
|
8
|
|
Motor vehicle volumes along route are too high
|
3
|
|
Not enough separation from vehicles on shared roadways
|
2
|
|
Didn’t feel safe from motor vehicle traffic
|
2
|
van_data %>%
select(cov_decon_greenway_less_txt) %>%
filter(!is.na(cov_decon_greenway_less_txt)) %>%
unique() %>%
kableExtra::kable(col.names = "Other listed reasons") %>%
kableExtra::kable_styling("hover", full_width = F)
|
Other listed reasons
|
|
I changed schools and my new location is too far to bike (I bus)
|
|
moved to Vancouver (previously commuted from New West)
|
|
Main access point is blocked by construction
|
|
Plain laziness
|
|
Arthritic knee
|
|
Avoiding the sun on sunny days
|
|
don’t normally use them
|
|
I moved further away from the Arbutus Greenway
|
|
I simply go out less than I used to. Also, thanks to minor physical
problems, walking is a bit more of a chore than it used to be.
|
|
Don’t have the same time at home to use them
|
|
I’m looking after small children
|
|
Shifted from cycling to walking/running - greenway is a bit far from me
on foot
|
|
My health now restricts use
|
|
I use the Arbutus Greenway less because I’m older and more tired, and
take fewer walks.
|
|
No clean bathrooms
|
|
Just not travelling there as much
|
|
Retired and no longer using it as a transportation route
|
ggplot(count(.ggpdf, cov_decon_greenway_less)) +
geom_bar(aes(y=reorder(cov_decon_greenway_less, -n), x = n/nrow(van_data), fill=reorder(cov_decon_greenway_less, -n)), stat= "identity", show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction = -1) +
scale_x_continuous(labels = percent) +
ylab("cov_decon_greenway_less") + xlab("")
Main mode of
transportation
transp_main_mode <- fromJSON('[
{
"label": "Walking",
"value": 1
},
{
"label": "Cycling",
"value": 2
},
{
"label": "Public Transit",
"value": 3
},
{
"label": "Car",
"value": 4
},
{
"label": "Motorcycle or scooter",
"value": 5
},
{
"label": "Other",
"value": 99
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- van_data %>%
left_join(transp_main_mode, by=c("transp_main_mode"="value")) %>%
transmute(interact_id = interact_id,
transp_main_mode = label)
table(.ggpdf$transp_main_mode, useNA = "ifany") %>%
as.data.frame() %>%
arrange(desc(Freq)) %>%
kableExtra::kable(col.names=c('Main mode of transportation', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)
|
Main mode of transportation
|
N
|
|
Car
|
73
|
|
Walking
|
60
|
|
Cycling
|
60
|
|
Public Transit
|
27
|
|
Other
|
5
|
|
Motorcycle or scooter
|
1
|
van_data %>%
select(transp_main_mode_txt) %>%
filter(!is.na(transp_main_mode_txt)) %>%
unique() %>%
kableExtra::kable(col.names = "Other listed main transportation modes") %>%
kableExtra::kable_styling("hover", full_width = F)
|
Other listed main transportation modes
|
|
Transit/wheelchair
|
|
Walking, car
|
|
equal car, public transit and cycle
|
|
skateboard
|
|
Car and public transport, 50/50
|
ggplot(count(.ggpdf, transp_main_mode)) +
geom_bar(aes(y=reorder(transp_main_mode, -n), x=n/nrow(van_data), fill=reorder(transp_main_mode, -n)), stat="identity", show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey", direction=-1) +
scale_x_continuous(labels = percent) +
ylab("transp_main_mode") + xlab("")
4.7 Social cohesion
Derived from 5 items:
Average of 5 items scored on a scale from strongly agree to strongly disagree. Higher score indicates higher social cohesion.
4.7.1 Global
4.7.2 By frequency of use