Skip to content

Update f documentation in epi_slide #144

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Jul 16, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -8,3 +8,5 @@
^data-raw$
^_pkgdown\.yml$
^pkgdown$
^doc$
^Meta$
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,6 @@
*.Rproj
inst/doc
docs
/doc/
/Meta/
*.DS_Store
3 changes: 1 addition & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

S3method("[",epi_df)
S3method(arrange,epi_df)
S3method(as_epi_df,data.frame)
S3method(as_epi_df,epi_df)
Expand Down Expand Up @@ -79,5 +80,3 @@ importFrom(tidyr,unnest)
importFrom(tidyselect,eval_select)
importFrom(tidyselect,starts_with)
importFrom(tsibble,as_tsibble)
importFrom(utils,head)
importFrom(utils,tail)
7 changes: 1 addition & 6 deletions R/methods-epi_df.R
Original file line number Diff line number Diff line change
Expand Up @@ -99,19 +99,14 @@ summary.epi_df = function(object, ...) {

cn <- names(res)
nr <- vctrs::vec_size(x)
not_epi_df <- (!("time_value" %in% cn) || !("geo_value" %in% cn)
|| vctrs::vec_size(res) > nr || any(i > nr))
not_epi_df <- (!("time_value" %in% cn) || !("geo_value" %in% cn) || vctrs::vec_size(res) > nr || any(i > nr))

if (not_epi_df) return(tibble::as_tibble(res))

# Case when i is numeric and there are duplicate values in it
if (is.numeric(i) && vctrs::vec_duplicate_any(i) > 0)
return(tibble::as_tibble(res))

# Column subsetting only, then return res as tibble
if (rlang::is_null(i) && !rlang::is_null(j))
return(tibble::as_tibble(res))

att_x = attr(x, "metadata")
new_epi_df(tibble::as_tibble(res),
geo_type = att_x$geo_type,
Expand Down
33 changes: 8 additions & 25 deletions R/slide.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,14 @@
#' @param f Function or formula to slide over variables in `x`. To "slide" means
#' to apply a function or formula over a running window of `n` time steps
#' (where one time step is typically one day or one week; see details for more
#' explanation). If a function, `f` must take `x`, a data frame with the same
#' column names as the original object; followed by any number of named
#' arguments; and ending with `...`. If a formula, `f` can operate directly on
#' columns accessed via `.x$var`, as in `~ mean(.x$var)` to compute a mean of
#' a column `var` over a sliding window of `n` time steps.
#' explanation). If a function, `f` should take `x`, an `epi_df` with the same
#' names as the non-grouping columns, followed by `g` to refer to the one row
#' tibble with one column per grouping variable that identifies the group,
#' and any number of named arguments (which will be taken from `...`). If a
#' formula, `f` can operate directly on columns accessed via `.x$var`, as
#' in `~ mean(.x$var)` to compute a mean of a column var over a sliding
#' window of n time steps. As well, `.y` may be used in the formula to refer
#' to the groupings that would be described by `g` if `f` was a function.
#' @param ... Additional arguments to pass to the function or formula specified
#' via `f`. Alternatively, if `f` is missing, then the current argument is
#' interpreted as an expression for tidy evaluation. See details.
Expand Down Expand Up @@ -85,26 +88,6 @@
#' inferred from the given expression and overrides any name passed explicitly
#' through the `new_col_name` argument.
#'
#' When `f` is a named function with arguments, if a tibble with an unnamed
#' grouping variable is passed in as the method argument to `f`, include a
#' parameter for the grouping-variable in `function()` just prior to
#' specifying the method to prevent that from being overridden. For example:
#' ```
#' # Construct an tibble with an unnamed grouping variable
#' edf = bind_rows(tibble(geo_value = "ak", time_value = as.Date("2020-01-01")
#' + 1:10, x1=1:10, y=1:10 + rnorm(10L))) %>%
#' as_epi_df()
#'
#' # Now, include a row parameter for the grouping variable in the tibble,
#' # which we denote as g, just prior to method = "qr"
#' # Note that if g was not included below, then the method = "qr" would be
#' # overridden, as described above
#' edf %>%
#' group_by(geo_value) %>%
#' epi_slide(function(x, g, method="qr", ...) tibble(model=list(
#' lm(y ~ x1, x, method=method))), n=7L)
#' ```
#'
#' @importFrom lubridate days weeks
#' @importFrom rlang .data .env !! enquo enquos sym
#' @export
Expand Down
33 changes: 8 additions & 25 deletions man/epi_slide.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions tests/testthat/test-epi_slide.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,8 +27,8 @@ test_that("`ref_time_values` + `align` that have some slide data, but generate t
test_that("these doesn't produce an error; the error appears only if the ref time values are out of the range for every group", {
expect_identical(edf %>% group_by(geo_value) %>% epi_slide(f, n=3L, ref_time_values=as.Date("2020-01-01")+200L) %>%
dplyr::select("geo_value","slide_value_value"),
dplyr::tibble(geo_value = "ak", slide_value_value = 199) %>% group_by(geo_value)) # out of range for one group
dplyr::tibble(geo_value = "ak", slide_value_value = 199)) # out of range for one group
expect_identical(edf %>% group_by(geo_value) %>% epi_slide(f, n=3L, ref_time_values=as.Date("2020-01-04")) %>%
dplyr::select("geo_value","slide_value_value"),
dplyr::tibble(geo_value = c("ak", "al"), slide_value_value = c(2, -2)) %>% group_by(geo_value)) # not out of range for either group
dplyr::tibble(geo_value = c("ak", "al"), slide_value_value = c(2, -2))) # not out of range for either group
})
Binary file renamed .DS_Store → vignettes/.DS_Store
Binary file not shown.