From e47e2ffedec717daddfba4aa2dbfe24b5b5566ca Mon Sep 17 00:00:00 2001
From: njtierney <nicholas.tierney@gmail.com>
Date: Tue, 6 Dec 2022 12:03:17 +0800
Subject: [PATCH 1/2] some initial notes on predicting to specific ages

---
 R/aggregate_predicted_contacts.R |  1 +
 R/predict_contacts.R             |  4 +++-
 R/predict_contacts_1y.R          | 26 ++++++++++++++++++++------
 3 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/R/aggregate_predicted_contacts.R b/R/aggregate_predicted_contacts.R
index 532b3ce..ada4daf 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 6898b71..d28fe48 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 e48c0d7..aaa40e2 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

From 22b97efbd716450ecbb399bc1e39d426992acd44 Mon Sep 17 00:00:00 2001
From: njtierney <nicholas.tierney@gmail.com>
Date: Wed, 14 Dec 2022 16:29:19 +1000
Subject: [PATCH 2/2] draft on prediction to monthly amounts

---
 vignettes/predicting-to-different-ages.Rmd | 67 ++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100644 vignettes/predicting-to-different-ages.Rmd

diff --git a/vignettes/predicting-to-different-ages.Rmd b/vignettes/predicting-to-different-ages.Rmd
new file mode 100644
index 0000000..f0c0b47
--- /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
+```
+