Created
February 4, 2020 22:00
-
-
Save sbfnk/8daf72332a6942c37b869707d17890ce to your computer and use it in GitHub Desktop.
China contacts
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library('socialmixr') | |
library('tidyverse') | |
## get China survey | |
s <- get_survey("https://doi.org/10.5281/zenodo.3366396") | |
## contact matrix | |
contact_matrix(s, age.limits = seq(0, 15, 5)) | |
## $matrix | |
## contact.age.group | |
## age.group [0,5) [5,10) [10,15) 15+ | |
## [0,5) 0.27692308 0.04615385 0.06153846 4.430769 | |
## [5,10) 0.17391304 1.32608696 0.21739130 4.043478 | |
## [10,15) 0.00000000 0.03125000 2.62500000 3.734375 | |
## 15+ 0.08659218 0.11592179 0.11731844 6.638268 | |
## == Let's check the counts | |
contact_matrix(s, age.limits = seq(0, 15, 5), counts = TRUE) | |
## $matrix | |
## contact.age.group | |
## age.group [0,5) [5,10) [10,15) 15+ | |
## [0,5) 18 3 4 288 | |
## [5,10) 8 61 10 186 | |
## [10,15) 0 2 168 239 | |
## 15+ 62 83 84 4753 | |
## $participants | |
## age.group participants proportion | |
## 1: [0,5) 65 0.07295174 | |
## 2: [5,10) 46 0.05162738 | |
## 3: [10,15) 64 0.07182941 | |
## 4: 15+ 716 0.80359147 | |
## == In the 10-14 age group: 168/64=2.625 | |
## == Let's check in the raw data | |
s$participants %>% | |
mutate(age_group = | |
limits_to_agegroups(reduce_agegroups(part_age, seq(0, 15, 5)))) %>% | |
group_by(age_group) %>% | |
summarise(n()) | |
## # A tibble: 4 x 2 | |
## age_group `n()` | |
## <fct> <int> | |
## 1 0-4 66 | |
## 2 5-9 51 | |
## 3 10-14 69 | |
## 4 15+ 779 | |
ten_to_fourteen_id <- s$participants %>% | |
filter(part_age >= 10 & part_age < 15) %>% | |
.$part_id | |
s$contacts %>% | |
filter(part_id %in% ten_to_fourteen_id) %>% | |
mutate(age_group = | |
limits_to_agegroups( | |
reduce_agegroups(cnt_age_exact, seq(0, 15, 5)))) %>% | |
group_by(age_group) %>% | |
summarise(n()) | |
## # A tibble: 4 x 2 | |
## age_group `n()` | |
## <fct> <int> | |
## 1 5-9 6 | |
## 2 10-14 184 | |
## 3 15+ 261 | |
## 4 NA 29 | |
## == Numbers are slightly smaller, probably because participants with contacts | |
## with missing age are being removed | |
contact_matrix(s, age.limits = seq(0, 15, 5), counts = TRUE, | |
missing.contact.age = "keep") | |
## == This matches the numbers returned by contact_matrix | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment