Skip to content

Instantly share code, notes, and snippets.

@goldingn
goldingn / gam_synthetic_contacts.R
Last active September 6, 2021 03:25
building synthetic contact matrices with generalised additive models
# 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
goldingn / what_is_my_name.R
Created November 8, 2019 04:21
playing with letting R objects know their own names
# 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
goldingn / gradient_box_plot.R
Created February 23, 2019 05:15
a box-esque plot with a greyscale gradient showing the density of data
# 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
goldingn / required_data nodes.R
Created September 25, 2018 09:16
recursive function to find all the data nodes on which an operation node depends (up until some stopping nodes) - not required, but stashed here in case some of the ideas are
# 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
goldingn / multiple_progress.R
Last active May 21, 2018 00:50
multiple progress bars on a single line, to be combined with parallel_progress.R
# 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
goldingn / fft_gp_prototype.R
Last active September 13, 2018 03:16
a prototype interface to defining Gaussian processes on a computational grid efficiently with greta, using the Fast Fourier Transform
# 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
goldingn / greta_marginalise_poisson_rv.R
Last active April 27, 2018 07:20
prototype of helper functions for marginalising a Poisson random variable in a greta model
# 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
goldingn / parallel_progress.R
Created April 14, 2018 00:50
prototype of parallel progress reporting (for processes on the same file system)
# 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
goldingn / greta_ode_prototype.R
Last active October 2, 2018 12:01
A prototype and demonstration of solving ODEs with greta
# 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
goldingn / tensorflow_hmc_hack.R
Last active February 20, 2018 05:37
hack greta v0.2.4 to use tensorflow HMC
# 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)