INTERACT, Victoria, wave 3
B. Thierry, Spherelab
27 October, 2022
1 Cohort demographics
1.1 Age distribution
summary(vic_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 |
|---|---|---|---|---|---|
| 18 | 37 | 44 | 47.5 | 60 | 82 |
fillCount = length(unique(vic_data$age))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_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 - 40", "41 - 50", "51 - 65", "65+")
vic_data <- vic_data %>%
mutate(age_class = case_when(age < 31 ~ age_classes[1],
age < 41 ~ age_classes[2],
age < 51 ~ age_classes[3],
age < 66 ~ age_classes[4],
TRUE ~ age_classes[5]),
age_class = factor(age_class, levels = age_classes))
table(vic_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 | 27 |
| 31 - 40 | 75 |
| 41 - 50 | 49 |
| 51 - 65 | 79 |
| 65+ | 30 |
ggplot(vic_data) +
geom_bar(aes(age_class, y=after_stat(count / sum(count)), fill=age_class), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
1.2 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": 6
}]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(gender, by=c("gender"="value")) %>%
transmute(pid = interact_id,
gender = label)
# Add gender as factor to dataset (for crosstab below)
vic_data <- vic_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 | 101 |
| Woman | 151 |
| Trans man | 3 |
| Trans woman | 1 |
| Genderqueer/Gender non-conforming | 3 |
| Different identity | 1 |
ggplot(.ggpdf) +
geom_bar(aes(gender, y=after_stat(count / sum(count)), fill=gender), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
# grouping gender non-conforming under LGBTQ2S+
gender_groups <- c("Man", "Woman", "Gender minorites")
vic_data <- vic_data %>%
mutate(gender_group = case_when(gender == 1 ~ gender_groups[1],
gender == 2 ~ gender_groups[2],
TRUE ~ gender_groups[3]),
gender_group = factor(gender_group, levels = gender_groups))1.3 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
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
transmute(pid = 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(pid = pid,
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 | 45 |
| With a spouse (or partner) | 188 |
| With children | 82 |
| With friends | 14 |
| With grandchildren | 4 |
| With other people | 5 |
| With relatives or siblings | 10 |
ggplot(.ggpdf) +
geom_bar(aes(x=living_arrange, y=after_stat(count / sum(count)), fill=living_arrange), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("")
1.4 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 <- vic_data %>%
left_join(income, by=c("income"="value")) %>%
transmute(pid = interact_id,
income = label)
table(.ggpdf$income, useNA = "ifany") %>%
knitr::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 | 2 |
| $15,000 to $19,999 | 3 |
| $20,000 to $29,999 | 8 |
| $30,000 to $39,999 | 11 |
| $40,000 to $49,999 | 14 |
| $50,000 to $99,999 | 72 |
| $100,000 to $149,999 | 73 |
| $150,000 to $199,999 | 37 |
| $200,000 or more | 17 |
| I don’t know/Prefer not to answer | 23 |
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("")
1.5 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 <- vic_data %>%
left_join(education, by=c("education"="value")) %>%
transmute(pid = 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 | 7 |
| Trade/Technical school or college diploma | 41 |
| University degree | 97 |
| Graduate degree | 110 |
| I don’t know/Prefer not to answer | 5 |
ggplot(.ggpdf) +
geom_bar(aes(education, y=after_stat(count / sum(count)), fill=education), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(25)) +
scale_y_continuous(labels=percent) + ylab("")
1.6 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": 6
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(employment, by=c("employment"="value")) %>%
transmute(pid = 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 | 40 |
| Employed full-time | 161 |
| Employed part-time | 28 |
| Unemployed and looking for work | 7 |
| Unemployed and not looking for work | 7 |
| Other | 17 |
ggplot(.ggpdf) +
geom_bar(aes(employment, y=after_stat(count / sum(count)), fill=employment), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(25)) +
scale_y_continuous(labels=percent) + ylab("")
1.7 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 <- vic_data %>%
transmute(pid = interact_id,
ethnicity = strsplit(str_sub(group_id, 2, -2), ', ')) %>%
unnest(ethnicity) %>%
mutate(ethnicity = as.integer(ethnicity)) %>%
left_join(ethnicity, by=c("ethnicity"="value")) %>%
transmute(pid = pid,
ethnicity = label)
table(.ggpdf$ethnicity, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Ethnicity', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| Ethnicity | N |
|---|---|
| Aboriginal / Indigenous | 7 |
| Asian | 13 |
| Black | 1 |
| Caucasian | 235 |
| Latin American | 2 |
| Middle Eastern | 3 |
| Other | 0 |
| I don’t know/Prefer not to answer | 7 |
ggplot(.ggpdf) +
geom_bar(aes(ethnicity, y=after_stat(count / sum(count)), fill=ethnicity), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_x_discrete(labels = scales::label_wrap(20))+
scale_y_continuous(labels=percent) + ylab("")
1.8 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": 5
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(house_tenure, by=c("house_tenure"="value")) %>%
transmute(pid = interact_id,
house_tenure = label)
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 | 163 |
| A tenant | 79 |
| A resident in a relative or friend’s home | 11 |
| A resident other than in a relative or friend’s home | 0 |
| Other | 5 |
| I don’t know/Prefer not to answer | 2 |
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("")
1.9 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": 9
},
{
"label": "I don’t know/Prefer not to answer",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(dwelling_type, by=c("dwelling_type"="value")) %>%
transmute(pid = interact_id,
dwelling_type = label)
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 | 137 |
| A semi-detached house | 13 |
| A row house | 17 |
| An apartment (or condo) in a duplex or triplex (two or three dwellings located one above the other) | 15 |
| An apartment (or condo) in a building that has fewer than five storeys | 46 |
| An apartment (or condo) in a building that has five or more storeys | 21 |
| A mobile home or other movable dwelling | 1 |
| A seniors’ home | 0 |
| Other | 8 |
| I don’t know/Prefer not to answer | 2 |
ggplot(.ggpdf) +
geom_bar(aes(y=dwelling_type, x=after_stat(count / sum(count)), fill=dwelling_type), show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_discrete(label=label_wrap(50))+
scale_x_continuous(labels=percent) + xlab("")
1.10 Returning or new participant
vic_data %>%
count(status) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F)| status | n |
|---|---|
| New | 95 |
| Returning | 165 |
ggplot(vic_data) +
geom_bar(aes(status, y=after_stat(count / sum(count)), fill=status), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey")+
scale_y_continuous(labels=percent) + ylab("")
1.11 Home location
Exact home locations have been randomly shifted by as much as 800m
## version ggmap
aoi <- st_bbox(vic_cp)
names(aoi) <- c('left', 'bottom', 'right', 'top')
aoi[['left']] <- aoi[['left']] - .05
aoi[['right']] <- aoi[['right']] + .05
aoi[['top']] <- aoi[['top']] + .025
aoi[['bottom']] <- aoi[['bottom']] - .025
bm <- get_stamenmap(aoi, zoom = 12, maptype = "toner-lite") %>% ggmap(extent = 'device')
bm + geom_sf(data = st_jitter(vic_cp, .008), aes(color=status), inherit.aes = FALSE , size =2.5, alpha = .3) + #see https://github.com/r-spatial/sf/issues/336
theme(legend.position = "bottom") +
scale_color_brewer(name="Type of participation", palette = "Set1")
1.12 Maps of destinations
Data from the VERITAS spatial questionnaire
1.12.1 By type of destination
vic_veritas_sf <- vic_veritas %>%
filter(!is.na(lat)) %>%
filter(coalesce(still_visit, 1) != 2) %>%
st_as_sf(coords = c("lng", "lat"), crs = 4326, na.fail = F)
aoi <- st_bbox(vic_cp)
names(aoi) <- c('left', 'bottom', 'right', 'top')
aoi[['left']] <- aoi[['left']] - .05
aoi[['right']] <- aoi[['right']] + .05
aoi[['top']] <- aoi[['top']] + .025
aoi[['bottom']] <- aoi[['bottom']] - .025
bm <- get_stamenmap(aoi, zoom = 12, maptype = "toner-lite") %>% ggmap(extent = 'device')
bm + geom_sf(data = st_jitter(vic_veritas_sf, .001), aes(color=loc_type), inherit.aes = FALSE , size = 2.5, alpha = .3) + #see https://github.com/r-spatial/sf/issues/336
#theme(legend.position = "bottom") +
scale_color_brewer(name="Type of location", palette = "Accent")
1.12.2 By mode of transport
.ggpdf <- vic_veritas_sf %>%
mutate(trsp_mode = case_when(location_tmode %in% c('[1]', '[2]', '[3]') ~ 'By car',
location_tmode == '[4]' ~ 'On foot',
location_tmode == '[5]' ~ 'By bicycle',
location_tmode %in% c('[6]', '[7]', '[8]') ~ 'By public transit',
location_tmode == '[99]' ~ 'Other',
TRUE ~ 'Mixed modes'),
trsp_mode = factor(trsp_mode, level = c('By car', 'On foot', 'By bicycle', 'By public transit', 'Other', 'Mixed modes')))
bm + geom_sf(data = st_jitter(.ggpdf, .001), aes(color=trsp_mode), inherit.aes = FALSE , size = 2.5, alpha = .3) + #see https://github.com/r-spatial/sf/issues/336
#theme(legend.position = "bottom") +
scale_color_brewer(name="Mode of transport", palette = "Set1")
2 General transportation and mobility
2.1 How often are your cycling trips made with an e-bike?
ebike <- fromJSON('[
{
"label": "Never",
"value": 1
},
{
"label": "Sometimes",
"value": 2
},
{
"label": "Often",
"value": 3
},
{
"label": "Always",
"value": 4
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(ebike, by=c("ebike"="value")) %>%
transmute(pid = interact_id,
ebike = label)
table(.ggpdf$ebike, useNA = "ifany") %>%
kableExtra::kable(col.names=c('e-bike use', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| e-bike use | N |
|---|---|
| Never | 200 |
| Sometimes | 15 |
| Often | 20 |
| Always | 25 |
ggplot(.ggpdf) +
geom_bar(aes(ebike, y=after_stat(count / sum(count)), fill=ebike), show.legend = FALSE) +
theme_light() +
#theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
scale_y_continuous(labels=percent) + ylab("")
2.2 How often are your cycling trips made with children?
bike_children <- fromJSON('[
{
"label": "Never",
"value": 1
},
{
"label": "Sometimes",
"value": 2
},
{
"label": "Often",
"value": 3
},
{
"label": "Always",
"value": 4
},
{
"label": "I don’t know",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(bike_children, by=c("bike_children"="value")) %>%
transmute(pid = interact_id,
bike_children = label)
table(.ggpdf$bike_children, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Biking with children', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| Biking with children | N |
|---|---|
| Never | 189 |
| Sometimes | 34 |
| Often | 35 |
| Always | 2 |
| I don’t know | 0 |
ggplot(.ggpdf) +
geom_bar(aes(bike_children, y=after_stat(count / sum(count)), fill=bike_children), 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("")
3 AAA network specific
3.1 Do you currently travel along any of the following routes?
use <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
},
{
"label": "I don’t know",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
vicroads <- fromJSON('[
{
"label": "Cook Street or Fifth Street",
"value": "a"
},
{
"label": "Fairfield Road or Humboldt Street",
"value": "b"
},
{
"label": "Fort Street",
"value": "c"
},
{
"label": "Government Street",
"value": "d"
},
{
"label": "Haultain Street or Kings Road",
"value": "e"
},
{
"label": "Pandora Avenue",
"value": "f"
},
{
"label": "Shelbourne Street or Begbie Street",
"value": "g"
},
{
"label": "Harbour Road, Wharf Street, or Belleville Street",
"value": "h"
},
{
"label": "Galloping Goose Trail or the E and N Trail",
"value": "i"
},
{
"label": "Vancouver Street",
"value": "j"
},
{
"label": "Dallas Road",
"value": "k"
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
pivot_longer(starts_with("vicroads"), names_to = "vicroads", names_prefix = "vicroads_", values_to = "use") %>%
left_join(use, by=c("use" = "value")) %>%
left_join(vicroads, by=c("vicroads" = "value"), suffix=c("", ".vicrd")) %>%
transmute(pid = interact_id,
vicroads = label.vicrd,
use = label)
count(.ggpdf, vicroads, use) %>%
pivot_wider(names_from = use, values_from = n, values_fill = 0) %>%
arrange(desc(Yes)) %>%
kableExtra::kable() %>%
kableExtra::kable_styling("hover", full_width = F) %>%
kableExtra::add_header_above(c(" ", "Use" = 3))| vicroads | Yes | No | I don’t know |
|---|---|---|---|
| Galloping Goose Trail or the E and N Trail | 238 | 22 | 0 |
| Pandora Avenue | 226 | 34 | 0 |
| Fort Street | 209 | 49 | 2 |
| Harbour Road, Wharf Street, or Belleville Street | 208 | 49 | 3 |
| Government Street | 190 | 68 | 2 |
| Dallas Road | 190 | 69 | 1 |
| Vancouver Street | 185 | 71 | 4 |
| Haultain Street or Kings Road | 169 | 88 | 3 |
| Cook Street or Fifth Street | 150 | 109 | 1 |
| Fairfield Road or Humboldt Street | 145 | 113 | 2 |
| Shelbourne Street or Begbie Street | 90 | 166 | 4 |
# Extend color palette (see https://www.r-bloggers.com/2013/09/how-to-expand-color-palette-with-ggplot-and-rcolorbrewer/)
fillCount = length(unique(.ggpdf$vicroads))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
filter(.ggpdf, use=='Yes') %>%
count(vicroads) %>%
ggplot() +
geom_bar(aes(y=reorder(vicroads, -n), x=n/nrow(vic_data), fill=reorder(vicroads, -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("vicroads") +
scale_x_continuous(labels = percent) + xlab("")
3.2 Whether participant has used intervention
Does participant uses any of the 11 roads for biking?
3.2.1 Global
use <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
},
{
"label": "I don’t know",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
select(interact_id, starts_with("vicroads")) %>%
pivot_longer(starts_with("vicroads"), names_to = "vicroads", names_prefix = "vicroads_", values_to = "use") %>%
group_by(interact_id) %>%
summarise(use_any = min(use)) %>%
left_join(use, by=c("use_any" = "value")) %>%
transmute(pid = interact_id,
used_intervention = label)
# Join back newly created variable
vic_data <- vic_data %>%
left_join(.ggpdf, by = c("interact_id" = "pid"))
table(.ggpdf$used_intervention) %>%
knitr::kable(col.names = c("Use", "N")) %>%
kableExtra::kable_styling("hover", full_width = F)| Use | N |
|---|---|
| Yes | 259 |
| No | 1 |
| I don’t know | 0 |
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("")
3.2.2 By age
# Used_intervention already added
rbind(table(pull(filter(vic_data, age_class == age_classes[1]), used_intervention)),
table(pull(filter(vic_data, age_class == age_classes[2]), used_intervention)),
table(pull(filter(vic_data, age_class == age_classes[3]), used_intervention)),
table(pull(filter(vic_data, age_class == age_classes[4]), used_intervention)),
table(pull(filter(vic_data, age_class == age_classes[5]), used_intervention))) %>%
t() %>%
kableExtra::kable(col.names = age_classes) %>%
kableExtra::kable_styling("hover", full_width = F)| 18 - 30 | 31 - 40 | 41 - 50 | 51 - 65 | 65+ | |
|---|---|---|---|---|---|
| Yes | 27 | 75 | 49 | 79 | 29 |
| No | 0 | 0 | 0 | 0 | 1 |
| I don’t know | 0 | 0 | 0 | 0 | 0 |
.ggpdf_pct <- vic_data %>%
group_by(age_class, used_intervention) %>%
summarise(n = n()) %>%
inner_join(count(vic_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)
3.2.3 By gender
# Used_intervention already added
rbind(table(pull(filter(vic_data, gender_group == gender_groups[1]), used_intervention)),
table(pull(filter(vic_data, gender_group == gender_groups[2]), used_intervention)),
table(pull(filter(vic_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 minorites | |
|---|---|---|---|
| Yes | 101 | 150 | 8 |
| No | 0 | 1 | 0 |
| I don’t know | 0 | 0 | 0 |
.ggpdf_pct <- vic_data %>%
filter(gender_group != gender_groups[3]) %>%
group_by(gender_group, used_intervention) %>%
summarise(n = n()) %>%
inner_join(count(vic_data, gender_group), by = "gender_group", 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 gender group") +
facet_wrap(vars(gender_group), ncol = 2)
3.3 Number of annual visits/uses
Swaping AAA network annual use by bike use frequency (as in Essence table)
3.3.1 Global
# Join newly created var to van_data
vic_data <- vic_data %>%
mutate(intervention_freq_use = na_if(bike_freq_covid_a, -7) + na_if(bike_freq_covid_b, -7) + na_if(bike_freq_covid_c, -7) + na_if(bike_freq_covid_d, -7))
summary(vic_data$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 |
|---|---|---|---|---|---|
| 0 | 84 | 164 | 168.2 | 260 | 364 |
fillCount = length(unique(vic_data$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_data) +
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")
vic_data <- vic_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(vic_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 | 42 |
| 1-3 times a week | 87 |
| 4 or more times a week | 131 |
ggplot(vic_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("")
3.3.2 By age
# Var intervention_freq_use already created
fillCount = length(unique(vic_data$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_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")
3.3.3 By gender
# Var intervention_freq_use already created
fillCount = length(unique(vic_data$intervention_freq_use))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(vic_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")
3.4 Have you ever heard of the All Ages and Abilities (AAA) Network?
aaa_familiarity <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(aaa_familiarity, by=c("aaa_familiarity"="value")) %>%
transmute(pid = interact_id,
aaa_familiarity = label)
table(.ggpdf$aaa_familiarity, useNA = "ifany") %>%
kableExtra::kable(col.names=c('AAA familiarity', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| AAA familiarity | N |
|---|---|
| Yes | 219 |
| No | 41 |
ggplot(.ggpdf) +
geom_bar(aes(aaa_familiarity, y=after_stat(count/sum(count)), fill=aaa_familiarity), 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("")
3.5 Do you think that the All Ages and Abilities (AAA) Network is a good or bad idea for Victoria?
aaa_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 <- vic_data %>%
left_join(aaa_idea, by=c("aaa_idea"="value")) %>%
transmute(pid = interact_id,
aaa_idea = label)
table(.ggpdf$aaa_idea, useNA = "ifany") %>%
kableExtra::kable(col.names=c('AAA idea', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| AAA idea | N |
|---|---|
| Very good idea | 225 |
| Somewhat good idea | 26 |
| Somewhat bad idea | 3 |
| Very bad idea | 2 |
| I don’t know | 4 |
ggplot(.ggpdf) +
geom_bar(aes(aaa_idea, y=after_stat(count/sum(count)), fill=aaa_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("")
3.6 Will you be likely to cycle more in the future once the All Ages and Abilities (AAA) Network is built?
aaa_bike_more <- fromJSON('[
{
"label": "Yes",
"value": 1
},
{
"label": "No",
"value": 2
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(aaa_bike_more, by=c("aaa_bike_more"="value")) %>%
transmute(pid = interact_id,
aaa_bike_more = label)
table(.ggpdf$aaa_bike_more, useNA = "ifany") %>%
kableExtra::kable(col.names=c('AAA familiarity', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| AAA familiarity | N |
|---|---|
| Yes | 203 |
| No | 57 |
ggplot(.ggpdf) +
geom_bar(aes(aaa_bike_more, y=after_stat(count/sum(count)), fill=aaa_bike_more), 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("")
4 Impacts
4.1 Physical activity
Minutes of total medium-vigorous physical activity per day, including work, travel, leisure. Computed from modpa and vigpa variables from health survey:
4.1.1 Global
.ggpdf <- vic_data %>%
transmute(interact_id = interact_id,
mvpa = (leisure_modpa * leisure_modpa_freq + leisure_vigpa * leisure_vigpa_freq + work_vigpa * work_vigpa_freq)/7)
# Link back MVPA to main dataset
vic_data <- vic_data %>%
left_join(.ggpdf, by="interact_id")
summary(.ggpdf$mvpa) %>%
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 |
|---|---|---|---|---|---|
| 0 | 12.9 | 34.3 | 47.1 | 60.5 | 265.7 |
fillCount = length(unique(.ggpdf$mvpa))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(.ggpdf, mvpa >=0)) +
geom_histogram(aes(mvpa, y=after_stat(count/sum(count)), fill=factor(mvpa)), show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
xlab("average minutes of MVPA per day in the last 7 days")+
scale_y_continuous(labels = percent) + ylab("")
4.1.2 By frequency of use
fillCount = length(unique(.ggpdf$mvpa))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(filter(vic_data, mvpa >=0)) +
geom_histogram(aes(mvpa, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(mvpa)), binwidth=30, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol=3) +
xlab("average minutes of MVPA per day, in the last 7 days") +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.2 Health
Using sf1 variable: In general, would you say your health is…
4.2.1 Global
sf1 <- fromJSON('[
{
"label": "Excellent",
"value": 1
},
{
"label": "Very good",
"value": 2
},
{
"label": "Good",
"value": 3
},
{
"label": "Fair",
"value": 4
},
{
"label": "Poor",
"value": 5
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(sf1, by=c("sf1"="value")) %>%
transmute(pid = interact_id,
sf1 = label)
table(.ggpdf$sf1, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Health status', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| Health status | N |
|---|---|
| Excellent | 56 |
| Very good | 129 |
| Good | 63 |
| Fair | 10 |
| Poor | 2 |
ggplot(.ggpdf) +
geom_bar(aes(sf1, y=after_stat(count/sum(count)), fill=sf1), show.legend = FALSE) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey")+
scale_y_continuous(labels = percent) + ylab("")
4.2.2 By frequency of use
.ggpdf <- vic_data %>%
left_join(sf1, by=c("sf1"="value")) %>%
transmute(pid = interact_id,
intervention_freq_use_class = intervention_freq_use_class,
sf1 = label)
rbind(table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[1]), sf1)),
table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[2]), sf1)),
table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[3]), sf1))) %>%
t() %>%
kableExtra::kable(col.names = bike_freq) %>%
kableExtra::kable_styling("hover", full_width = F)| less than once a week | 1-3 times a week | 4 or more times a week | |
|---|---|---|---|
| Excellent | 5 | 21 | 30 |
| Very good | 22 | 37 | 70 |
| Good | 13 | 22 | 28 |
| Fair | 1 | 6 | 3 |
| Poor | 1 | 1 | 0 |
ggplot(.ggpdf) +
geom_bar(aes(sf1, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=sf1), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol=3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.3 Subjective happiness
4.3.1 Global
vic_data <- vic_data %>%
mutate(gwb = rowMeans(select(., gwb_a:gwb_d), na.rm = T))
.ggpdf <- vic_data %>%
transmute(pid = interact_id,
gwb = gwb,
gwb_int = as.integer(round(gwb)))
summary(.ggpdf$gwb) %>%
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 |
|---|---|---|---|---|---|
| 1.5 | 4.2 | 4.5 | 4.6 | 5 | 7 |
fillCount = length(unique(.ggpdf$gwb_int))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf) +
geom_histogram(aes(gwb, y=after_stat(count/sum(count)), fill=factor(gwb_int)), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
4.3.2 By frequency of use
.ggpdf <- vic_data %>%
transmute(pid = interact_id,
intervention_freq_use_class = intervention_freq_use_class,
gwb = gwb,
gwb_int = as.integer(round(gwb)))
fillCount = length(unique(.ggpdf$gwb_int))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf) +
geom_histogram(aes(gwb, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(gwb_int)), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol=3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.4 Personal wellbeing
Overall life satisfaction, from 0 (completely dissatisfied) to 10 (completely satisfied). Computed from Personal Wellbeing Index (PWI) Scale, excluding the general life satisfaction (pwb_a) and spirituality items (pwb_i).
4.4.1 Global
vic_data <- vic_data %>%
mutate(pwb = rowMeans(select(., pwb_vic_b:pwb_vic_h), na.rm = T)) # excluding pwb_a
.ggpdf <- vic_data %>%
transmute(pid = interact_id,
pwb = pwb,
pwb_int = as.integer(round(pwb)))
summary(.ggpdf$pwb) %>%
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 |
|---|---|---|---|---|---|
| 1 | 2.1 | 2.7 | 3.2 | 3.7 | 8 |
fillCount = length(unique(.ggpdf$pwb_int))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf) +
geom_histogram(aes(pwb, y=after_stat(count/sum(count)), fill=factor(pwb_int)), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
4.4.2 By frequency of use
.ggpdf <- vic_data %>%
transmute(pid = interact_id,
intervention_freq_use_class = intervention_freq_use_class,
pwb = pwb,
pwb_int = as.integer(round(pwb)))
fillCount = length(unique(.ggpdf$pwb_int))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(.ggpdf) +
geom_histogram(aes(pwb, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(pwb_int)), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol=3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.5 Number of close friends
NB Only for new participants
4.5.1 Global
summary(vic_data$confide) %>%
as.list() %>%
data.frame() %>%
knitr::kable(digits = 1, col.names = c("Min", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max", "NA.s")) %>%
kableExtra::kable_styling("hover", full_width = F)| Min | 1st Qu. | Median | Mean | 3rd Qu. | Max | NA.s |
|---|---|---|---|---|---|---|
| 0 | 4 | 5 | 6.6 | 10 | 20 | 165 |
fillCount = length(unique(vic_data$confide))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_data) +
geom_histogram(aes(confide, y=after_stat(count/sum(count)), fill=factor(confide)), binwidth=2, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
4.5.2 By frequency of use
fillCount = length(unique(vic_data$confide))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_data) +
geom_histogram(aes(confide, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(confide)), binwidth=5, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol=3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.6 Sense of belonging
4.6.1 Global
belonging <- fromJSON('[
{
"label": "Very strong",
"value": 1
},
{
"label": "Somewhat strong",
"value": 2
},
{
"label": "Somewhat weak",
"value": 3
},
{
"label": "Very weak",
"value": 4
},
{
"label": "I don’t know",
"value": 77
}
]') %>%
mutate(label = factor(label, levels = label))
.ggpdf <- vic_data %>%
left_join(sf1, by=c("belonging"="value")) %>%
transmute(pid = interact_id,
belonging = label)
table(.ggpdf$belonging, useNA = "ifany") %>%
kableExtra::kable(col.names=c('Sense of belonging', 'N')) %>%
kableExtra::kable_styling("hover", full_width = F)| Sense of belonging | N |
|---|---|
| Excellent | 28 |
| Very good | 126 |
| Good | 73 |
| Fair | 24 |
| Poor | 0 |
| NA | 9 |
ggplot(.ggpdf) +
geom_bar(aes(belonging, y=after_stat(count/sum(count)), fill=belonging), 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("")
4.6.2 By frequency of use
.ggpdf <- vic_data %>%
left_join(belonging, by=c("belonging"="value")) %>%
transmute(pid = interact_id,
intervention_freq_use_class = intervention_freq_use_class,
belonging = label) %>%
filter(!is.na(belonging))
rbind(table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[1]), belonging)),
table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[2]), belonging)),
table(pull(filter(.ggpdf, intervention_freq_use_class == bike_freq[3]), belonging))) %>%
t() %>%
kableExtra::kable(col.names = bike_freq) %>%
kableExtra::kable_styling("hover", full_width = F)| less than once a week | 1-3 times a week | 4 or more times a week | |
|---|---|---|---|
| Very strong | 4 | 10 | 14 |
| Somewhat strong | 18 | 38 | 70 |
| Somewhat weak | 11 | 31 | 31 |
| Very weak | 7 | 6 | 11 |
| I don’t know | 2 | 2 | 4 |
ggplot(.ggpdf) +
geom_bar(aes(belonging, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=belonging), show.legend = FALSE) +
theme_light() +
theme(axis.text.x=element_text(angle=30,hjust=1)) +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol = 3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.7 Loneliness
Derived from 3 items:
- How often do you feel left out;
- lack companionship;
- feel isolated.
Responses are rated as either 1 (hardly ever), 2 (some of the time), or 3 (often), and summed to a total score from 3 to 9. Higher scores indicate greater loneliness.
4.7.1 Global
vic_data <- vic_data %>%
mutate(loneliness = loneliness_a + loneliness_b + loneliness_c)
summary(vic_data$loneliness) %>%
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 |
|---|---|---|---|---|---|
| 3 | 3 | 5 | 5 | 6 | 9 |
ggplot(vic_data) +
geom_bar(aes(factor(loneliness), y=after_stat(count/sum(count)), fill=factor(loneliness)), show.legend = F) +
theme_light() +
labs(x = "loneliness") +
scale_fill_brewer(palette="GnBu", na.value = "grey", ) +
scale_y_continuous(labels = percent) + ylab("")
4.7.2 By frequency of use
ggplot(vic_data) +
geom_bar(aes(factor(loneliness), y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(loneliness)), show.legend = F) +
theme_light() +
labs(x = "loneliness") +
scale_fill_brewer(palette="GnBu", na.value = "grey", ) +
facet_wrap(vars(intervention_freq_use_class), ncol = 3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.9 Neighbouring (informal)
Frequency of informal social interactions among neighbours (saying hello or having chat) per week, on a scale of 0 (never) to 7 (almost daily).
4.9.1 Global
vic_data <- vic_data %>%
mutate(spat_talking_nghb = (coalesce(spat_a, 0) + coalesce(spat_b, 0)) / 2 / 52)
summary(vic_data$spat_talking_nghb) %>%
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 |
|---|---|---|---|---|---|
| 0 | 1.5 | 3 | 3.2 | 5 | 7 |
fillCount = length(unique(as.integer(round(vic_data$spat_talking_nghb))))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_data) +
geom_histogram(aes(spat_talking_nghb, y=after_stat(count/sum(count)), fill=factor(as.integer(round(spat_talking_nghb)))), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
4.9.2 By frequency of use
ggplot(vic_data) +
geom_histogram(aes(spat_talking_nghb, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(as.integer(round(spat_talking_nghb)))), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol = 3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.10 Neighbouring (formal)
Frequency of formal social interactions among neighbours (visiting or going somewhere with neighbour, giving or receiving help from neighbour) per week, on a scale of 0 (never) to 7 (almost daily).
4.10.1 Global
vic_data <- vic_data %>%
mutate(spat_interact_nghb = (coalesce(spat_c, 0) + coalesce(spat_d, 0) + coalesce(spat_e, 0)) / 3 /
52)
summary(vic_data$spat_interact_nghb) %>%
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 |
|---|---|---|---|---|---|
| 0 | 0 | 0.2 | 0.4 | 0.7 | 5.3 |
fillCount = length(unique(as.integer(round(vic_data$spat_interact_nghb))))
getPalette = colorRampPalette(RColorBrewer::brewer.pal(9, "GnBu"))
ggplot(vic_data) +
geom_histogram(aes(spat_interact_nghb, y=after_stat(count/sum(count)), fill=factor(as.integer(round(spat_interact_nghb)))), binwidth = 1, show.legend = F) +
theme_light() +
scale_fill_manual(values = getPalette(fillCount), na.value = "grey") +
scale_y_continuous(labels = percent) + ylab("")
4.10.2 By frequency of use
ggplot(vic_data) +
geom_histogram(aes(spat_interact_nghb, y = after_stat(count/tapply(count, PANEL, sum)[PANEL]), fill=factor(as.integer(round(spat_interact_nghb)))), binwidth=1, show.legend = F) +
theme_light() +
scale_fill_brewer(palette="GnBu", na.value = "grey") +
facet_wrap(vars(intervention_freq_use_class), ncol = 3) +
scale_y_continuous(labels = percent) + ylab("percent within each frequency group")
4.8 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.8.1 Global
4.8.2 By frequency of use