diff --git a/DESCRIPTION b/DESCRIPTION index 4975d5b1..12576ddc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: monty Title: Monte Carlo Models -Version: 0.2.20 +Version: 0.2.21 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), diff --git a/R/domain.R b/R/domain.R index 6c963886..a33a7477 100644 --- a/R/domain.R +++ b/R/domain.R @@ -54,7 +54,7 @@ monty_domain_expand <- function(domain, packer) { arg = "domain") } - nms_full <- packer$parameters + nms_full <- packer$names() nms_map <- packer$unpack(nms_full) nms_logical <- names(nms_map) @@ -76,5 +76,5 @@ monty_domain_expand <- function(domain, packer) { domain[!i, , drop = FALSE]) } - domain[order(match(rownames(domain), packer$parameters)), , drop = FALSE] + domain[order(match(rownames(domain), packer$names())), , drop = FALSE] } diff --git a/R/dsl-generate.R b/R/dsl-generate.R index 01ac83d7..4b8942b6 100644 --- a/R/dsl-generate.R +++ b/R/dsl-generate.R @@ -56,7 +56,7 @@ dsl_generate_direct_sample <- function(dat, env, meta) { exprs <- lapply(dat$exprs, dsl_generate_sample_expr, meta) body <- c(call("<-", meta[["pars"]], quote(list())), exprs, - bquote(unlist(.(meta[["pars"]])[packer$parameters], FALSE, FALSE))) + bquote(unlist(.(meta[["pars"]])[packer$names()], FALSE, FALSE))) as_function(alist(rng = ), body, env) } diff --git a/R/model-function.R b/R/model-function.R index af52af7e..1e2cc5c1 100644 --- a/R/model-function.R +++ b/R/model-function.R @@ -63,7 +63,7 @@ monty_model_function <- function(density, packer = NULL, fixed = NULL) { } monty_model( - list(parameters = packer$parameters, + list(parameters = packer$names(), density = function(x) { rlang::inject(density(!!!packer$unpack(x))) })) diff --git a/R/packer.R b/R/packer.R index daa7ebe8..bc84754b 100644 --- a/R/packer.R +++ b/R/packer.R @@ -1,9 +1,11 @@ -##' Build a parameter packer, which can be used in models to translate -##' between an unstructured vector of numbers (the vector being -##' updated by an MCMC for example) to a structured list of named -##' values, which is easier to program against. We refer to the -##' process of taking a named list of scalars, vectors and arrays and -##' converting into a single vector "packing" and the inverse +##' Build a packer, which can be used to translate between an +##' unstructured vector of numbers (the vector being updated by an +##' MCMC for example) and a structured list of named values, which is +##' easier to program against. This is useful for the bridge between +##' model parameters and a models's implementation, but it is also +##' useful for the state vector in a state-space model. We refer to +##' the process of taking a named list of scalars, vectors and arrays +##' and converting into a single vector "packing" and the inverse ##' "unpacking". ##' ##' There are several places where it is most convenient to work in an @@ -145,57 +147,64 @@ ##' vector vs packing an array where all dimensions are 1. See the ##' examples, and please let us know if the behaviour needs changing. ##' -##' @title Build a parameter packer +##' @title Build a packer ##' -##' @param scalar Names of scalar parameters. This is similar for -##' listing elements in `array` with values of 1, though elements in +##' @param scalar Names of scalars. This is similar for listing +##' elements in `array` with values of 1, though elements in ##' `scalar` will be placed ahead of those listed in `array` within ##' the final parameter vector, and elements in `array` will have ##' generated names that include square brackets. ##' -##' @param array A list, where names correspond to the names of array -##' parameters and values correspond to the lengths of parameters. -##' Multiple dimensions are allowed (so if you provide an element -##' with two entries these represent dimensions of a matrix). -##' Zero-length integer vectors or `NULL` values are counted as -##' scalars, which allows you to put scalars at positions other than -##' the front of the packing vector. In future, you may be able to -##' use *strings* as values for the lengths, in which case these -##' will be looked for within `fixed`. -##' -##' @param fixed A named list of fixed parameters; these will be added -##' into the final list directly. These typically represent -##' additional pieces of data that your model needs to run, but -##' which you are not performing inference on. +##' @param array A list, where names correspond to the names of arrays +##' and values correspond to their lengths. Multiple dimensions are +##' allowed (so if you provide an element with two entries these +##' represent dimensions of a matrix). Zero-length integer vectors +##' or `NULL` values are counted as scalars, which allows you to put +##' scalars at positions other than the front of the packing +##' vector. In future, you may be able to use *strings* as values +##' for the lengths, in which case these will be looked for within +##' `fixed`. +##' +##' @param fixed A named list of fixed data to be inserted into the +##' final unpacked list; these will be added into the final list +##' directly. In the parameter packer context, these typically +##' represent additional pieces of data that your model needs to +##' run, but which you are not performing inference on. ##' ##' @param process An arbitrary R function that will be passed the -##' final assembled parameter list; it may create any *additional* -##' entries, which will be concatenated onto the original list. If -##' you use this you should take care not to return any values with -##' the same names as entries listed in `scalar`, `array` or -##' `fixed`, as this is an error (this is so that `pack()` is -##' not broken). We will likely play around with this process in -##' future in order to get automatic differentiation to work. -##' -##' @return An object of class `monty_packer`, which has three -##' elements: -##' -##' * `parameters`: a character vector of computed parameter names; -##' these are the names that your statistical model will use. +##' final assembled list; it may create any *additional* entries, +##' which will be concatenated onto the original list. If you use +##' this you should take care not to return any values with the same +##' names as entries listed in `scalar`, `array` or `fixed`, as this +##' is an error (this is so that `pack()` is not broken). We will +##' likely play around with this process in future in order to get +##' automatic differentiation to work. +##' +##' @return An object of class `monty_packer`, which has elements: +##' +##' * `names`: a function that returns a character vector of computed +##' names; in the parameter packer context these are the names that +##' your statistical model will use. +##' ##' * `unpack`: a function that can unpack an unstructured vector ##' (say, from your statistical model parameters) into a structured ##' list (say, for your generative model) -##' * `pack`: a function that can pack your structured list of -##' parameters back into a numeric vector suitable for the +##' +##' * `pack`: a function that can pack your structured list of data +##' back into a numeric vector, for example suitable for a ##' statistical model. This ignores values created by a -##' `preprocess` function. +##' `preprocess` function and present in `fixed`. +##' ##' * `index`: a function which produces a named list where each -##' element has the name of a value in `parameters` and each value -##' has the indices within an unstructured vector where these values -##' can be found. -##' * `subset`: an experimental interface which can be used to subset a -##' packer to a packer for a subset of contents. Documentation will -##' be provided once the interface settles. +##' element has the name of a value in `scalar` or `array` and each +##' value has the indices within an unstructured vector where these +##' values can be found, in the shape of the data that would be +##' unpacked. This is of limited most use to most people. +##' +##' * `subset`: an experimental interface which can be used to subset +##' a packer to a packer for a subset of contents. Documentation +##' will be provided once the interface settles, but this is for +##' advanced use only! ##' ##' @export ##' @@ -260,7 +269,7 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, process = NULL) { call <- environment() - parameters <- character(0) + nms <- character(0) idx <- list() shape <- list() @@ -279,7 +288,7 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, } shape[scalar] <- rep(list(integer()), length(scalar)) idx[scalar] <- as.list(seq_along(scalar)) - parameters <- c(parameters, scalar) + nms <- c(nms, scalar) } len <- length(scalar) # start arrays after scalars @@ -287,7 +296,7 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, assert_named(array, unique = TRUE, call = call) for (nm in names(array)) { tmp <- prepare_pack_array(nm, array[[nm]], call) - parameters <- c(parameters, tmp$names) + nms <- c(nms, tmp$names) shape[[nm]] <- tmp$shape idx[[nm]] <- seq_len(tmp$n) + len len <- len + tmp$n @@ -325,9 +334,9 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, unpack <- function(x) { if (is.null(dim(x))) { - unpack_vector(x, parameters, len, idx, shape, fixed, process) + unpack_vector(x, nms, len, idx, shape, fixed, process) } else { - unpack_array(x, parameters, len, idx, shape, fixed, process) + unpack_array(x, nms, len, idx, shape, fixed, process) } } @@ -379,7 +388,7 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, list(index = index, packer = packer) } - ret <- list(parameters = parameters, + ret <- list(names = function() nms, unpack = unpack, pack = pack, index = function() idx, @@ -438,7 +447,7 @@ array_indices <- function(shape) { print.monty_packer <- function(x, ...) { cli::cli_h1("") cli::cli_alert_info( - "Packing {length(x$parameters)} parameter{?s}: {squote(x$parameters)}") + "Packing {length(x$names())} parameter{?s}: {squote(x$names())}") cli::cli_alert_info( "Use '$pack()' to convert from a list to a vector") cli::cli_alert_info( @@ -448,10 +457,10 @@ print.monty_packer <- function(x, ...) { } -unpack_vector <- function(x, parameters, len, idx, shape, fixed, process) { +unpack_vector <- function(x, nms, len, idx, shape, fixed, process) { call <- parent.frame() if (!is.null(names(x))) { - if (!identical(names(x), parameters)) { + if (!identical(names(x), nms)) { ## Here, we could do better I think with this message; we ## might pass thropuigh empty names, and produce some summary ## of different names. Something for later though. @@ -476,7 +485,7 @@ unpack_vector <- function(x, parameters, len, idx, shape, fixed, process) { err <- intersect(names(extra), names(res)) if (length(err) > 0) { cli::cli_abort( - c("'process()' is trying to overwrite entries in parameters", + c("'process()' is trying to overwrite entries in your list", i = paste("The 'process()' function should only create elements", "that are not already present in 'scalar', 'array'", "or 'fixed', as this lets us reverse the transformation", @@ -494,10 +503,10 @@ unpack_vector <- function(x, parameters, len, idx, shape, fixed, process) { } -unpack_array <- function(x, parameters, len, idx, shape, fixed, process) { +unpack_array <- function(x, nms, len, idx, shape, fixed, process) { call <- parent.frame() dn <- dimnames(x) - if (!is.null(dn) && !is.null(dn[[1]]) && !identical(dn[[1]], parameters)) { + if (!is.null(dn) && !is.null(dn[[1]]) && !identical(dn[[1]], nms)) { ## See comment above about reporting on this better cli::cli_abort("Incorrect rownames in input") } diff --git a/man/monty_packer.Rd b/man/monty_packer.Rd index c4ac8cc7..cd192499 100644 --- a/man/monty_packer.Rd +++ b/man/monty_packer.Rd @@ -2,70 +2,75 @@ % Please edit documentation in R/packer.R \name{monty_packer} \alias{monty_packer} -\title{Build a parameter packer} +\title{Build a packer} \usage{ monty_packer(scalar = NULL, array = NULL, fixed = NULL, process = NULL) } \arguments{ -\item{scalar}{Names of scalar parameters. This is similar for -listing elements in \code{array} with values of 1, though elements in +\item{scalar}{Names of scalars. This is similar for listing +elements in \code{array} with values of 1, though elements in \code{scalar} will be placed ahead of those listed in \code{array} within the final parameter vector, and elements in \code{array} will have generated names that include square brackets.} -\item{array}{A list, where names correspond to the names of array -parameters and values correspond to the lengths of parameters. -Multiple dimensions are allowed (so if you provide an element -with two entries these represent dimensions of a matrix). -Zero-length integer vectors or \code{NULL} values are counted as -scalars, which allows you to put scalars at positions other than -the front of the packing vector. In future, you may be able to -use \emph{strings} as values for the lengths, in which case these -will be looked for within \code{fixed}.} - -\item{fixed}{A named list of fixed parameters; these will be added -into the final list directly. These typically represent -additional pieces of data that your model needs to run, but -which you are not performing inference on.} +\item{array}{A list, where names correspond to the names of arrays +and values correspond to their lengths. Multiple dimensions are +allowed (so if you provide an element with two entries these +represent dimensions of a matrix). Zero-length integer vectors +or \code{NULL} values are counted as scalars, which allows you to put +scalars at positions other than the front of the packing +vector. In future, you may be able to use \emph{strings} as values +for the lengths, in which case these will be looked for within +\code{fixed}.} + +\item{fixed}{A named list of fixed data to be inserted into the +final unpacked list; these will be added into the final list +directly. In the parameter packer context, these typically +represent additional pieces of data that your model needs to +run, but which you are not performing inference on.} \item{process}{An arbitrary R function that will be passed the -final assembled parameter list; it may create any \emph{additional} -entries, which will be concatenated onto the original list. If -you use this you should take care not to return any values with -the same names as entries listed in \code{scalar}, \code{array} or -\code{fixed}, as this is an error (this is so that \code{pack()} is -not broken). We will likely play around with this process in -future in order to get automatic differentiation to work.} +final assembled list; it may create any \emph{additional} entries, +which will be concatenated onto the original list. If you use +this you should take care not to return any values with the same +names as entries listed in \code{scalar}, \code{array} or \code{fixed}, as this +is an error (this is so that \code{pack()} is not broken). We will +likely play around with this process in future in order to get +automatic differentiation to work.} } \value{ -An object of class \code{monty_packer}, which has three -elements: +An object of class \code{monty_packer}, which has elements: \itemize{ -\item \code{parameters}: a character vector of computed parameter names; -these are the names that your statistical model will use. +\item \code{names}: a function that returns a character vector of computed +names; in the parameter packer context these are the names that +your statistical model will use. \item \code{unpack}: a function that can unpack an unstructured vector (say, from your statistical model parameters) into a structured list (say, for your generative model) -\item \code{pack}: a function that can pack your structured list of -parameters back into a numeric vector suitable for the +\item \code{pack}: a function that can pack your structured list of data +back into a numeric vector, for example suitable for a statistical model. This ignores values created by a -\code{preprocess} function. +\code{preprocess} function and present in \code{fixed}. \item \code{index}: a function which produces a named list where each -element has the name of a value in \code{parameters} and each value -has the indices within an unstructured vector where these values -can be found. -\item \code{subset}: an experimental interface which can be used to subset a -packer to a packer for a subset of contents. Documentation will -be provided once the interface settles. +element has the name of a value in \code{scalar} or \code{array} and each +value has the indices within an unstructured vector where these +values can be found, in the shape of the data that would be +unpacked. This is of limited most use to most people. +\item \code{subset}: an experimental interface which can be used to subset +a packer to a packer for a subset of contents. Documentation +will be provided once the interface settles, but this is for +advanced use only! } } \description{ -Build a parameter packer, which can be used in models to translate -between an unstructured vector of numbers (the vector being -updated by an MCMC for example) to a structured list of named -values, which is easier to program against. We refer to the -process of taking a named list of scalars, vectors and arrays and -converting into a single vector "packing" and the inverse +Build a packer, which can be used to translate between an +unstructured vector of numbers (the vector being updated by an +MCMC for example) and a structured list of named values, which is +easier to program against. This is useful for the bridge between +model parameters and a models's implementation, but it is also +useful for the state vector in a state-space model. We refer to +the process of taking a named list of scalars, vectors and arrays +and converting into a single vector "packing" and the inverse "unpacking". } \details{ diff --git a/tests/testthat/test-packer.R b/tests/testthat/test-packer.R index 5025b1d6..ec688ac2 100644 --- a/tests/testthat/test-packer.R +++ b/tests/testthat/test-packer.R @@ -6,7 +6,7 @@ test_that("can't create empty packer", { test_that("trivial packer", { xp <- monty_packer("a") - expect_equal(xp$parameters, "a") + expect_equal(xp$names(), "a") expect_equal(xp$unpack(1), list(a = 1)) expect_equal(xp$unpack(c(a = 1)), list(a = 1)) expect_error(xp$unpack(c(b = 1)), @@ -23,7 +23,7 @@ test_that("trivial packer", { test_that("multiple scalar unpacking", { xp <- monty_packer(c("a", "b", "c")) - expect_equal(xp$parameters, c("a", "b", "c")) + expect_equal(xp$names(), c("a", "b", "c")) expect_equal(xp$unpack(1:3), list(a = 1, b = 2, c = 3)) expect_equal(xp$pack(list(a = 1, b = 2, c = 3)), 1:3) expect_equal(xp$index(), list(a = 1, b = 2, c = 3)) @@ -32,7 +32,7 @@ test_that("multiple scalar unpacking", { test_that("can bind data into an unpacked list", { xp <- monty_packer(c("a", "b"), fixed = list(x = 1:5, y = 10)) - expect_equal(xp$parameters, c("a", "b")) + expect_equal(xp$names(), c("a", "b")) expect_equal(xp$unpack(1:2), list(a = 1, b = 2, x = 1:5, y = 10)) expect_equal(xp$pack(list(a = 1, b = 2, x = 1:5, y = 10)), 1:2) expect_equal(xp$pack(list(a = 1, b = 2)), 1:2) @@ -41,14 +41,14 @@ test_that("can bind data into an unpacked list", { test_that("can unpack arrays", { xp <- monty_packer("a", list(b = 3)) - expect_equal(xp$parameters, c("a", "b[1]", "b[2]", "b[3]")) + expect_equal(xp$names(), c("a", "b[1]", "b[2]", "b[3]")) expect_equal(xp$unpack(1:4), list(a = 1, b = 2:4)) }) test_that("can use integer vectors for array inputs", { xp <- monty_packer("a", c(b = 3, c = 4)) - expect_equal(xp$parameters, + expect_equal(xp$names(), c("a", sprintf("b[%d]", 1:3), sprintf("c[%d]", 1:4))) expect_equal(xp$unpack(1:8), list(a = 1, b = 2:4, c = 5:8)) expect_equal(xp$index(), list(a = 1, b = 2:4, c = 5:8)) @@ -65,7 +65,7 @@ test_that("can create packers with higher-level dimensionsality", { xp <- monty_packer( array = list(a = 1, b = 2, c = 2:3, d = 2:4)) expect_equal( - xp$parameters, + xp$names(), c("a[1]", "b[1]", "b[2]", sprintf("c[%d,%d]", 1:2, rep(1:3, each = 2)), sprintf("d[%d,%d,%d]", 1:2, rep(1:3, each = 2), rep(1:4, each = 6)))) @@ -112,7 +112,7 @@ test_that("validate array inputs", { test_that("can pass empty array elements as scalars", { p <- monty_packer(array = list(a = integer(), b = 2)) - expect_equal(p$parameters, c("a", "b[1]", "b[2]")) + expect_equal(p$names(), c("a", "b[1]", "b[2]")) expect_equal(p$unpack(1:3), list(a = 1, b = 2:3)) expect_equal(p$pack(list(a = 1, b = 2:3)), 1:3) }) @@ -120,7 +120,7 @@ test_that("can pass empty array elements as scalars", { test_that("can pass empty array elements as scalars in odd order", { p <- monty_packer(array = list(a = 2, b = NULL)) - expect_equal(p$parameters, c("a[1]", "a[2]", "b")) + expect_equal(p$names(), c("a[1]", "a[2]", "b")) expect_equal(p$unpack(1:3), list(a = 1:2, b = 3)) expect_equal(p$pack(list(a = 1:2, b = 3)), 1:3) }) @@ -138,7 +138,7 @@ test_that("can post-process parameters", { list(d = x$a + x$b + x$c) } xp <- monty_packer(c("a", "b", "c"), process = p) - expect_equal(xp$parameters, c("a", "b", "c")) + expect_equal(xp$names(), c("a", "b", "c")) expect_equal(xp$unpack(1:3), list(a = 1, b = 2, c = 3, d = 6)) expect_equal(xp$pack(xp$unpack(1:3)), 1:3) expect_equal(xp$pack(list(a = 1, b = 2, c = 3)), 1:3) @@ -158,7 +158,7 @@ test_that("require that process is well-behaved", { } xp <- monty_packer(c("a", "b", "c"), process = p) expect_error(xp$unpack(1:3), - "'process()' is trying to overwrite entries in parameters", + "'process()' is trying to overwrite entries in your list", fixed = TRUE) }) @@ -388,7 +388,7 @@ test_that("can subset a packer of scalars", { p <- monty_packer(c("a", "b", "c", "d")) res <- p$subset(c("b", "c")) expect_equal(res$index, 2:3) - expect_equal(res$packer$parameters, c("b", "c")) + expect_equal(res$packer$names(), c("b", "c")) expect_equal(res$packer$unpack(1:2), list(b = 1, c = 2)) }) @@ -399,7 +399,7 @@ test_that("can subset a packer of arrays", { expect_equal(res$index, c(1, 4:12)) cmp <- monty_packer(array = list(a = integer(), c = c(3, 3))) - expect_equal(res$packer$parameters, cmp$parameters) + expect_equal(res$packer$names(), cmp$names()) expect_equal(res$packer$index(), cmp$index()) })