Merge pull request #226 from dsweber2/formatting

Formatting

Author: dsweber2

.git-blame-ignore-revs

@@ -0,0 +1,3 @@
+# using styler at all
+aca7d5e7b66d8bac9d9fbcec3acdb98a087d58fa
+f12fcc2bf3fe0a75ba2b10eaaf8a1f1d22486a17

.github/workflows/styler.yml

@@ -0,0 +1,80 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    paths:
+      [
+        "**.[rR]",
+        "**.[qrR]md",
+        "**.[rR]markdown",
+        "**.[rR]nw",
+        "**.[rR]profile",
+      ]
+
+name: Style
+
+jobs:
+  style:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v3
+        with:
+          fetch-depth: 0
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::styler, any::roxygen2
+          needs: styler
+
+      - name: Enable styler cache
+        run: styler::cache_activate()
+        shell: Rscript {0}
+
+      - name: Determine cache location
+        id: styler-location
+        run: |
+          cat(
+            "location=",
+            styler::cache_info(format = "tabular")$location,
+            "\n",
+            file = Sys.getenv("GITHUB_OUTPUT"),
+            append = TRUE,
+            sep = ""
+          )
+        shell: Rscript {0}
+
+      - name: Cache styler
+        uses: actions/cache@v3
+        with:
+          path: ${{ steps.styler-location.outputs.location }}
+          key: ${{ runner.os }}-styler-${{ github.sha }}
+          restore-keys: |
+            ${{ runner.os }}-styler-
+            ${{ runner.os }}-
+
+      - name: Style
+        run: styler::style_pkg()
+        shell: Rscript {0}
+
+      - name: Commit and push changes
+        run: |
+          if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \
+              | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$'))
+          then
+            git config --local user.name "$GITHUB_ACTOR"
+            git config --local user.email "[email protected]"
+            git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)"
+            git pull --ff-only
+            git push origin
+          else
+            echo "No changes to commit."
+          fi

R/arx_classifier.R

@@ -47,9 +47,9 @@ arx_classifier <- function(
     predictors,
     trainer = parsnip::logistic_reg(),
     args_list = arx_class_args_list()) {
-
-  if (!is_classification(trainer))
+  if (!is_classification(trainer)) {
     cli::cli_abort("`trainer` must be a {.pkg parsnip} model of mode 'classification'.")
+  }
 
   wf <- arx_class_epi_workflow(
     epi_data, outcome, predictors, trainer, args_list
@@ -65,13 +65,15 @@ arx_classifier <- function(
     tibble::as_tibble() %>%
     dplyr::select(-time_value)
 
-  structure(list(
-    predictions = preds,
-    epi_workflow = wf,
-    metadata = list(
-      training = attr(epi_data, "metadata"),
-      forecast_created = Sys.time()
-    )),
+  structure(
+    list(
+      predictions = preds,
+      epi_workflow = wf,
+      metadata = list(
+        training = attr(epi_data, "metadata"),
+        forecast_created = Sys.time()
+      )
+    ),
     class = c("arx_class", "canned_epipred")
   )
 }
@@ -117,12 +119,13 @@ arx_class_epi_workflow <- function(
     predictors,
     trainer = NULL,
     args_list = arx_class_args_list()) {
-
   validate_forecaster_inputs(epi_data, outcome, predictors)
-  if (!inherits(args_list, c("arx_class", "alist")))
+  if (!inherits(args_list, c("arx_class", "alist"))) {
     rlang::abort("args_list was not created using `arx_class_args_list().")
-  if (!(is.null(trainer) || is_classification(trainer)))
+  }
+  if (!(is.null(trainer) || is_classification(trainer))) {
     rlang::abort("`trainer` must be a `{parsnip}` model of mode 'classification'.")
+  }
   lags <- arx_lags_validator(predictors, args_list$lags)
 
   # --- preprocessor
@@ -172,8 +175,10 @@ arx_class_epi_workflow <- function(
   o2 <- rlang::sym(paste0("ahead_", args_list$ahead, "_", o))
   r <- r %>%
     step_epi_ahead(!!o, ahead = args_list$ahead, role = "pre-outcome") %>%
-    step_mutate(outcome_class = cut(!!o2, breaks = args_list$breaks),
-                role = "outcome") %>%
+    step_mutate(
+      outcome_class = cut(!!o2, breaks = args_list$breaks),
+      role = "outcome"
+    ) %>%
     step_epi_naomit() %>%
     step_training_window(n_recent = args_list$n_training)
 
@@ -245,9 +250,7 @@ arx_class_args_list <- function(
     method = c("rel_change", "linear_reg", "smooth_spline", "trend_filter"),
     log_scale = FALSE,
     additional_gr_args = list(),
-    nafill_buffer = Inf
-) {
-
+    nafill_buffer = Inf) {
   .lags <- lags
   if (is.list(lags)) lags <- unlist(lags)
   method <- match.arg(method)
@@ -266,7 +269,8 @@ arx_class_args_list <- function(
     cli::cli_abort(
       c("`additional_gr_args` must be a {.cls list}.",
         "!" = "This is a {.cls {class(additional_gr_args)}}.",
-        i = "See `?epiprocess::growth_rate` for available arguments.")
+        i = "See `?epiprocess::growth_rate` for available arguments."
+      )
     )
   }
 
@@ -277,19 +281,20 @@ arx_class_args_list <- function(
 
   max_lags <- max(lags)
   structure(
-    enlist(lags = .lags,
-           ahead,
-           n_training,
-           breaks,
-           forecast_date,
-           target_date,
-           outcome_transform,
-           max_lags,
-           horizon,
-           method,
-           log_scale,
-           additional_gr_args,
-           nafill_buffer
+    enlist(
+      lags = .lags,
+      ahead,
+      n_training,
+      breaks,
+      forecast_date,
+      target_date,
+      outcome_transform,
+      max_lags,
+      horizon,
+      method,
+      log_scale,
+      additional_gr_args,
+      nafill_buffer
     ),
     class = c("arx_class", "alist")
   )
@@ -300,4 +305,3 @@ print.arx_class <- function(x, ...) {
   name <- "ARX Classifier"
   NextMethod(name = name, ...)
 }
-

R/arx_forecaster.R

@@ -25,20 +25,24 @@
 #' jhu <- case_death_rate_subset %>%
 #'   dplyr::filter(time_value >= as.Date("2021-12-01"))
 #'
-#' out <- arx_forecaster(jhu, "death_rate",
-#'   c("case_rate", "death_rate"))
+#' out <- arx_forecaster(
+#'   jhu, "death_rate",
+#'   c("case_rate", "death_rate")
+#' )
 #'
 #' out <- arx_forecaster(jhu, "death_rate",
-#'   c("case_rate", "death_rate"), trainer = quantile_reg(),
-#'   args_list = arx_args_list(levels = 1:9 / 10))
+#'   c("case_rate", "death_rate"),
+#'   trainer = quantile_reg(),
+#'   args_list = arx_args_list(levels = 1:9 / 10)
+#' )
 arx_forecaster <- function(epi_data,
                            outcome,
                            predictors,
                            trainer = parsnip::linear_reg(),
                            args_list = arx_args_list()) {
-
-  if (!is_regression(trainer))
+  if (!is_regression(trainer)) {
     cli::cli_abort("`trainer` must be a {.pkg parsnip} model of mode 'regression'.")
+  }
 
   wf <- arx_fcast_epi_workflow(
     epi_data, outcome, predictors, trainer, args_list
@@ -54,13 +58,15 @@ arx_forecaster <- function(epi_data,
     tibble::as_tibble() %>%
     dplyr::select(-time_value)
 
-  structure(list(
-    predictions = preds,
-    epi_workflow = wf,
-    metadata = list(
-      training = attr(epi_data, "metadata"),
-      forecast_created = Sys.time()
-    )),
+  structure(
+    list(
+      predictions = preds,
+      epi_workflow = wf,
+      metadata = list(
+        training = attr(epi_data, "metadata"),
+        forecast_created = Sys.time()
+      )
+    ),
     class = c("arx_fcast", "canned_epipred")
   )
 }
@@ -85,25 +91,30 @@ arx_forecaster <- function(epi_data,
 #' jhu <- case_death_rate_subset %>%
 #'   dplyr::filter(time_value >= as.Date("2021-12-01"))
 #'
-#' arx_fcast_epi_workflow(jhu, "death_rate",
-#'   c("case_rate", "death_rate"))
+#' arx_fcast_epi_workflow(
+#'   jhu, "death_rate",
+#'   c("case_rate", "death_rate")
+#' )
 #'
 #' arx_fcast_epi_workflow(jhu, "death_rate",
-#'   c("case_rate", "death_rate"), trainer = quantile_reg(),
-#'   args_list = arx_args_list(levels = 1:9 / 10))
+#'   c("case_rate", "death_rate"),
+#'   trainer = quantile_reg(),
+#'   args_list = arx_args_list(levels = 1:9 / 10)
+#' )
 arx_fcast_epi_workflow <- function(
     epi_data,
     outcome,
     predictors,
     trainer = NULL,
     args_list = arx_args_list()) {
-
   # --- validation
   validate_forecaster_inputs(epi_data, outcome, predictors)
-  if (!inherits(args_list, c("arx_fcast", "alist")))
+  if (!inherits(args_list, c("arx_fcast", "alist"))) {
     cli::cli_abort("args_list was not created using `arx_args_list().")
-  if (!(is.null(trainer) || is_regression(trainer)))
+  }
+  if (!(is.null(trainer) || is_regression(trainer))) {
     cli::cli_abort("{trainer} must be a `{parsnip}` model of mode 'regression'.")
+  }
   lags <- arx_lags_validator(predictors, args_list$lags)
 
   # --- preprocessor
@@ -126,15 +137,17 @@ arx_fcast_epi_workflow <- function(
     # add all levels to the forecaster and update postprocessor
     tau <- sort(compare_quantile_args(
       args_list$levels,
-      rlang::eval_tidy(trainer$args$tau))
-    )
+      rlang::eval_tidy(trainer$args$tau)
+    ))
     args_list$levels <- tau
     trainer$args$tau <- rlang::enquo(tau)
     f <- layer_quantile_distn(f, levels = tau) %>% layer_point_from_distn()
   } else {
     f <- layer_residual_quantiles(
-      f, probs = args_list$levels, symmetrize = args_list$symmetrize,
-      by_key = args_list$quantile_by_key)
+      f,
+      probs = args_list$levels, symmetrize = args_list$symmetrize,
+      by_key = args_list$quantile_by_key
+    )
   }
   f <- layer_add_forecast_date(f, forecast_date = forecast_date) %>%
     layer_add_target_date(target_date = target_date)
@@ -204,7 +217,6 @@ arx_args_list <- function(
     nonneg = TRUE,
     quantile_by_key = character(0L),
     nafill_buffer = Inf) {
-
   # error checking if lags is a list
   .lags <- lags
   if (is.list(lags)) lags <- unlist(lags)
@@ -222,17 +234,19 @@ arx_args_list <- function(
 
   max_lags <- max(lags)
   structure(
-    enlist(lags = .lags,
-           ahead,
-           n_training,
-           levels,
-           forecast_date,
-           target_date,
-           symmetrize,
-           nonneg,
-           max_lags,
-           quantile_by_key,
-           nafill_buffer),
+    enlist(
+      lags = .lags,
+      ahead,
+      n_training,
+      levels,
+      forecast_date,
+      target_date,
+      symmetrize,
+      nonneg,
+      max_lags,
+      quantile_by_key,
+      nafill_buffer
+    ),
     class = c("arx_fcast", "alist")
   )
 }
@@ -248,16 +262,22 @@ compare_quantile_args <- function(alist, tlist) {
   default_alist <- eval(formals(arx_args_list)$levels)
   default_tlist <- eval(formals(quantile_reg)$tau)
   if (setequal(alist, default_alist)) {
-    if (setequal(tlist, default_tlist)) return(sort(unique(union(alist, tlist))))
-    else return(sort(unique(tlist)))
+    if (setequal(tlist, default_tlist)) {
+      return(sort(unique(union(alist, tlist))))
+    } else {
+      return(sort(unique(tlist)))
+    }
   } else {
-    if (setequal(tlist, default_tlist)) return(sort(unique(alist)))
-    else {
-      if (setequal(alist, tlist)) return(sort(unique(alist)))
+    if (setequal(tlist, default_tlist)) {
+      return(sort(unique(alist)))
+    } else {
+      if (setequal(alist, tlist)) {
+        return(sort(unique(alist)))
+      }
       rlang::abort(c(
         "You have specified different, non-default, quantiles in the trainier and `arx_args` options.",
-        i = "Please only specify quantiles in one location.")
-      )
+        i = "Please only specify quantiles in one location."
+      ))
     }
   }
 }