diff --git a/NAMESPACE b/NAMESPACE index 20b219bde..c31d339a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,8 @@ S3method(as.data.frame,epiparameter) S3method(as.data.frame,multi_epiparameter) S3method(as.function,epiparameter) S3method(as_epiparameter,data.frame) +S3method(c,epiparameter) +S3method(c,multi_epiparameter) S3method(cdf,epiparameter) S3method(convert_params_to_summary_stats,character) S3method(convert_params_to_summary_stats,epiparameter) diff --git a/R/epiparameter.R b/R/epiparameter.R index 66e66451a..b675256b3 100644 --- a/R/epiparameter.R +++ b/R/epiparameter.R @@ -920,3 +920,62 @@ mean.epiparameter <- function(x, ...) { # return mean or NA mean } + +#' [c()] method for `` class +#' +#' @param ... [dots] Objects to be concatenated. +#' +#' @return An `` or list of `` objects. +#' @export +#' +#' @examples +#' db <- epiparameter_db() +#' +#' # combine two objects into a list +#' c(db[[1]], db[[2]]) +#' +#' # combine a list of objects and a single object +#' c(db, db[[1]]) +c.epiparameter <- function(...) { + x <- list(...) + if (!all(vapply(x, FUN = inherits, FUN.VALUE = logical(1), + what = c("epiparameter", "multi_epiparameter")))) { + stop( + "Can only combine or objects", + call. = FALSE + ) + } + + # if are in `...` build the new unnested list of + # objects iteratively in order to preserve input order + if (any(vapply(x, FUN = inherits, FUN.VALUE = logical(1), + what = "multi_epiparameter"))) { + # list is not pre-allocated as it's easier to append arbitrary length + # objects + ep_list <- list() + for (i in seq_along(x)) { + if (is_epiparameter(x[[i]])) { + ep_list <- c(ep_list, list(x[[i]])) + } else { + # unclass to prevent recursive dispatch + ep_list <- c(ep_list, unclass(x[[i]])) + } + } + } else { + ep_list <- x + } + + # for when `...` is a single + if (length(ep_list) == 1) { + ep_list <- ep_list[[1]] + } else { + # will always be triggered if called from c.multi_epiparameter + class(ep_list) <- "multi_epiparameter" + } + ep_list +} + +#' @export +c.multi_epiparameter <- function(...) { + c.epiparameter(...) +} diff --git a/man/c.epiparameter.Rd b/man/c.epiparameter.Rd new file mode 100644 index 000000000..140844cc2 --- /dev/null +++ b/man/c.epiparameter.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/epiparameter.R +\name{c.epiparameter} +\alias{c.epiparameter} +\title{\code{\link[=c]{c()}} method for \verb{} class} +\usage{ +\method{c}{epiparameter}(...) +} +\arguments{ +\item{...}{\link{dots} Objects to be concatenated.} +} +\value{ +An \verb{} or list of \verb{} objects. +} +\description{ +\code{\link[=c]{c()}} method for \verb{} class +} +\examples{ +db <- epiparameter_db() + +# combine two objects into a list +c(db[[1]], db[[2]]) + +# combine a list of objects and a single object +c(db, db[[1]]) +} diff --git a/tests/testthat/test-epiparameter.R b/tests/testthat/test-epiparameter.R index 00fc50b3f..aea7fa13f 100644 --- a/tests/testthat/test-epiparameter.R +++ b/tests/testthat/test-epiparameter.R @@ -1232,3 +1232,65 @@ test_that("as.data.frame works for from db", { "notes") ) }) + +{ + suppressMessages( + db <- epiparameter_db() + ) + ep <- db[[1]] +} + +test_that("c.epiparameter works as expected with two s", { + res <- c(ep, ep) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, 2) + expect_s3_class(res[[1]], class = "epiparameter") +}) + +test_that("c.epiparameter works as expected with one ", { + res <- c(ep) + expect_s3_class(res, class = "epiparameter") + expect_true(test_epiparameter(res)) +}) + +test_that("c.epiparameter works with & ", { + res <- c(ep, db) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, length(db) + 1) + expect_s3_class(res[[1]], class = "epiparameter") +}) + +test_that("c.multi_epiparameter works with two s", { + res <- c(db, db) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, 244) + expect_s3_class(res[[1]], class = "epiparameter") +}) + +test_that("c.multi_epiparameter works with one ", { + res <- c(db) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, length(db)) +}) + +test_that("c.multi_epiparameter works & ", { + res <- c(db, ep) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, length(db) + 1) + expect_s3_class(res[[1]], class = "epiparameter") +}) + +test_that("c.epiparameter preserves input order", { + res <- c(ep, db, ep) + expect_s3_class(res, class = "multi_epiparameter") + expect_length(res, length(db) + 2) + expect_true(identical(res[[1]], res[[2]])) + expect_true(identical(res[[1]], res[[length(res)]])) +}) + +test_that("c.epiparameter fails as expected", { + expect_error( + c(ep, 1), + regexp = "Can only combine or objects" + ) +}) diff --git a/vignettes/epiparameter.Rmd b/vignettes/epiparameter.Rmd index bc3af0d27..5a4ced39b 100644 --- a/vignettes/epiparameter.Rmd +++ b/vignettes/epiparameter.Rmd @@ -202,7 +202,7 @@ If a set of epidemiological parameter has been inferred and is known to the user ```{r add-to-library} # wrap in list to append to database -new_db <- append(db, list(covid_incubation)) +new_db <- append(db, covid_incubation) tail(new_db, n = 3) ```