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

# 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

# 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

# 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)

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

# marginalise over a Poisson random variable in a greta model

# likelihood function must be a function taking a single value of N (drawn from
# N ~ Poisson(lambda)), and returning a distribution. Lambda is a (possibly
# variable) scalar greta array for the rate of the poisson distribution. max_n
# is a scalar positive integer giving the maximum value of N to consider when
# marginalising the Poisson distribution
marginal_poisson <- function (likelihood_function, lambda, max_n) {
  n_seq <- seq_len(max_n)
  wt <- poisson_weights(n_seq, lambda)

goldingn

# progress information in parallel processes (that use the same filesystem)

# the master function sets up a tempfile for each process, spawns processes, and
# passes the corresponding tempfile location to each; each process dumps
# progress information into its tempfile; the master function polls those files
# for the progress information and returns it to the screen; the previous line
# is overwritten, as for progress bars
library (future)

# an environment to stash file info in, to hack around scoping issues. A package

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

# get greta working with bayesflow's HMC implementation & working via
# tensorflow's run syntax

build_function <- function (dag) {

  # temporarily pass float type info to options, so it can be accessed by
  # nodes on definition, without clunky explicit passing
  old_float_type <- options()$greta_tf_float
  on.exit(options(greta_tf_float = old_float_type))
  options(greta_tf_float = dag$tf_float)