goldingn

to_free <- function (node, data) {
  lower <- node$lower
  upper <- node$upper
  fun <- switch(node$constraint,
                none = function (x) x,
                high = function (x) log(x - lower),
                low = function (x) log(upper - x),
                both = function(x) qlogis((y - lower) / (upper - lower)))
  fun(data)
}

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

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

goldingn

# lookup table of error messages (coud be read in from a file in the package)
lookup <- cbind(from = "there is no package called ‘pineapples’",
                to = "no pineapples here!")

# swap over the message if there's a better one in the lookup
swap_message <- function (message) {
  idx <- match(message, lookup[, "from"])
  if (length(idx == 1) && !is.na(idx))
    message <- lookup[idx, "to"]
  message

goldingn

# demonstrating how bad an esitmate of model goodness fo fit pseudo R2 is with small integer data

# fake poisson glm
set.seed(1)
n <- 1000
x <- rnorm(n)

# the lower the rates, the worse the pseudo-r squared says the model is
intercept <- -2
# try twiddling the intercept to change the average rate for the Poisson

goldingn

# quick & dirty caching of R objects - run the expression in b iff an RDS file
# for the object doesn't exist, otherwise load the object
`%<--%` <- function (a, b) {
  name <- deparse(substitute(a))
  file <- paste0(name, ".rds")
  if (file.exists(file)) {
    obj <- readRDS(file)
  } else {
    obj <- b
    saveRDS(obj, file)

goldingn

# install the experimental parallel branch
# remotes::install_github("zoonproject/zoon@parallel")
library (zoon)

# example workflow for 4 independent models that may take a while to run
run_wf <- function () {
  workflow(occurrence = UKAnophelesPlumbeus,
           covariate = UKBioclim,
           process = Replicate(Background(n = 1000), 4),
           model = GBM(max.trees = 10000),

goldingn

devtools::install_github("RhoInc/CRANsearcher")
pkg <- CRANsearcher:::getPackages()

strings <- paste(pkg[, "Title"], pkg[, "Description"])

idx <- grep(" ecolog*| evolut*", strings, ignore.case = TRUE)

length(idx)
# [1] 236

goldingn

# fake data
n <- 1000
m <- 50
x <- matrix(rnorm(n * m), n, m)
b <- rnorm(m, 0, 2) * rbinom(m, 1, 0.2)
eta <- x %*% b
y <- rnorm(n, eta, 0.3)

library (greta)