goldingn

# build synthetic age-structured contact matrices with GAMs

library(tidyverse)
library(mgcv)
library(patchwork)
library(socialmixr)

# return the polymod-average population age distribution in 5y
# increments (weight country population distributions by number of participants)
# note that we don't want to weight by survey age distributions for this, since

goldingn

fuzzyMatch <- function (a, b) {
  
  # no-frills fuzzy matching of strings between character vectors
  # `a` and `b` (essentially a wrapper around a stringdist function)
  # The function returns a two column matrix giving the matching index
  # (as `match` would return) and a matrix giving the distances, so you
  # can check how well it did on the hardest words.
  # Warning - this uses all of your cores.
  
  # load the stringdist package

goldingn

# styles for plotting
library(default)

.old_par <- list()
.current_style <- list()
.shims <- new.env()

remove_shims <- function () {
  if ("shims" %in% search())
    detach ("shims")

goldingn

# how to make R objects know their own names?

# this works with commands run in the global environment, but not inside functions
this_call <- function() {
  file1 <- tempfile("Rrawhist")
  savehistory(file1)
  rawhist <- readLines(file1)
  rawhist[length(rawhist)]
}

goldingn

# box-ish plot with colour gradient giving smoothed densities

# some fake values
x <- c(rnorm(150, -0.5,  1.3),
       rnorm(30, -1,  0.8),
       rnorm(20, 0.1,  0.6))

# how smooth the gradient is
n_levels <- 100

goldingn

# prototype ODE solver function for greta

# user-facing function to export:
# derivative must be a function with the first two arguments being 'y' and 't',
# and subsequent named arguments representing (temporally static) model
# parameters
# y0 must be a greta array representing the shape of y at time 0
# times must be a column vector of times at which to evaluate y
# dots must be named greta arrays for the additional (fixed) parameters
ode_solve <- function (derivative, y0, times, ...) {

goldingn

# recursively find all the data nodes that this one depends on, stopping the
# search at any nodes that are data or whose unique names are in stop_at
required_data_nodes <- function (node, stop_at = c(), data_nodes = list()) {

  name <- node$unique_name

  if (!name %in% stop_at) {

    # if a data node, record and stop this search branch (data has no children)

goldingn

# FFT approximation to a GP on a regular grid (defined by a raster)

# information representing a grid of points, defined by the x and y coordinates
# fft_grid <- function (x_coord, y_coord) {
#   
#   # pre calculate grid info
#   dx <- x_coord[2] - x_coord[1]
#   dy <- y_coord[2] - y_coord[1]
#   m <- length(x_coord)
#   n <- length(y_coord)

goldingn

# make a nice viridis GMRF tesselation for Richard
rm(list = ls())
set.seed(1)

library(INLA)
library(raster)
library(viridis)
library(fields)

# grid sizes for sampling the GRF and for the final image

goldingn

# plotting multiple progress bars on the same line, as a precursor to running
# the progress bars in parallel

library (progress)
library (future)
library (R6)

new_connection <- function () {
  f <- tempfile()
  file.create(f)