Skip to content

Commit fd2339d

Browse files
authored
Merge pull request #416 from cmu-delphi/ndefries/fix-timetype-week-trigger
Trigger week time_type even when date seq is incomplete
2 parents aecb7e5 + f3f16e3 commit fd2339d

File tree

7 files changed

+42
-18
lines changed

7 files changed

+42
-18
lines changed

DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: epiprocess
33
Title: Tools for basic signal processing in epidemiology
4-
Version: 0.7.4
4+
Version: 0.7.5
55
Authors@R: c(
66
person("Jacob", "Bien", role = "ctb"),
77
person("Logan", "Brooks", role = "aut"),

NEWS.md

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,10 +16,11 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.x.y will indicat
1616
- Minor documentation updates; PR #393
1717
- Improved `epi_archive` print method. Compactified metadata and shows a snippet
1818
of the underlying `DT` (#341).
19-
- Added `autoplot` method for `epi_df` objects, which creates a ggplot2 plot of
19+
- Added `autoplot` method for `epi_df` objects, which creates a `ggplot2` plot of
2020
the `epi_df` (#382).
2121
- Refactored internals to use `cli` for warnings/errors and `checkmate` for
2222
argument checking (#413).
23+
- Fix logic to auto-assign `ep_df` `time_type` to `week` (#416).
2324

2425
## Breaking changes
2526

R/autoplot.R

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,15 @@
3232
#' .color_by = "none",
3333
#' .facet_by = "geo_value"
3434
#' )
35-
#' autoplot(jhu_csse_daily_subset, case_rate_7d_av, .color_by = "none",
36-
#' .base_color = "red", .facet_by = "geo_value")
35+
#' autoplot(jhu_csse_daily_subset, case_rate_7d_av,
36+
#' .color_by = "none",
37+
#' .base_color = "red", .facet_by = "geo_value"
38+
#' )
3739
#'
3840
#' # .base_color specification won't have any effect due .color_by default
3941
#' autoplot(jhu_csse_daily_subset, case_rate_7d_av,
40-
#' .base_color = "red", .facet_by = "geo_value")
42+
#' .base_color = "red", .facet_by = "geo_value"
43+
#' )
4144
autoplot.epi_df <- function(
4245
object, ...,
4346
.color_by = c("all_keys", "geo_value", "other_keys", ".response", "all", "none"),
@@ -59,7 +62,8 @@ autoplot.epi_df <- function(
5962
allowed <- allowed[allowed]
6063
if (length(allowed) == 0 && rlang::dots_n(...) == 0L) {
6164
cli::cli_abort("No numeric variables were available to plot automatically.",
62-
class = "epiprocess__no_numeric_vars_available")
65+
class = "epiprocess__no_numeric_vars_available"
66+
)
6367
}
6468
vars <- tidyselect::eval_select(rlang::expr(c(...)), object)
6569
if (rlang::is_empty(vars)) { # find them automatically if unspecified
@@ -76,11 +80,13 @@ autoplot.epi_df <- function(
7680
class = "epiprocess__all_requested_vars_not_numeric"
7781
)
7882
} else if (!all(ok)) {
79-
cli::cli_warn(c(
80-
"Only the requested variables {.var {names(vars)[ok]}} are numeric.",
81-
i = "`autoplot()` cannot display {.var {names(vars)[!ok]}}."
82-
),
83-
class = "epiprocess__some_requested_vars_not_numeric")
83+
cli::cli_warn(
84+
c(
85+
"Only the requested variables {.var {names(vars)[ok]}} are numeric.",
86+
i = "`autoplot()` cannot display {.var {names(vars)[!ok]}}."
87+
),
88+
class = "epiprocess__some_requested_vars_not_numeric"
89+
)
8490
vars <- vars[ok]
8591
}
8692
}

R/epi_df.R

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -297,9 +297,11 @@ as_epi_df.epi_df <- function(x, ...) {
297297
#' @export
298298
as_epi_df.tbl_df <- function(x, geo_type, time_type, as_of,
299299
additional_metadata = list(), ...) {
300-
if (!test_subset(c("geo_value", "time_value"), names(x))) cli_abort(
301-
"Columns `geo_value` and `time_value` must be present in `x`."
302-
)
300+
if (!test_subset(c("geo_value", "time_value"), names(x))) {
301+
cli_abort(
302+
"Columns `geo_value` and `time_value` must be present in `x`."
303+
)
304+
}
303305

304306
new_epi_df(
305307
x, geo_type, time_type, as_of,

R/outliers.R

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -109,9 +109,11 @@ detect_outlr <- function(x = seq_along(y), y,
109109

110110
# Validate the output
111111
assert_data_frame(results)
112-
if (!test_subset(c("lower", "upper", "replacement"), colnames(results))) cli_abort(
113-
"Columns `lower`, `upper`, and `replacement` must be present in the output of the outlier detection method."
114-
)
112+
if (!test_subset(c("lower", "upper", "replacement"), colnames(results))) {
113+
cli_abort(
114+
"Columns `lower`, `upper`, and `replacement` must be present in the output of the outlier detection method."
115+
)
116+
}
115117

116118
# Update column names with model abbreviation
117119
colnames(results) <- paste(abbr, colnames(results), sep = "_")

R/utils.R

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -444,7 +444,13 @@ guess_time_type <- function(time_value) {
444444
return("day-time")
445445
} # Else, if a Date class, then use "week" or "day" depending on gaps
446446
else if (inherits(time_value, "Date")) {
447-
return(ifelse(all(diff(sort(time_value)) == 7), "week", "day"))
447+
# Convert to numeric so we can use the modulo operator.
448+
unique_time_gaps <- as.numeric(diff(sort(unique(time_value))))
449+
# We need to check the modulus of `unique_time_gaps` in case there are
450+
# missing dates. Gaps in a weekly date sequence will cause some diffs to
451+
# be larger than 7 days. If we just check if `diffs == 7`, it will fail
452+
# unless the weekly date sequence is already complete.
453+
return(ifelse(all(unique_time_gaps %% 7 == 0), "week", "day"))
448454
}
449455

450456
# Else, check whether it's one of the tsibble classes

tests/testthat/test-utils.R

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,13 @@ test_that("guess_time_type works for different types", {
8989
expect_equal(guess_time_type(not_ymd3), "custom")
9090
expect_equal(guess_time_type(not_a_date), "custom")
9191
})
92+
3
93+
test_that("guess_time_type works with gaps", {
94+
days_gaps <- as.Date("2022-01-01") + c(0, 1, 3, 4, 8, 8 + 7)
95+
weeks_gaps <- as.Date("2022-01-01") + 7 * c(0, 1, 3, 4, 8, 8 + 7)
96+
expect_equal(guess_time_type(days_gaps), "day")
97+
expect_equal(guess_time_type(weeks_gaps), "week")
98+
})
9299

93100
test_that("enlist works", {
94101
my_list <- enlist(x = 1, y = 2, z = 3)

0 commit comments

Comments
 (0)