Skip to content
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

Telkamp7/issue24 #26

Merged
merged 6 commits into from
Nov 15, 2023
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
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ export(epi_calendar)
export(fit_growth_rate)
export(tsd)
importFrom(ggplot2,autoplot)
importFrom(grDevices,devAskNewPage)
importFrom(graphics,plot)
importFrom(lifecycle,deprecated)
importFrom(magrittr,"%>%")
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,5 @@


* Added a new function `epi_calendar()` that determines the epidemiological season based on a given date, allowing users to easily categorize dates within or outside specified seasons.

* Introduced additional visualizations in the `autoplot()` method, enhancing the capabilities of the `plot()` method with new displays of observed cases and growth rates.
70 changes: 56 additions & 14 deletions R/autoplot.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,11 @@
#'
#' @param object An `aedseo_tsd` or `aedseo` object
#' @param linewidth Numeric, the width of the line for the growth rate
#' @param alpha Numeric, the alpha (transparency) for the confidence interval
#' ribbon
#' @param size Numeric, size of observational points.
#' @param width Numeric, the width of the error bar employed to show the
#' confidence interval of the growth rate estimate.
#' @param alpha Numeric, the alpha (transparency) for the observations with a
#' significantly positive growth rate.
#' @param ... Additional arguments (not used).
#'
#' @return A 'ggplot' object for visualizing the time series data.
Expand Down Expand Up @@ -65,19 +68,58 @@ autoplot.aedseo_tsd <- function(object, ...) {
ggplot2::geom_point() +
ggplot2::geom_line()
}
#' @importFrom grDevices devAskNewPage
#' @rdname autoplot
#' @method autoplot aedseo
#' @export
autoplot.aedseo <- function(object, linewidth = 0.7, alpha = 0.3, ...) {
object %>%
ggplot2::ggplot(
mapping = ggplot2::aes(
x = .data$reference_time,
y = .data$growth_rate,
ymin = .data$lower_growth_rate,
ymax = .data$upper_growth_rate
)
) +
ggplot2::geom_line(linewidth = linewidth) +
ggplot2::geom_ribbon(alpha = alpha)
autoplot.aedseo <- function(
object,
linewidth = 0.7,
size = 2,
alpha = 0.3,
width = 0.2,
...) {
# Construct the observed cases plot
# NOTE: We use print to show plots sequentially
suppressWarnings(
print(
object %>%
ggplot2::ggplot(
mapping = ggplot2::aes(
x = .data$reference_time,
y = .data$observed
)
) +
ggplot2::geom_point(
mapping = ggplot2::aes(alpha = .data$seasonal_onset_alarm),
size = size
) +
ggplot2::geom_line(linewidth = linewidth)
)
)
# Set 'ask' for plotting device to TRUE
oask <- devAskNewPage(ask = TRUE)
# ... and clean-up on exit
on.exit(devAskNewPage(oask))
# ... and the growth rate plots
print(
object %>%
ggplot2::ggplot(
mapping = ggplot2::aes(
x = .data$reference_time,
y = .data$growth_rate,
ymin = .data$lower_growth_rate,
ymax = .data$upper_growth_rate
)
) +
ggplot2::geom_point(
mapping = ggplot2::aes(alpha = .data$growth_warning),
size = size
) +
ggplot2::geom_errorbar(
mapping = ggplot2::aes(alpha = .data$growth_warning),
width = width
) +
ggplot2::geom_hline(yintercept = 0, linetype = "dashed")
)
}
8 changes: 4 additions & 4 deletions R/epi_calendar.R
Original file line number Diff line number Diff line change
Expand Up @@ -34,11 +34,11 @@
#'
#' epi_calendar(as.Date("2023-12-01"), start = 40, end = 20)
#' # Expected output: "2023/2024"
epi_calendar <- function(date, start = 40, end = 20) {
epi_calendar <- Vectorize(function(date, start = 40, end = 20) {
# Compute the current week
current_week <- as.integer(format(x = date, "%V"))
current_week <- as.integer(format(x = date, "%U"))

if (current_week <= start && end <= current_week) {
if (current_week <= start & end <= current_week) {
return("out_of_season")
}

Expand All @@ -54,4 +54,4 @@ epi_calendar <- function(date, start = 40, end = 20) {
}

return(ans)
}
})
11 changes: 8 additions & 3 deletions man/autoplot.Rd

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