some initial notes on predicting to specific ages

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(

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(

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

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
+```
+