From 630655875edda18f1ac287b14948ddd8a6e81301 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 21 Jul 2022 18:02:41 -0700 Subject: [PATCH 01/15] Added a few more tests. --- tests/testthat/km-test-growth_rate.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 tests/testthat/km-test-growth_rate.R diff --git a/tests/testthat/km-test-growth_rate.R b/tests/testthat/km-test-growth_rate.R new file mode 100644 index 00000000..50972eb4 --- /dev/null +++ b/tests/testthat/km-test-growth_rate.R @@ -0,0 +1,15 @@ +library(dplyr) + +x <- jhu_csse_daily_subset %>% + select(-case_rate_7d_av,-death_rate_7d_av, -cases_7d_av) %>% + group_by(geo_value) %>% + mutate(cases_gr = growth_rate(x = time_value, y = cases)) + +test_that("`x` and `y` must be the same lengths",{ + expect_error(growth_rate(x=1:3,y=1:4)) +}) + +test_that("`x0` must be a subset of `x`",{ + expect_error(growth_rate(x=1:20,y=1:20,x0=21)) + expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) +}) \ No newline at end of file From 6b9ae457453b1ee7908eb8d8105690abffad421a Mon Sep 17 00:00:00 2001 From: kenmawer Date: Mon, 8 Aug 2022 15:47:59 -0700 Subject: [PATCH 02/15] Renamed file. --- tests/testthat/{km-test-growth_rate.R => test-growth_rate.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{km-test-growth_rate.R => test-growth_rate.R} (100%) diff --git a/tests/testthat/km-test-growth_rate.R b/tests/testthat/test-growth_rate.R similarity index 100% rename from tests/testthat/km-test-growth_rate.R rename to tests/testthat/test-growth_rate.R From 4ce0fcd9be3898bfbcb7a66c032e8d59da99b487 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Mon, 8 Aug 2022 16:27:12 -0700 Subject: [PATCH 03/15] I can't seem to figure out how to get the warning thrown. Setting x and y as c(1,1:19), for example, won't work. --- tests/testthat/test-growth_rate.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 50972eb4..9da14871 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -5,11 +5,10 @@ x <- jhu_csse_daily_subset %>% group_by(geo_value) %>% mutate(cases_gr = growth_rate(x = time_value, y = cases)) -test_that("`x` and `y` must be the same lengths",{ - expect_error(growth_rate(x=1:3,y=1:4)) -}) - -test_that("`x0` must be a subset of `x`",{ - expect_error(growth_rate(x=1:20,y=1:20,x0=21)) +test_that("Test error throwing",{ + 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`.") expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) }) \ No newline at end of file From 741ecd221e197d59e1a07674640eeea4729d6b94 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 10 Aug 2022 16:16:46 -0700 Subject: [PATCH 04/15] Added newline. --- tests/testthat/test-growth_rate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 9da14871..6b4f056a 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -11,4 +11,4 @@ test_that("Test error throwing",{ expect_error(growth_rate(x=1:20,y=1:20,x0=21), "`x0` must be a subset of `x`.") expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) -}) \ No newline at end of file +}) From 58cafd8ce623ebd5ece1abe42dd8d5b6a4a7c0f8 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 10 Aug 2022 18:42:48 -0700 Subject: [PATCH 05/15] Added another test. --- tests/testthat/test-growth_rate.R | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 6b4f056a..7f57fcc0 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -1,14 +1,21 @@ library(dplyr) -x <- jhu_csse_daily_subset %>% - select(-case_rate_7d_av,-death_rate_7d_av, -cases_7d_av) %>% - group_by(geo_value) %>% - mutate(cases_gr = growth_rate(x = time_value, y = cases)) - 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`.") + + # This should produce no error expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) + + # 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() }) From 8b82d9db1e4c03dfa2de5f987957609d4f314816 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 11 Aug 2022 12:49:05 -0700 Subject: [PATCH 06/15] Addded updated documentation, as well as tests on methods (still unfinished). Also noted that `rel_change` is the default method for estimation. --- DESCRIPTION | 2 +- R/growth_rate.R | 3 ++- man/as_epi_archive.Rd | 12 +++++++---- man/as_epi_df.Rd | 10 ++++----- man/epi_archive.Rd | 36 +++++++++++++++---------------- man/epi_slide.Rd | 12 +++++++---- man/epix_as_of.Rd | 12 +++++++---- man/epix_merge.Rd | 12 +++++++---- man/epix_slide.Rd | 12 +++++++---- man/growth_rate.Rd | 3 ++- tests/testthat/test-growth_rate.R | 21 +++++++++++++++++- 11 files changed, 88 insertions(+), 47 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 00b78130..18a3bdfb 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,7 +56,7 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 Depends: R (>= 2.10) URL: https://cmu-delphi.github.io/epiprocess/ diff --git a/R/growth_rate.R b/R/growth_rate.R index d3ca9e31..e96a27f0 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 method 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`. diff --git a/man/as_epi_archive.Rd b/man/as_epi_archive.Rd index f8f0e99e..4fb7c1eb 100644 --- a/man/as_epi_archive.Rd +++ b/man/as_epi_archive.Rd @@ -42,11 +42,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 5d1b1335..b5df1302 100644 --- a/man/as_epi_df.Rd +++ b/man/as_epi_df.Rd @@ -51,9 +51,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} @@ -61,14 +61,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 c4dc796c..84ac9406 100644 --- a/man/epi_archive.Rd +++ b/man/epi_archive.Rd @@ -100,17 +100,17 @@ 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-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-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}{ @@ -151,8 +151,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{
}} @@ -160,8 +160,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{epix_as_of()} for details. @@ -171,8 +171,8 @@ See the documentation for the wrapper function \code{epix_as_of()} for details. } \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{data.table} with the current one, and allows for a post-filling of \code{NA} values by last observation carried forward (LOCF). @@ -183,8 +183,8 @@ See the documentation for the wrapper function \code{epix_merge()} for details. } \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{epix_as_of()} for @@ -206,8 +206,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 9e80fff9..9c8c2102 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 658e7169..b5d5969c 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_merge.Rd b/man/epix_merge.Rd index 781ef6fe..3d1b2e1c 100644 --- a/man/epix_merge.Rd +++ b/man/epix_merge.Rd @@ -35,11 +35,15 @@ examples. } \details{ This is simply a wrapper around the \code{merge()} method of the -\code{epi_archive} class, so if \code{x} and \code{y} are an \code{epi_archive} objects, then:\preformatted{epix_merge(x, y) -} +\code{epi_archive} class, so if \code{x} and \code{y} are an \code{epi_archive} objects, then: -is equivalent to:\preformatted{x$merge(y) -} +\if{html}{\out{
}}\preformatted{epix_merge(x, y) +}\if{html}{\out{
}} + +is equivalent to: + +\if{html}{\out{
}}\preformatted{x$merge(y) +}\if{html}{\out{
}} } \examples{ # create two example epi_archive datasets diff --git a/man/epix_slide.Rd b/man/epix_slide.Rd index f01a0a71..b6f7a323 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 index 7f57fcc0..e9d9a683 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -9,7 +9,9 @@ test_that("Test error throwing",{ # This should produce no error expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) - +}) + +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?)" @@ -19,3 +21,20 @@ test_that("Test error throwing",{ expect_warning() %>% expect_error() }) + +test_that("Simple example of growth rate produces desired results",{ + expect_equal(growth_rate(x=1:20,y=2^(1:20),h=1), + c(rep(1,19),NaN)) +}) + +# Test each of the methods, log_scale settings, and na_rm settings +growth_rate(x=1:20,y=2^(1:20),method="rel_change",h=1) +growth_rate(x=1:20,y=2^(1:20),method="linear_reg",h=1) +growth_rate(x=1:20,y=2^(1:20),method="smooth_spline",h=1) +growth_rate(x=1:20,y=2^(1:20),method="trend_filter",h=1) + +growth_rate(x=1:20,y=sin(1:20)+1:20,h=4) +growth_rate(x=1:20,y=sin(1:20)+1:20,method="rel_change",h=4) +growth_rate(x=1:20,y=sin(1:20)+1:20,method="linear_reg",h=4) +growth_rate(x=1:20,y=sin(1:20)+1:20,method="smooth_spline",h=4) +growth_rate(x=1:20,y=sin(1:20)+1:20,method="trend_filter",h=4) From 6850a9af5e690c87fcb4c5012f26b1d2d3308f8b Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 11 Aug 2022 13:43:57 -0700 Subject: [PATCH 07/15] Added more tests. --- tests/testthat/test-growth_rate.R | 38 +++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index e9d9a683..a683ade6 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -28,13 +28,31 @@ test_that("Simple example of growth rate produces desired results",{ }) # Test each of the methods, log_scale settings, and na_rm settings -growth_rate(x=1:20,y=2^(1:20),method="rel_change",h=1) -growth_rate(x=1:20,y=2^(1:20),method="linear_reg",h=1) -growth_rate(x=1:20,y=2^(1:20),method="smooth_spline",h=1) -growth_rate(x=1:20,y=2^(1:20),method="trend_filter",h=1) - -growth_rate(x=1:20,y=sin(1:20)+1:20,h=4) -growth_rate(x=1:20,y=sin(1:20)+1:20,method="rel_change",h=4) -growth_rate(x=1:20,y=sin(1:20)+1:20,method="linear_reg",h=4) -growth_rate(x=1:20,y=sin(1:20)+1:20,method="smooth_spline",h=4) -growth_rate(x=1:20,y=sin(1:20)+1:20,method="trend_filter",h=4) + +test_that("Running different methods won't fail",{ + expect_error( + for (m in c("rel_change","linear_reg","smooth_spline","trend_filter")) { + growth_rate(x=1:25,y=sin(0:24)+0:24+1,method=m,h=3) + }, + NA + ) +}) + +test_that("When using trend_filter, if `cv=FALSE`, then df must be an integer",{ + expect_error(growth_rate(x=1:25,y=sin(0:24)+0:24+1,method="trend_filter", + cv=FALSE,df=1.5,h=3), + "If `cv = FALSE`, then `df` must be an integer.") +}) + +growth_rate(x=1:20,y=exp(1:20),h=5,method="linear_reg",log_scale = TRUE) + +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("na_rm works",{ + X <- c(1:10,NA,12:19,NA) + Y <- c(1:9,NA,NA,12:20) + growth_rate(x=X,y=Y,na_rm = TRUE) +}) From 46690de4b1893fc6ec1951f944c08d2d6ea8fea1 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 11 Aug 2022 13:50:40 -0700 Subject: [PATCH 08/15] Fixed na_rm method in `growth_rate` that I believed was wrong as it failed to properly eliminate NA's. --- R/growth_rate.R | 2 +- tests/testthat/test-growth_rate.R | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/growth_rate.R b/R/growth_rate.R index e96a27f0..bee9ddaf 100644 --- a/R/growth_rate.R +++ b/R/growth_rate.R @@ -146,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/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index a683ade6..f2c5ce95 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -27,8 +27,6 @@ test_that("Simple example of growth rate produces desired results",{ c(rep(1,19),NaN)) }) -# Test each of the methods, log_scale settings, and na_rm settings - test_that("Running different methods won't fail",{ expect_error( for (m in c("rel_change","linear_reg","smooth_spline","trend_filter")) { @@ -54,5 +52,9 @@ test_that("log_scale works",{ test_that("na_rm works",{ X <- c(1:10,NA,12:19,NA) Y <- c(1:9,NA,NA,12:20) - growth_rate(x=X,y=Y,na_rm = TRUE) + + expect_false(NA %in% growth_rate(x=X,y=Y,na_rm = TRUE)) + expect_equal(growth_rate(x=X,y=Y,na_rm = FALSE), + # 1+NA gives an NA classified as a numeric + rep(1+NA,20)) }) From fda2e1aac74b9df1a54fd3066abc7df08b7ed93a Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 11 Aug 2022 13:51:46 -0700 Subject: [PATCH 09/15] Added another test to see what happens when NA's are removed. --- tests/testthat/test-growth_rate.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index f2c5ce95..d296a8ec 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -54,6 +54,7 @@ test_that("na_rm works",{ Y <- c(1:9,NA,NA,12:20) expect_false(NA %in% growth_rate(x=X,y=Y,na_rm = TRUE)) + expect_equal(length(growth_rate(x=X,y=Y,na_rm = TRUE)),17) expect_equal(growth_rate(x=X,y=Y,na_rm = FALSE), # 1+NA gives an NA classified as a numeric rep(1+NA,20)) From 2556d5577753d006171374276af9f8e01e059fc7 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Thu, 11 Aug 2022 14:38:51 -0700 Subject: [PATCH 10/15] Doing snapshot creates a new snap file, which I just don't want to happen... --- tests/testthat/test-growth_rate.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index d296a8ec..7a0bfdd3 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -22,7 +22,7 @@ test_that("Test throwing of warning of duplicates",{ expect_error() }) -test_that("Simple example of growth rate produces desired results",{ +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)) }) @@ -31,9 +31,7 @@ test_that("Running different methods won't fail",{ expect_error( for (m in c("rel_change","linear_reg","smooth_spline","trend_filter")) { growth_rate(x=1:25,y=sin(0:24)+0:24+1,method=m,h=3) - }, - NA - ) + }, NA) }) test_that("When using trend_filter, if `cv=FALSE`, then df must be an integer",{ @@ -42,8 +40,6 @@ test_that("When using trend_filter, if `cv=FALSE`, then df must be an integer",{ "If `cv = FALSE`, then `df` must be an integer.") }) -growth_rate(x=1:20,y=exp(1:20),h=5,method="linear_reg",log_scale = TRUE) - 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)) From 7141537df622212354197c44855400105129da93 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 17 Aug 2022 11:06:31 -0700 Subject: [PATCH 11/15] Made changes. --- R/growth_rate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/growth_rate.R b/R/growth_rate.R index bee9ddaf..568e7c4d 100644 --- a/R/growth_rate.R +++ b/R/growth_rate.R @@ -45,7 +45,7 @@ #' 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. This is the -#' default method if `method` is not specified. +#' 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`. @@ -146,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] } From 1c26f37c83e3e4518bfeaab121c3e2c2542c2136 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 17 Aug 2022 13:40:35 -0700 Subject: [PATCH 12/15] Added another example to test for na_rm. --- tests/testthat/test-growth_rate.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 7a0bfdd3..52a5e0e0 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -46,12 +46,14 @@ test_that("log_scale works",{ }) test_that("na_rm works",{ - X <- c(1:10,NA,12:19,NA) - Y <- c(1:9,NA,NA,12:20) + X <- c(1:10,NA,10:20,NA) + Y <- c(2^(1:9),NA,NA,2^(10:21)) expect_false(NA %in% growth_rate(x=X,y=Y,na_rm = TRUE)) - expect_equal(length(growth_rate(x=X,y=Y,na_rm = TRUE)),17) + expect_equal(length(growth_rate(x=X,y=Y,na_rm = TRUE)),20) expect_equal(growth_rate(x=X,y=Y,na_rm = FALSE), # 1+NA gives an NA classified as a numeric - rep(1+NA,20)) + rep(1+NA,23)) + expect_equal(growth_rate(x=X,y=Y,h=1,na_rm = TRUE), + c(rep(1,19),NaN)) }) From b65ab18711719278b1844ad7eb1ca817f8942e07 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 17 Aug 2022 14:58:40 -0700 Subject: [PATCH 13/15] Good commit --- tests/testthat/test-growth_rate.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 52a5e0e0..6df0a0bd 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -1,5 +1,14 @@ 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(m = "rel_change",...) { + growth_rate(x=X,y=Y,method=m,h=3,...) +} + test_that("Test error throwing",{ # Error cases expect_error(growth_rate(x=1:3,y=1:4), @@ -29,7 +38,7 @@ test_that("Simple example of growth rate that produces desired results",{ test_that("Running different methods won't fail",{ expect_error( - for (m in c("rel_change","linear_reg","smooth_spline","trend_filter")) { + for (m in methods) { growth_rate(x=1:25,y=sin(0:24)+0:24+1,method=m,h=3) }, NA) }) @@ -45,10 +54,7 @@ test_that("log_scale works",{ rep(1,20)) }) -test_that("na_rm works",{ - X <- c(1:10,NA,10:20,NA) - Y <- c(2^(1:9),NA,NA,2^(10:21)) - +test_that("na_rm works as is necessary when there are NA's",{ expect_false(NA %in% growth_rate(x=X,y=Y,na_rm = TRUE)) expect_equal(length(growth_rate(x=X,y=Y,na_rm = TRUE)),20) expect_equal(growth_rate(x=X,y=Y,na_rm = FALSE), From c9737781e1b4c037ab44966e69032564783d1cdb Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 17 Aug 2022 15:23:18 -0700 Subject: [PATCH 14/15] Added growth_rate test. --- tests/testthat/test-growth_rate.R | 47 +++++++++++++------------------ 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 6df0a0bd..877869eb 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -5,8 +5,8 @@ Y <- c(2^(1:9),NA,NA,2^(10:21)) methods <- c("rel_change","linear_reg","smooth_spline","trend_filter") -gr <- function(m = "rel_change",...) { - growth_rate(x=X,y=Y,method=m,h=3,...) +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",{ @@ -15,9 +15,9 @@ test_that("Test error throwing",{ "`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`.") - - # This should produce no error - expect_error(growth_rate(x=1:20,y=1:20,x0=c(1,3)),NA) + # 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",{ @@ -32,34 +32,27 @@ test_that("Test throwing of warning of duplicates",{ }) 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("Running different methods won't fail",{ - expect_error( - for (m in methods) { - growth_rate(x=1:25,y=sin(0:24)+0:24+1,method=m,h=3) - }, NA) -}) - -test_that("When using trend_filter, if `cv=FALSE`, then df must be an integer",{ - expect_error(growth_rate(x=1:25,y=sin(0:24)+0:24+1,method="trend_filter", - cv=FALSE,df=1.5,h=3), - "If `cv = FALSE`, then `df` must be an integer.") + 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), + expect_equal(growth_rate(x=1:20,y=exp(1:20),h=5, + method="linear_reg",log_scale = TRUE), rep(1,20)) }) -test_that("na_rm works as is necessary when there are NA's",{ - expect_false(NA %in% growth_rate(x=X,y=Y,na_rm = TRUE)) - expect_equal(length(growth_rate(x=X,y=Y,na_rm = TRUE)),20) - expect_equal(growth_rate(x=X,y=Y,na_rm = FALSE), +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(growth_rate(x=X,y=Y,h=1,na_rm = TRUE), - c(rep(1,19),NaN)) + expect_equal(gr(h=1), c(rep(1,19),NaN)) + expect_error(gr(method = "smooth_spline")) }) From bc042136040678f633da8a27bb69d73d4ed0e564 Mon Sep 17 00:00:00 2001 From: kenmawer Date: Wed, 17 Aug 2022 15:39:54 -0700 Subject: [PATCH 15/15] Condensed a for loop. --- tests/testthat/test-growth_rate.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/tests/testthat/test-growth_rate.R b/tests/testthat/test-growth_rate.R index 877869eb..be1ed75d 100644 --- a/tests/testthat/test-growth_rate.R +++ b/tests/testthat/test-growth_rate.R @@ -42,9 +42,7 @@ test_that("log_scale works",{ }) 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)) - } + 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",{