Telkamp7/issue9

DESCRIPTION

@@ -19,21 +19,23 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Suggests: 
-    ggplot2,
     knitr,
     MASS,
     rmarkdown,
     testthat (>= 3.0.0),
-    tidyr,
     zoo
 Config/testthat/edition: 3
 Imports: 
+    ggplot2,
     checkmate,
     dplyr,
     lifecycle,
     magrittr,
     purrr,
     stats,
-    tibble
+    tibble,
+    tidyr,
+    utils,
+    rlang
 URL: https://ssi-dk.github.io/aeddo/
 VignetteBuilder: knitr

NAMESPACE

@@ -1,8 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(autoplot,aeddo)
+S3method(plot,aeddo)
 export("%>%")
 export(aeddo)
+export(autoplot)
 export(nll_poisson_gamma)
+importFrom(ggplot2,autoplot)
+importFrom(graphics,plot)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
+importFrom(rlang,.data)
 importFrom(tibble,tibble)

R/aeddo.R

@@ -41,27 +41,40 @@
 #' @export
 #'
 #' @examples
-#' # TODO: #1 Create an example using MASS::deaths. @telkamp7
-#' # Sample time series data
-#' data <- data.frame(
-#'   time = 1:10,
-#'   y = c(10, 15, 20, 30, 50, 100, 200, 40, 20, 10),
-#'   n = c(100, 150, 200, 300, 500, 1000, 2000, 400, 200, 100)
+#' # Create an example aedseo_tsd object
+#' aeddo_data <- data.frame(
+#'   time = as.Date(c(
+#'     "2023-01-01",
+#'     "2023-01-02",
+#'     "2023-01-03",
+#'     "2023-01-04",
+#'     "2023-01-05",
+#'     "2023-01-06"
+#'   )),
+#'   y = c(100, 120, 180, 110, 130, 140),
+#'   n = 1
 #' )
-#' # Define formula for modeling
-#' formula <- y ~ 1
-#' # Detect outbreaks
+#'
+#' # Supply a model formula
+#' fixed_effects_formula <- y ~ 1
+#'
+#' # Choose a size for the rolling window
+#' k = 2
+#' # ... and quantile for the threshold
+#' sig_level = 0.9
+#'
+#' # Employ the algorithm
 #' aeddo_results <- aeddo(
-#'   data = data,
-#'   formula = formula,
-#'   k = 5,
-#'   sig_level = 0.95,
+#'   data = aeddo_data,
+#'   formula = fixed_effects_formula,
+#'   k = k,
+#'   sig_level = sig_level,
 #'   exclude_past_outbreaks = TRUE,
-#'   init_theta = c(1, 1),
+#'   init_theta = c(1, 0),
 #'   lower = c(-Inf, 1e-6),
 #'   upper = c(Inf, 1e2),
 #'   method = "L-BFGS-B"
-#' )
+#'   )
 #' # Print the results
 #' print(aeddo_results)
 aeddo <- function(
@@ -74,7 +87,6 @@ aeddo <- function(
     lower = numeric(),
     upper = numeric(),
     method = "BFGS") {
-
   # Assert function inputs
   check_aeddo_inputs(
     data,
@@ -103,14 +115,16 @@ aeddo <- function(
       u_probability = numeric(),
       outbreak_alarm = logical()
     ),
-    class = "aeddo"
+    class = "aeddo",
+    data = data,
+    k = k
   )
 
   # Initilize past_outbreaks if we want to omit outbreak related observations
-  if(exclude_past_outbreaks == TRUE) {
+  if (exclude_past_outbreaks == TRUE) {
     past_outbreaks <- tibble::as_tibble(
       lapply(data, function(col) col[0])
-      )
+    )
   }
 
   # Loop over the observations to perform windowed estimation
@@ -124,8 +138,8 @@ aeddo <- function(
 
     # Exclude past observations, if they were deemed an outbreak
     # Turned on by 'excludePastOutbreaks = TRUE'
-    if(exclude_past_outbreaks == TRUE){
-      if(nrow(past_outbreaks) > 0){
+    if (exclude_past_outbreaks == TRUE) {
+      if (nrow(past_outbreaks) > 0) {
         window_data <- window_data %>%
           dplyr::setdiff(past_outbreaks)
       }
@@ -198,7 +212,7 @@ aeddo <- function(
         outbreak_alarm = outbreak_alarm
       )
 
-    if(exclude_past_outbreaks == TRUE & outbreak_alarm == TRUE){
+    if (exclude_past_outbreaks == TRUE && outbreak_alarm == TRUE) {
       past_outbreaks <- past_outbreaks %>%
         dplyr::bind_rows(reference_data)
     }

R/autoplot.R

@@ -0,0 +1,106 @@
+#' Create a complete 'ggplot' appropriate to a particular data type
+#'
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#'  This function generates a complete 'ggplot' object suitable for
+#'  visualizing time series data in an `aeddo` object. It creates a line
+#'  plot connecting the observations and adds points at each data point.
+#'
+#' @param object An `aeddo` object
+#' @param ... Additional arguments (not used).
+#'
+#' @return A 'ggplot' object for visualizing the time series data.
+#'
+#' @aliases autoplot
+#'
+#' @examples
+#' # Create an example aeddo object
+#' aeddo_data <- data.frame(
+#'   time = as.Date(c(
+#'     "2023-01-01",
+#'     "2023-01-02",
+#'     "2023-01-03",
+#'     "2023-01-04",
+#'     "2023-01-05",
+#'     "2023-01-06"
+#'   )),
+#'   y = c(100, 120, 180, 110, 130, 140),
+#'   n = 1
+#' )
+#'
+#' # Supply a model formula
+#' fixed_effects_formula <- y ~ 1
+#'
+#' # Choose a size for the rolling window
+#' k = 2
+#' # ... and quantile for the threshold
+#' sig_level = 0.9
+#'
+#' # Employ the algorithm
+#' aeddo_results <- aeddo(
+#'   data = aeddo_data,
+#'   formula = fixed_effects_formula,
+#'   k = k,
+#'   sig_level = sig_level,
+#'   exclude_past_outbreaks = TRUE,
+#'   init_theta = c(1, 0),
+#'   lower = c(-Inf, 1e-6),
+#'   upper = c(Inf, 1e2),
+#'   method = "L-BFGS-B"
+#'   )
+#'
+#' # Create a ggplot visualization for the aeddo object
+#' autoplot(aeddo_results)
+#' @importFrom ggplot2 autoplot
+#' @importFrom rlang .data
+#' @rdname autoplot
+#' @export
+autoplot <- function(object, ...) {
+  UseMethod("autoplot")
+}
+#' @rdname autoplot
+#' @method autoplot aeddo
+#' @export
+autoplot.aeddo <- function(object, ...) {
+  # Extract the supplied data
+  data <- attr(object, "data")
+  # ... and the window width
+  k <- attr(object, "k")
+
+  # Unnest the results
+  unnested_object_results <- object %>%
+    tidyr::unnest("reference_data")
+
+  # Join with original data, to visualize full series
+  joined_results <- data %>%
+    dplyr::full_join(
+      y = unnested_object_results,
+      by = dplyr::join_by("time", "y", "n")
+    )
+
+  # Extract the observations used for training
+  training_dates <- utils::head(data$time, k)
+
+  # Make a nice 'ggplot' visualization
+  suppressWarnings(
+    joined_results %>%
+      ggplot2::ggplot(
+        mapping = ggplot2::aes(
+          x = .data$time,
+          y = .data$y,
+          alpha = .data$outbreak_alarm
+        )
+      ) +
+      ggplot2::geom_point() +
+      ggplot2::annotate(
+        geom = "rect",
+        xmin = training_dates[1] - Inf,
+        xmax = training_dates[k],
+        ymin = -Inf,
+        ymax = Inf,
+        alpha = 0.2
+      ) +
+      ggplot2::guides(alpha = "none")
+  )
+}

R/internal.R

@@ -42,7 +42,8 @@ check_aeddo_inputs <- function(
   coll <- checkmate::makeAssertCollection()
 
   checkmate::assert_class(
-    data, classes = c("data.frame"),
+    data,
+    classes = c("data.frame"),
     null.ok = FALSE,
     add = coll
   )
@@ -120,7 +121,6 @@ check_aeddo_inputs <- function(
 #' @keywords internal
 #'
 #' @examples
-#'
 #' \dontrun{
 #' # This function is for internal use and is called within the
 #' # nll_poisson_gamma function. It is not intended to be called directly by
@@ -140,7 +140,8 @@ check_nll_poisson_gamma_inputs <- function(
     add = coll
   )
   checkmate::assert_class(
-    data, classes = c("data.frame"),
+    data,
+    classes = c("data.frame"),
     null.ok = FALSE,
     add = coll
   )

R/nll_poisson_gamma.R

@@ -41,7 +41,6 @@ nll_poisson_gamma <- function(
     theta,
     data,
     formula) {
-
   # Assert function inputs
   check_nll_poisson_gamma_inputs(
     theta,

R/plot.R

@@ -0,0 +1,63 @@
+#' Create a complete 'ggplot' appropriate to a particular data type
+#'
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#'  This function generates a complete 'ggplot' object suitable for
+#'  visualizing time series data in an `aeddo` object. It creates a line
+#'  plot connecting the observations and adds points at each data point.
+#'
+#' @param x An `aeddo` object
+#' @param ... Additional arguments (not used).
+#'
+#' @return A 'ggplot' object for visualizing the time series data.
+#'
+#' @aliases plot
+#'
+#' @seealso [autoplot()]
+#'
+#' @examples
+#' # Create an example aeddo object
+#' aeddo_data <- data.frame(
+#'   time = as.Date(c(
+#'     "2023-01-01",
+#'     "2023-01-02",
+#'     "2023-01-03",
+#'     "2023-01-04",
+#'     "2023-01-05",
+#'     "2023-01-06"
+#'   )),
+#'   y = c(100, 120, 180, 110, 130, 140),
+#'   n = 1
+#' )
+#'
+#' # Supply a model formula
+#' fixed_effects_formula <- y ~ 1
+#'
+#' # Choose a size for the rolling window
+#' k = 2
+#' # ... and quantile for the threshold
+#' sig_level = 0.9
+#'
+#' # Employ the algorithm
+#' aeddo_results <- aeddo(
+#'   data = aeddo_data,
+#'   formula = fixed_effects_formula,
+#'   k = k,
+#'   sig_level = sig_level,
+#'   exclude_past_outbreaks = TRUE,
+#'   init_theta = c(1, 0),
+#'   lower = c(-Inf, 1e-6),
+#'   upper = c(Inf, 1e2),
+#'   method = "L-BFGS-B"
+#'   )
+#'
+#' # Create a ggplot visualization for the aeddo object
+#' plot(aeddo_results)
+#' @importFrom graphics plot
+#' @rdname plot
+#' @method plot aeddo
+#' @export
+plot.aeddo <- function(x, ...) {
+  suppressWarnings(print(autoplot(x, ...)))
+}