From 7aa5a234c22d04cabaa71f2781be6826b393ff7a Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 24 Sep 2024 18:07:38 +0100 Subject: [PATCH 1/6] Fix bug unpacking scalars that were created as arrays --- R/packer.R | 2 +- R/util.R | 2 +- tests/testthat/test-packer.R | 12 ++++++++++++ 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/R/packer.R b/R/packer.R index 7095c6b1..b538be92 100644 --- a/R/packer.R +++ b/R/packer.R @@ -318,7 +318,7 @@ prepare_pack_array <- function(name, shape, call = NULL) { arg = "array", call = call) } if (length(shape) == 0) { - return(list(names = name, shape = 1, n = 1L)) + return(list(names = name, shape = integer(0), n = 1L)) } if (any(shape <= 0)) { cli::cli_abort( diff --git a/R/util.R b/R/util.R index 804d9f9f..e2dd90ef 100644 --- a/R/util.R +++ b/R/util.R @@ -102,7 +102,7 @@ dim2 <- function(x) { "dim2<-" <- function(x, value) { - if (length(value) != 1) { + if (length(value) > 1) { dim(x) <- value } x diff --git a/tests/testthat/test-packer.R b/tests/testthat/test-packer.R index 13742e95..1c849b40 100644 --- a/tests/testthat/test-packer.R +++ b/tests/testthat/test-packer.R @@ -220,3 +220,15 @@ test_that("can't used process with array unpacking", { p$unpack(matrix(1:6, 2)), "Can't unpack a matrix where the unpacker uses 'process'") }) + + +test_that("Properly unpack scalars stored as zero-length arrays", { + p <- monty_packer(array = list(a = integer(0), b = 1L)) + expect_equal(p$unpack(1:2), list(a = 1, b = 2)) + expect_equal(p$unpack(matrix(1:10, 2, 5)), + list(a = seq(1, 9, by = 2), + b = matrix(seq(2, 10, by = 2), 1, 5))) + expect_equal(p$unpack(array(1:30, c(2, 3, 5))), + list(a = matrix(seq(1, 29, by = 2), c(3, 5)), + b = array(seq(2, 30, by = 2), c(1, 3, 5)))) +}) From 6a918f077bb61f44e8babc7d75e88268dde81ed2 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 26 Sep 2024 08:21:57 +0100 Subject: [PATCH 2/6] Support for packing multidimensional inputs --- R/packer.R | 171 +++++++++++++++++++++++++++++++++-- man/monty_packer.Rd | 47 +++++++++- tests/testthat/test-packer.R | 126 +++++++++++++++++++++++++- 3 files changed, 328 insertions(+), 16 deletions(-) diff --git a/R/packer.R b/R/packer.R index b538be92..485a4919 100644 --- a/R/packer.R +++ b/R/packer.R @@ -114,9 +114,36 @@ ##' This approach generalises to higher dimensional input, though we ##' suspect you'll spend a bit of time head-scratching if you use it. ##' -##' We do not currently offer the ability to pack this sort of output -##' back up, though it's not hard. Please let us know if you would -##' use this. +##' # Packing lists into vectors and matrices +##' +##' The unpacking operation is very common - an MCMC proceeds, +##' produces an unstructured vector, and you unpack it into a list in +##' order to be able to easily work with it. The reverse is much less +##' common, where we take a list and convert it into a vector (or +##' matrix, or multidimensional array). Use of this direction +##' ("packing") may be more common where using packers to work with +##' the output of state-space models (e.g. in +##' [odin2](https://mrc-ide.github.io/odin2) or +##' [dust2](https://mrc-ide.github.io/dust2), which use this +##' machinery). +##' +##' The input to `pack()` will be the shape that `unpack()` returned; +##' a named list of numerical vectors, matrices and arrays. The names +##' must correspond do the names if your packer (i.e., `scalar` and +##' the names of `array`). Each element has dimensions +##' +##' ``` +##' <...object, ...residual> +##' ``` +##' +##' where `...object` is the dimensions of the data itself and +##' `...residual` is the dimensions of the hypothetical input to +##' `pack`. +##' +##' There is an unfortunate ambiguity in R's lack of true scalar types +##' that we cannot avoid. It is hard to tell the difference packing a +##' 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 ##' @@ -211,6 +238,21 @@ ##' # The processed elements are ignored on the return pack: ##' p$pack(list(a = 1, b_flat = 2:4, b = matrix(c(2, 3, 3, 4), 2, 2))) ##' p$pack(list(a = 1, b_flat = 2:4)) +##' +##' # R lacks scalars, which means that some packers will unpack +##' # different inputs to the same outputs: +##' p <- monty_packer(c("a", "b")) +##' p$unpack(1:2) +##' p$unpack(cbind(1:2)) +##' +##' # This means that we can't reliably pack these inputs in a way +##' # that guarantees round-tripping is possible. We have chosen to +##' # prioritise the case where a *single vector* is round-trippable: +##' p$pack(list(a = 1, b = 2)) +##' +##' # This ambiguity goes away if unpacking matices with more than one +##' # column: +##' p$unpack(matrix(1:6, 2, 3)) monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, process = NULL) { call <- environment() @@ -286,14 +328,25 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, } pack <- function(p) { - res <- numeric(length(parameters)) - if (!all(lengths(p[names(idx)]) == lengths(idx))) { - ## Not quite enough, because we should check the dimensions too. - ## That ends up being quite hard with integer checks possibly - ## because we really want to use identical() - this will do for now. - cli::cli_abort("Invalid structure to 'pack()'") + ## We might want a more explicit error here? + assert_named(p, unique = TRUE) + ## TODO: drop any processed and fixed things here, which means + ## we're more concerned about finding things we can reshape than + ## anything else. + shp <- pack_check_dimensions(p, scalar, shape, names(fixed), process) + ret <- matrix(NA_real_, len, prod(shp)) + for (i in seq_along(p)) { + ret[idx[[i]], ] <- p[[i]] } - unlist(lapply(names(idx), function(el) p[el]), TRUE, FALSE) + + drop <- length(shp) == 0 || + (length(shp) == 1 && (length(shape) == 0 || all(lengths(shape) == 0))) + if (drop) { + dim(ret) <- NULL + } else if (length(shp) > 1) { + dim(ret) <- c(len, shp) + } + ret } ret <- list(parameters = parameters, @@ -317,6 +370,7 @@ prepare_pack_array <- function(name, shape, call = NULL) { "'{name}' is not"), arg = "array", call = call) } + shape <- as.integer(shape) if (length(shape) == 0) { return(list(names = name, shape = integer(0), n = 1L)) } @@ -366,6 +420,7 @@ print.monty_packer <- function(x, ...) { unpack_vector <- function(x, parameters, len, idx, shape, fixed, process) { call <- parent.frame() if (!is.null(names(x))) { + browser() if (!identical(names(x), parameters)) { ## Here, we could do better I think with this message; we ## might pass thropuigh empty names, and produce some summary @@ -442,3 +497,99 @@ unpack_array <- function(x, parameters, len, idx, shape, fixed, process) { res } + + +## Now, we do some annoying calculations to make sure that what we've +## been gven has the correct size, etc. +pack_check_dimensions <- function(p, scalar, shape, fixed, process, + call = parent.frame()) { + if (length(scalar) > 0) { + shape <- c(set_names(rep(list(integer()), length(scalar)), scalar), + shape) + } + + msg <- setdiff(names(shape), names(p)) + extra <- if (is.null(process)) setdiff(names(p), c(names(shape), fixed)) + + err <- setdiff(names(shape), names(p)) + if (length(err) > 0) { + cli::cli_abort("Name{?s} missing from input to pack: {squote(err)}", + call = call) + } + if (length(extra) > 0) { + cli::cli_abort( + "Unexpected element{?s} present in input to pack: {squote(extra)}", + call = call) + } + + ## It's very tedious to check if we can map a set of inputs to a + ## single pack. What we expect is if we have an element 'x' with + ## dimensions and we expect that the shape 's' of + ## this is we need to validate that the first dimensions of + ## 'x' are 's' and thern record the remainder - that's the shape of + ## the rest of the eventual object (so if there is no dimension left + ## then it was originally a vector, if there's one element left our + ## original input was a matrix and so on). Then we check that this + ## remainder is consistent across all elements in the list. + ## + ## There are a couple of additional wrinkles due to scalar variables + ## (these are ones where 's' has length 0). First, We can't drop + ## things from 'd' with d[-i] because that will drop everything. + ## Second, when working out the residual dimensions of the packed + ## data we might have a situation where there are some scalars for + ## which we think the residual dimension is 1 and some non-scalars + ## where we think there is no residual dimension. This is actually + ## the same situation. This is explored a bit in the tests and the + ## examples above. + res <- lapply(names(shape), function(nm) { + d <- dim2(p[[nm]]) + s <- shape[[nm]] + i <- seq_along(s) + if (length(d) >= length(s) && identical(d[i], s)) { + list(success = TRUE, residual = if (length(i) == 0) d else d[-i]) + } else { + list(success = FALSE, shape = d[i]) + } + }) + + err <- !vlapply(res, "[[", "success") + if (any(err)) { + err_nms <- names(shape)[err] + detail <- sprintf( + "%s: expected <%s>, given <%s>", + err_nms, + vcapply(shape[err], paste, collapse = ", "), + vcapply(res[err], function(x) paste(x$shape, collapse = ", "))) + cli::cli_abort( + c("Incompatible dimensions in input for {squote(names(shape)[err])}", + set_names(detail, "x")), + call = call) + } + + residual <- lapply(res, "[[", "residual") + is_scalar <- lengths(residual) == 0 + is_vector_output <- any(is_scalar) && + all(lengths(residual[!is_scalar]) == 1) && + all(vnapply(residual[!is_scalar], identity) == 1) + if (is_vector_output) { + return(integer()) + } + + ret <- residual[[1]] + ok <- vlapply(residual, identical, ret) + if (!all(ok)) { + residual[is_scalar] <- 1L + hash <- vcapply(residual, rlang::hash) + detail <- vcapply(unique(hash), function(h) { + sprintf("%s: <...%s>", + paste(squote(names(shape)[hash == h]), collapse = ", "), + paste(residual[hash == h][[1]], collapse = ", ")) + }) + cli::cli_abort( + c("Inconsistent residual dimension in inputs", + set_names(detail, "x")), + call = call) + } + + ret +} diff --git a/man/monty_packer.Rd b/man/monty_packer.Rd index 7ae2ff25..89af6330 100644 --- a/man/monty_packer.Rd +++ b/man/monty_packer.Rd @@ -166,10 +166,36 @@ matrices (one column per set) and so on. This approach generalises to higher dimensional input, though we suspect you'll spend a bit of time head-scratching if you use it. +} + +\section{Packing lists into vectors and matrices}{ +The unpacking operation is very common - an MCMC proceeds, +produces an unstructured vector, and you unpack it into a list in +order to be able to easily work with it. The reverse is much less +common, where we take a list and convert it into a vector (or +matrix, or multidimensional array). Use of this direction +("packing") may be more common where using packers to work with +the output of state-space models (e.g. in +\href{https://mrc-ide.github.io/odin2}{odin2} or +\href{https://mrc-ide.github.io/dust2}{dust2}, which use this +machinery). + +The input to \code{pack()} will be the shape that \code{unpack()} returned; +a named list of numerical vectors, matrices and arrays. The names +must correspond do the names if your packer (i.e., \code{scalar} and +the names of \code{array}). Each element has dimensions + +\if{html}{\out{
}}\preformatted{<...object, ...residual> +}\if{html}{\out{
}} -We do not currently offer the ability to pack this sort of output -back up, though it's not hard. Please let us know if you would -use this. +where \code{...object} is the dimensions of the data itself and +\code{...residual} is the dimensions of the hypothetical input to +\code{pack}. + +There is an unfortunate ambiguity in R's lack of true scalar types +that we cannot avoid. It is hard to tell the difference packing a +vector vs packing an array where all dimensions are 1. See the +examples, and please let us know if the behaviour needs changing. } \examples{ @@ -214,4 +240,19 @@ p$unpack(1:4) # The processed elements are ignored on the return pack: p$pack(list(a = 1, b_flat = 2:4, b = matrix(c(2, 3, 3, 4), 2, 2))) p$pack(list(a = 1, b_flat = 2:4)) + +# R lacks scalars, which means that some packers will unpack +# different inputs to the same outputs: +p <- monty_packer(c("a", "b")) +p$unpack(1:2) +p$unpack(cbind(1:2)) + +# This means that we can't reliably pack these inputs in a way +# that guarantees round-tripping is possible. We have chosen to +# prioritise the case where a *single vector* is round-trippable: +p$pack(list(a = 1, b = 2)) + +# This ambiguity goes away if unpacking matices with more than one +# column: +p$unpack(matrix(1:6, 2, 3)) } diff --git a/tests/testthat/test-packer.R b/tests/testthat/test-packer.R index 1c849b40..a23dfb49 100644 --- a/tests/testthat/test-packer.R +++ b/tests/testthat/test-packer.R @@ -14,9 +14,11 @@ test_that("trivial packer", { expect_error(xp$unpack(1:2), "Incorrect length input; expected 1 but given 2") expect_equal(xp$pack(list(a = 1)), 1) - expect_error(xp$pack(list(a = 1:2)), - "Invalid structure to 'pack()'", - fixed = TRUE) + expect_equal(xp$pack(list(a = 1:2)), + 1:2) + expect_equal(xp$pack(list(a = 1:2, b = 2)), + 1:2) + expect_equal(xp$index(), list(a = 1)) }) @@ -225,6 +227,7 @@ test_that("can't used process with array unpacking", { test_that("Properly unpack scalars stored as zero-length arrays", { p <- monty_packer(array = list(a = integer(0), b = 1L)) expect_equal(p$unpack(1:2), list(a = 1, b = 2)) + expect_equal(p$unpack(cbind(1:2)), list(a = 1, b = matrix(2))) expect_equal(p$unpack(matrix(1:10, 2, 5)), list(a = seq(1, 9, by = 2), b = matrix(seq(2, 10, by = 2), 1, 5))) @@ -232,3 +235,120 @@ test_that("Properly unpack scalars stored as zero-length arrays", { list(a = matrix(seq(1, 29, by = 2), c(3, 5)), b = array(seq(2, 30, by = 2), c(1, 3, 5)))) }) + + +## These tests are the inverse of the tests abvove. +test_that("Roundtrip scalars stored as zero-length arrays", { + p <- monty_packer(array = list(a = integer(0), b = 1L)) + p$pack(list(a = 1, b = 2)) + + ## expect_equal(p$unpack(1:2), list(a = 1, b = 2)) + expect_equal(p$pack(list(a = 1, b = 2)), c(1, 2)) + expect_equal(p$pack(list(a = 1, b = matrix(2))), cbind(c(1, 2))) + + ## expect_equal(p$pack(list(a = 1, b = 2)), 1:2) + expect_equal(p$pack(list(a = seq(1, 9, by = 2), + b = matrix(seq(2, 10, by = 2), 1, 5))), + matrix(1:10, 2, 5)) + expect_equal(p$pack(list(a = matrix(seq(1, 29, by = 2), c(3, 5)), + b = array(seq(2, 30, by = 2), c(1, 3, 5)))), + array(1:30, c(2, 3, 5))) +}) + + +test_that("all-scalar corner case", { + p1 <- monty_packer(c("a", "b")) + p2 <- monty_packer(array = list(a = integer(0), b = integer(0))) + + ## These inputs both map to the same output, for both ways of + ## writing the packer: + expect_equal(p1$unpack(1:2), + list(a = 1, b = 2)) + expect_equal(p1$unpack(cbind(1:2)), + list(a = 1, b = 2)) + expect_equal(p2$unpack(1:2), + list(a = 1, b = 2)) + expect_equal(p2$unpack(cbind(1:2)), + list(a = 1, b = 2)) + + ## Which means that we can't work out how to pack this output, with + ## either packer: + expect_equal(p1$pack(list(a = 1, b = 2)), + 1:2) + expect_equal(p2$pack(list(a = 1, b = 2)), + 1:2) +}) + + +test_that("validate that we can consistently unpack things", { + p <- monty_packer("a", list(b = 2, c = 3:4)) + + i <- p$unpack(1:15) + p$pack(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4))) + + expect_equal( + p$pack(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4))), + 1:15) + + p$unpack(matrix(1:45, 15, 3)) +}) + + +test_that("give errors when input is the wrong shape, from scalar input", { + p <- monty_packer("a", list(b = 2, c = 3:4)) + + ## Check the happy path first: + expect_equal( + p$pack(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4))), + 1:15) + v <- p$unpack(matrix(1:45, 15, 3)) + expect_equal(p$pack(v), matrix(1:45, 15, 3)) + + err <- expect_error( + p$pack(list(a = 1, b = 1:3, c = matrix(4:15, 3, 4))), + "Incompatible dimensions in input for 'b'") + expect_match(err$body[[1]], "b: expected <2>, given <3>") + err <- expect_error( + p$pack(list(a = numeric(3), + b = matrix(0, 3, 3), + c = array(0, c(3, 4, 3)))), + "Incompatible dimensions in input for 'b'") + expect_match(err$body[[1]], "b: expected <2>, given <3>") + + err <- expect_error( + p$pack(list(a = 1, b = 1:3, c = matrix(4:15, 4, 3))), + "Incompatible dimensions in input for 'b'") + expect_match(err$body[[1]], "b: expected <2>, given <3>") + expect_match(err$body[[2]], "c: expected <3, 4>, given <4, 3>") + err <- expect_error( + p$pack(list(a = 1, + b = matrix(0, 3, 3), + c = array(0, c(4, 3, 3)))), + "Incompatible dimensions in input for 'b'") + expect_match(err$body[[1]], "b: expected <2>, given <3>") + expect_match(err$body[[2]], "c: expected <3, 4>, given <4, 3>") +}) + + +test_that("give errors when input has incorect residual dimension", { + p <- monty_packer("a", list(b = 2, c = 3:4)) + + err <- expect_error( + p$pack(list(a = 1, b = matrix(2:3, 2, 3), c = matrix(4:15, 3, 4))), + "Inconsistent residual dimension in inputs") + expect_equal( + err$body, + c(x = "'a', 'c': <...1>", + x = "'b': <...3>")) + + err <- expect_error( + p$pack(list(a = numeric(4), + b = matrix(0, 2, 3), + c = array(0, c(3, 4, 5)))), + "Inconsistent residual dimension in inputs") + expect_equal( + err$body, + c(x = "'a': <...4>", + x = "'b': <...3>", + x = "'c': <...5>")) +}) From ef0ab0a417792744ec83e0ffb471b6bdfbb1c5d1 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 26 Sep 2024 08:30:36 +0100 Subject: [PATCH 3/6] Expand tests --- R/packer.R | 7 +++--- tests/testthat/test-packer.R | 42 ++++++++++++++++++++++++++++++------ 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/R/packer.R b/R/packer.R index 485a4919..49307d30 100644 --- a/R/packer.R +++ b/R/packer.R @@ -335,8 +335,8 @@ monty_packer <- function(scalar = NULL, array = NULL, fixed = NULL, ## anything else. shp <- pack_check_dimensions(p, scalar, shape, names(fixed), process) ret <- matrix(NA_real_, len, prod(shp)) - for (i in seq_along(p)) { - ret[idx[[i]], ] <- p[[i]] + for (nm in c(scalar, names(shape))) { + ret[idx[[nm]], ] <- p[[nm]] } drop <- length(shp) == 0 || @@ -420,7 +420,6 @@ print.monty_packer <- function(x, ...) { unpack_vector <- function(x, parameters, len, idx, shape, fixed, process) { call <- parent.frame() if (!is.null(names(x))) { - browser() if (!identical(names(x), parameters)) { ## Here, we could do better I think with this message; we ## might pass thropuigh empty names, and produce some summary @@ -513,7 +512,7 @@ pack_check_dimensions <- function(p, scalar, shape, fixed, process, err <- setdiff(names(shape), names(p)) if (length(err) > 0) { - cli::cli_abort("Name{?s} missing from input to pack: {squote(err)}", + cli::cli_abort("Missing element{?s} from input to pack: {squote(err)}", call = call) } if (length(extra) > 0) { diff --git a/tests/testthat/test-packer.R b/tests/testthat/test-packer.R index a23dfb49..bc7338af 100644 --- a/tests/testthat/test-packer.R +++ b/tests/testthat/test-packer.R @@ -16,8 +16,6 @@ test_that("trivial packer", { expect_equal(xp$pack(list(a = 1)), 1) expect_equal(xp$pack(list(a = 1:2)), 1:2) - expect_equal(xp$pack(list(a = 1:2, b = 2)), - 1:2) expect_equal(xp$index(), list(a = 1)) }) @@ -283,14 +281,20 @@ test_that("all-scalar corner case", { test_that("validate that we can consistently unpack things", { p <- monty_packer("a", list(b = 2, c = 3:4)) - i <- p$unpack(1:15) - p$pack(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4))) - expect_equal( p$pack(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4))), 1:15) - p$unpack(matrix(1:45, 15, 3)) + ## Order does not matter: + expect_equal( + p$pack(rev(list(a = 1, b = 2:3, c = matrix(4:15, 3, 4)))), + 1:15) + + v <- p$unpack(matrix(1:45, 15, 3)) + expect_equal(names(v), c("a", "b", "c")) + expect_equal(v$a, c(1, 16, 31)) + expect_equal(v$b, cbind(2:3, 17:18, 32:33)) + expect_equal(v$c, array(c(4:15, 19:30, 34:45), c(3, 4, 3))) }) @@ -352,3 +356,29 @@ test_that("give errors when input has incorect residual dimension", { x = "'b': <...3>", x = "'c': <...5>")) }) + + +test_that("validate names to pack", { + p <- monty_packer("a", list(b = 2, c = 3:4)) + expect_error( + p$pack(list(a = 1, b = 2, c = 3, d = 4)), + "Unexpected element present in input to pack: 'd'") + expect_error( + p$pack(list(a = 1, d = 4)), + "Missing elements from input to pack: 'b' and 'c'") +}) + + +test_that("fixed inputs can be present or absent", { + p <- monty_packer(c("a", "b"), fixed = list(c = 10, d = 12)) + expect_equal(p$pack(list(a = 1, b = 2)), 1:2) + expect_equal(p$pack(list(a = 1, b = 2, c = NA)), 1:2) +}) + + +test_that("if process is present ignore extra names", { + p <- monty_packer(c("a", "b"), process = identity) + expect_equal( + p$pack(list(a = 1, b = 2)), + 1:2) +}) From 66a738d2c265a06057547662824b5619e872076b Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 26 Sep 2024 08:33:31 +0100 Subject: [PATCH 4/6] Bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5ed6714c..9146d764 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: monty Title: Monte Carlo Models -Version: 0.2.6 +Version: 0.2.7 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), From ed34d639341d895bdca89eef626228da743181e7 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 09:36:30 +0100 Subject: [PATCH 5/6] Apply suggestions from code review Co-authored-by: Wes Hinsley --- R/packer.R | 6 +++--- tests/testthat/test-packer.R | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/packer.R b/R/packer.R index 49307d30..a64ae5b6 100644 --- a/R/packer.R +++ b/R/packer.R @@ -499,7 +499,7 @@ unpack_array <- function(x, parameters, len, idx, shape, fixed, process) { ## Now, we do some annoying calculations to make sure that what we've -## been gven has the correct size, etc. +## been given has the correct size, etc. pack_check_dimensions <- function(p, scalar, shape, fixed, process, call = parent.frame()) { if (length(scalar) > 0) { @@ -525,14 +525,14 @@ pack_check_dimensions <- function(p, scalar, shape, fixed, process, ## single pack. What we expect is if we have an element 'x' with ## dimensions and we expect that the shape 's' of ## this is we need to validate that the first dimensions of - ## 'x' are 's' and thern record the remainder - that's the shape of + ## 'x' are 's' and then record the remainder - that's the shape of ## the rest of the eventual object (so if there is no dimension left ## then it was originally a vector, if there's one element left our ## original input was a matrix and so on). Then we check that this ## remainder is consistent across all elements in the list. ## ## There are a couple of additional wrinkles due to scalar variables - ## (these are ones where 's' has length 0). First, We can't drop + ## (these are ones where 's' has length 0). First, we can't drop ## things from 'd' with d[-i] because that will drop everything. ## Second, when working out the residual dimensions of the packed ## data we might have a situation where there are some scalars for diff --git a/tests/testthat/test-packer.R b/tests/testthat/test-packer.R index bc7338af..d73b0fcb 100644 --- a/tests/testthat/test-packer.R +++ b/tests/testthat/test-packer.R @@ -238,7 +238,7 @@ test_that("Properly unpack scalars stored as zero-length arrays", { ## These tests are the inverse of the tests abvove. test_that("Roundtrip scalars stored as zero-length arrays", { p <- monty_packer(array = list(a = integer(0), b = 1L)) - p$pack(list(a = 1, b = 2)) + expect_equal(p$pack(list(a = 1, b = 2)), c(1, 2)) ## expect_equal(p$unpack(1:2), list(a = 1, b = 2)) expect_equal(p$pack(list(a = 1, b = 2)), c(1, 2)) From f8982f203129eb5a3d274507fb1182c13b6517c2 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 09:48:15 +0100 Subject: [PATCH 6/6] Update R/packer.R Co-authored-by: Wes Hinsley --- R/packer.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/packer.R b/R/packer.R index a64ae5b6..0517ecf4 100644 --- a/R/packer.R +++ b/R/packer.R @@ -129,7 +129,7 @@ ##' ##' The input to `pack()` will be the shape that `unpack()` returned; ##' a named list of numerical vectors, matrices and arrays. The names -##' must correspond do the names if your packer (i.e., `scalar` and +##' must correspond to the names in your packer (i.e., `scalar` and ##' the names of `array`). Each element has dimensions ##' ##' ```