diff --git a/R/aggregate_predicted_contacts.R b/R/aggregate_predicted_contacts.R index 532b3ce2..ada4dafe 100644 --- a/R/aggregate_predicted_contacts.R +++ b/R/aggregate_predicted_contacts.R @@ -60,6 +60,7 @@ aggregate_predicted_contacts <- function(predicted_contacts_1y, dplyr::filter( !is.na(age_group_to) ) %>% + # TODO: This is where we need to fix how these new differences are reconciled # sum the number of contacts to the 'to' age groups, for each integer # participant age dplyr::group_by( diff --git a/R/predict_contacts.R b/R/predict_contacts.R index 6898b716..d28fe489 100644 --- a/R/predict_contacts.R +++ b/R/predict_contacts.R @@ -84,13 +84,15 @@ predict_contacts <- function(model, age_min_integration <- min(ages[valid]) age_max_integration <- max(ages[valid]) + # predicted contacts... - no longer at 1 year increments pred_1y <- predict_contacts_1y( model = model, population = population, # these two arguments could be changed by just taking in the age vector # and then doing that step above internally age_min = age_min_integration, - age_max = age_max_integration + age_max = age_max_integration, + age_breaks = age_breaks ) pred_groups <- aggregate_predicted_contacts( diff --git a/R/predict_contacts_1y.R b/R/predict_contacts_1y.R index e48c0d79..aaa40e28 100644 --- a/R/predict_contacts_1y.R +++ b/R/predict_contacts_1y.R @@ -42,15 +42,29 @@ #' age_max = 2 #' ) #' @export -predict_contacts_1y <- function(model, population, age_min = 0, age_max = 100) { - +predict_contacts_1y <- function(model, + population, + age_min = 0, + age_max = 100, + age_breaks = NULL) { all_ages <- age_min:age_max # predict contacts to all integer years, adjusting for the population in a given place - tidyr::expand_grid( - age_from = all_ages, - age_to = all_ages, - ) %>% + + + if (!is.null(age_breaks)){ + df_expanded <- tidyr::expand_grid( + age_from = age_breaks, + age_to = age_breaks + ) + } else { + df_expanded <- tidyr::expand_grid( + age_from = all_ages, + age_to = all_ages, + ) + } + + df_expanded %>% # add on prediction features, setting the population to predict to add_modelling_features( population = population diff --git a/vignettes/predicting-to-different-ages.Rmd b/vignettes/predicting-to-different-ages.Rmd new file mode 100644 index 00000000..f0c0b479 --- /dev/null +++ b/vignettes/predicting-to-different-ages.Rmd @@ -0,0 +1,67 @@ +--- +title: "predicting-to-different-ages" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{predicting-to-different-ages} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(conmat) +``` + +For this example we want to explore creating contact matrices for people of different ages. By default conmat predicts to 5 year ages. So taking some example data from Perth, we could extrapolate the following contact rates. + +```{r} +perth_city <- abs_age_lga("Perth (C)") + +perth_city + +synthetic_settings_5y_perth <- extrapolate_polymod( + population = perth_city +) + +synthetic_settings_5y_perth$home +``` + +But what if instead you wanted to predict to different ages? Say for example if you were just interested in 0-5 year olds, but at a 6 monthly interval? + +```{r} +six_monthly <- c( + seq(from = 0, + to = 5, + by = 1/2) +) + +six_monthly +``` + +```{r} +synthetic_settings_perth_6m <- extrapolate_polymod( + population = perth_city, + age_breaks = six_monthly +) +``` + +```{r} +synthetic_settings_perth_6m$home +``` + +```{r} +raw_mat <- predict_setting_contacts( + population = perth_city, + contact_model = polymod_setting_models, + age_breaks = six_monthly +) + +raw_mat +``` +