diff --git a/R/growth_rate.R b/R/growth_rate.R index d3ca9e31..568e7c4d 100644 --- a/R/growth_rate.R +++ b/R/growth_rate.R @@ -44,7 +44,8 @@ #' * "rel_change": uses (B/A - 1) / h, where B is the average of `y` over the #' second half of a sliding window of bandwidth h centered at the reference #' point `x0`, and A the average over the first half. This can be seen as -#' using a first-difference approximation to the derivative. +#' using a first-difference approximation to the derivative. This is the +#' default if `method` is not specified. #' * "linear_reg": uses the slope from a linear regression of `y` on `x` over a #' sliding window centered at the reference point `x0`, divided by the fitted #' value from this linear regression at `x0`. @@ -145,7 +146,7 @@ growth_rate = function(x = seq_along(y), y, x0 = x, # Remove NAs if we need to if (na_rm) { - o = !(is.na(x) & is.na(y)) + o = !is.na(x) & !is.na(y) x = x[o] y = y[o] } diff --git a/man/as_epi_archive.Rd b/man/as_epi_archive.Rd index d13ba4d6..a98798cc 100644 --- a/man/as_epi_archive.Rd +++ b/man/as_epi_archive.Rd @@ -91,11 +91,15 @@ examples. } \details{ This simply a wrapper around the \code{new()} method of the \code{epi_archive} -class, so for example:\preformatted{x <- as_epi_archive(df, geo_type = "state", time_type = "day") -} +class, so for example: -would be equivalent to:\preformatted{x <- epi_archive$new(df, geo_type = "state", time_type = "day") -} +\if{html}{\out{
}}\preformatted{x <- as_epi_archive(df, geo_type = "state", time_type = "day") +}\if{html}{\out{
}} + +would be equivalent to: + +\if{html}{\out{
}}\preformatted{x <- epi_archive$new(df, geo_type = "state", time_type = "day") +}\if{html}{\out{
}} } \examples{ # Simple ex. with necessary keys diff --git a/man/as_epi_df.Rd b/man/as_epi_df.Rd index 6d7592e4..851aed7e 100644 --- a/man/as_epi_df.Rd +++ b/man/as_epi_df.Rd @@ -52,9 +52,9 @@ examples. } \section{Methods (by class)}{ \itemize{ -\item \code{epi_df}: Simply returns the \code{epi_df} object unchanged. +\item \code{as_epi_df(epi_df)}: Simply returns the \code{epi_df} object unchanged. -\item \code{tbl_df}: The input tibble \code{x} must contain the columns +\item \code{as_epi_df(tbl_df)}: The input tibble \code{x} must contain the columns \code{geo_value} and \code{time_value}. All other columns will be preserved as is, and treated as measured variables. If \code{as_of} is missing, then the function will try to guess it from an \code{as_of}, \code{issue}, or \code{version} column of \code{x} @@ -62,14 +62,14 @@ will try to guess it from an \code{as_of}, \code{issue}, or \code{version} colum (stored in its attributes); if this fails, then the current day-time will be used. -\item \code{data.frame}: Works analogously to \code{as_epi_df.tbl_df()}. +\item \code{as_epi_df(data.frame)}: Works analogously to \code{as_epi_df.tbl_df()}. -\item \code{tbl_ts}: Works analogously to \code{as_epi_df.tbl_df()}, except that +\item \code{as_epi_df(tbl_ts)}: Works analogously to \code{as_epi_df.tbl_df()}, except that the \code{tbl_ts} class is dropped, and any key variables (other than "geo_value") are added to the metadata of the returned object, under the \code{other_keys} field. -}} +}} \examples{ # Convert a `tsibble` that has county code as an extra key # Notice that county code should be a character string to preserve any leading zeroes diff --git a/man/epi_archive.Rd b/man/epi_archive.Rd index 0b198eab..026f27e1 100644 --- a/man/epi_archive.Rd +++ b/man/epi_archive.Rd @@ -114,18 +114,18 @@ toy_epi_archive \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-new}{\code{epi_archive$new()}} -\item \href{#method-print}{\code{epi_archive$print()}} -\item \href{#method-as_of}{\code{epi_archive$as_of()}} -\item \href{#method-fill_through_version}{\code{epi_archive$fill_through_version()}} -\item \href{#method-merge}{\code{epi_archive$merge()}} -\item \href{#method-slide}{\code{epi_archive$slide()}} -\item \href{#method-clone}{\code{epi_archive$clone()}} +\item \href{#method-epi_archive-new}{\code{epi_archive$new()}} +\item \href{#method-epi_archive-print}{\code{epi_archive$print()}} +\item \href{#method-epi_archive-as_of}{\code{epi_archive$as_of()}} +\item \href{#method-epi_archive-fill_through_version}{\code{epi_archive$fill_through_version()}} +\item \href{#method-epi_archive-merge}{\code{epi_archive$merge()}} +\item \href{#method-epi_archive-slide}{\code{epi_archive$slide()}} +\item \href{#method-epi_archive-clone}{\code{epi_archive$clone()}} } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-new}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-new}{}}} \subsection{Method \code{new()}}{ Creates a new \code{epi_archive} object. \subsection{Usage}{ @@ -195,8 +195,8 @@ An \code{epi_archive} object. } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-print}{}}} \subsection{Method \code{print()}}{ \subsection{Usage}{ \if{html}{\out{
}}\preformatted{epi_archive$print()}\if{html}{\out{
}} @@ -204,8 +204,8 @@ An \code{epi_archive} object. } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-as_of}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-as_of}{}}} \subsection{Method \code{as_of()}}{ Generates a snapshot in \code{epi_df} format as of a given version. See the documentation for the wrapper function \code{\link[=epix_as_of]{epix_as_of()}} for details. @@ -215,8 +215,8 @@ See the documentation for the wrapper function \code{\link[=epix_as_of]{epix_as_ } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-fill_through_version}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-fill_through_version}{}}} \subsection{Method \code{fill_through_version()}}{ Fill in unobserved history using requested scheme by mutating \code{self} and potentially reseating its fields. See @@ -237,8 +237,8 @@ version, which doesn't mutate the input archive but might alias its fields. } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-merge}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-merge}{}}} \subsection{Method \code{merge()}}{ Merges another \code{epi_archive} with the current one, mutating the current one by reseating its \code{DT} and several other fields, but avoiding @@ -267,8 +267,8 @@ does not alias either archive's \code{DT}. } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-slide}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-slide}{}}} \subsection{Method \code{slide()}}{ Slides a given function over variables in an \code{epi_archive} object. See the documentation for the wrapper function \code{\link[=epix_slide]{epix_slide()}} for @@ -290,8 +290,8 @@ details. } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-clone}{}}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-epi_archive-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ diff --git a/man/epi_slide.Rd b/man/epi_slide.Rd index c64bbce1..1b620b69 100644 --- a/man/epi_slide.Rd +++ b/man/epi_slide.Rd @@ -107,12 +107,16 @@ incomplete windows) is therefore left up to the user, either through the specified function or formula \code{f}, or through post-processing. If \code{f} is missing, then an expression for tidy evaluation can be specified, -for example, as in:\preformatted{epi_slide(x, cases_7dav = mean(cases), n = 7) -} +for example, as in: + +\if{html}{\out{
}}\preformatted{epi_slide(x, cases_7dav = mean(cases), n = 7) +}\if{html}{\out{
}} -which would be equivalent to:\preformatted{epi_slide(x, function(x, ...) mean(x$cases), n = 7, +which would be equivalent to: + +\if{html}{\out{
}}\preformatted{epi_slide(x, function(x, ...) mean(x$cases), n = 7, new_col_name = "cases_7dav") -} +}\if{html}{\out{
}} Thus, to be clear, when the computation is specified via an expression for tidy evaluation (first example, above), then the name for the new column is diff --git a/man/epix_as_of.Rd b/man/epix_as_of.Rd index 6dc72a44..4053cd28 100644 --- a/man/epix_as_of.Rd +++ b/man/epix_as_of.Rd @@ -29,11 +29,15 @@ examples. } \details{ This is simply a wrapper around the \code{as_of()} method of the -\code{epi_archive} class, so if \code{x} is an \code{epi_archive} object, then:\preformatted{epix_as_of(x, max_version = v) -} +\code{epi_archive} class, so if \code{x} is an \code{epi_archive} object, then: -is equivalent to:\preformatted{x$as_of(max_version = v) -} +\if{html}{\out{
}}\preformatted{epix_as_of(x, max_version = v) +}\if{html}{\out{
}} + +is equivalent to: + +\if{html}{\out{
}}\preformatted{x$as_of(max_version = v) +}\if{html}{\out{
}} } \examples{ # warning message of data latency shown diff --git a/man/epix_slide.Rd b/man/epix_slide.Rd index 2acae1a1..79e9c1c3 100644 --- a/man/epix_slide.Rd +++ b/man/epix_slide.Rd @@ -115,11 +115,15 @@ should never be used in place of \code{epi_slide()}, and only used when version-aware sliding is necessary (as it its purpose). Finally, this is simply a wrapper around the \code{slide()} method of the -\code{epi_archive} class, so if \code{x} is an \code{epi_archive} object, then:\preformatted{epix_slide(x, new_var = comp(old_var), n = 120) -} +\code{epi_archive} class, so if \code{x} is an \code{epi_archive} object, then: -is equivalent to:\preformatted{x$slide(x, new_var = comp(old_var), n = 120) -} +\if{html}{\out{
}}\preformatted{epix_slide(x, new_var = comp(old_var), n = 120) +}\if{html}{\out{
}} + +is equivalent to: + +\if{html}{\out{
}}\preformatted{x$slide(x, new_var = comp(old_var), n = 120) +}\if{html}{\out{
}} } \examples{ # these dates are reference time points for the 3 day average sliding window diff --git a/man/growth_rate.Rd b/man/growth_rate.Rd index 173eff43..f6273b8d 100644 --- a/man/growth_rate.Rd +++ b/man/growth_rate.Rd @@ -72,7 +72,8 @@ The following methods are available for estimating the growth rate: \item "rel_change": uses (B/A - 1) / h, where B is the average of \code{y} over the second half of a sliding window of bandwidth h centered at the reference point \code{x0}, and A the average over the first half. This can be seen as -using a first-difference approximation to the derivative. +using a first-difference approximation to the derivative. This is the +default method if \code{method} is not specified. \item "linear_reg": uses the slope from a linear regression of \code{y} on \code{x} over a sliding window centered at the reference point \code{x0}, divided by the fitted value from this linear regression at \code{x0}. diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R new file mode 100644 index 00000000..be1ed75d --- /dev/null +++ b/tests/testthat/test-growth_rate.R @@ -0,0 +1,56 @@ +library(dplyr) + +X <- c(1:10,NA,10:20,NA) +Y <- c(2^(1:9),NA,NA,2^(10:21)) + +methods <- c("rel_change","linear_reg","smooth_spline","trend_filter") + +gr <- function(method = "rel_change", h = 3, na_rm = TRUE, ...) { + growth_rate(x=X,y=Y,method=method,na_rm = na_rm, h = h,...) +} + +test_that("Test error throwing",{ + # Error cases + expect_error(growth_rate(x=1:3,y=1:4), + "`x` and `y` must have the same length.") + expect_error(growth_rate(x=1:20,y=1:20,x0=21), + "`x0` must be a subset of `x`.") + # Fails only when method = `"trend_filter"` + expect_error(gr(method = "trend_filter",cv=FALSE,df=1.5), + "If `cv = FALSE`, then `df` must be an integer.") +}) + +test_that("Test throwing of warning of duplicates",{ + # The warning that is prompted is as follows: + # "`x` contains duplicate values. (If being run on a column in an `epi_df`, + # did you group by relevant key variables?)" + # Note that putting it in the regexp of expect_warning doesn't seem to work + jhu_csse_daily_subset %>% + mutate(cases_gr = growth_rate(x = time_value, y = cases, dup_rm=TRUE)) %>% + expect_warning() %>% + expect_error() +}) + +test_that("Simple example of growth rate that produces desired results",{ + expect_equal(growth_rate(x=1:20,y=2^(1:20),h=1), c(rep(1,19),NaN)) +}) + +test_that("log_scale works",{ + expect_equal(growth_rate(x=1:20,y=exp(1:20),h=5, + method="linear_reg",log_scale = TRUE), + rep(1,20)) +}) + +test_that("Running different methods with NA removal won't fail",{ + for (m in methods) expect_false(NA %in% gr(method = m,x0=1:5)) +}) + +test_that("na_rm works and is necessary when there are NA's",{ + expect_false(NA %in% gr()) + expect_equal(length(gr()),20) + expect_equal(gr(na_rm = FALSE), + # 1+NA gives an NA classified as a numeric + rep(1+NA,23)) + expect_equal(gr(h=1), c(rep(1,19),NaN)) + expect_error(gr(method = "smooth_spline")) +})