run styler

Author: dajmcdon

R/cdc_baseline_forecaster.R

@@ -37,23 +37,23 @@
 #' preds <- pivot_quantiles_wider(cdc$predictions, .pred_distn)
 #'
 #' if (require(ggplot2)) {
-#' forecast_date <- unique(preds$forecast_date)
-#' four_states <- c("ca", "pa", "wa", "ny")
-#' preds %>%
-#'   filter(geo_value %in% four_states) %>%
-#'   ggplot(aes(target_date)) +
-#'   geom_ribbon(aes(ymin = `0.1`, ymax = `0.9`), fill = blues9[3]) +
-#'   geom_ribbon(aes(ymin = `0.25`, ymax = `0.75`), fill = blues9[6]) +
-#'   geom_line(aes(y = .pred), color = "orange") +
-#'   geom_line(
-#'     data = weekly_deaths %>% filter(geo_value %in% four_states),
-#'     aes(x = time_value, y = deaths)
-#'   ) +
-#'   scale_x_date(limits = c(forecast_date - 90, forecast_date + 30)) +
-#'   labs(x = "Date", y = "Weekly deaths") +
-#'   facet_wrap(~geo_value, scales = "free_y") +
-#'   theme_bw() +
-#'   geom_vline(xintercept = forecast_date)
+#'   forecast_date <- unique(preds$forecast_date)
+#'   four_states <- c("ca", "pa", "wa", "ny")
+#'   preds %>%
+#'     filter(geo_value %in% four_states) %>%
+#'     ggplot(aes(target_date)) +
+#'     geom_ribbon(aes(ymin = `0.1`, ymax = `0.9`), fill = blues9[3]) +
+#'     geom_ribbon(aes(ymin = `0.25`, ymax = `0.75`), fill = blues9[6]) +
+#'     geom_line(aes(y = .pred), color = "orange") +
+#'     geom_line(
+#'       data = weekly_deaths %>% filter(geo_value %in% four_states),
+#'       aes(x = time_value, y = deaths)
+#'     ) +
+#'     scale_x_date(limits = c(forecast_date - 90, forecast_date + 30)) +
+#'     labs(x = "Date", y = "Weekly deaths") +
+#'     facet_wrap(~geo_value, scales = "free_y") +
+#'     theme_bw() +
+#'     geom_vline(xintercept = forecast_date)
 #' }
 cdc_baseline_forecaster <- function(
     epi_data,
@@ -95,7 +95,7 @@ cdc_baseline_forecaster <- function(
     ) %>%
     layer_add_forecast_date(forecast_date = forecast_date) %>%
     layer_unnest(.pred_distn_all)
-    # layer_add_target_date(target_date = target_date)
+  # layer_add_target_date(target_date = target_date)
   if (args_list$nonneg) f <- layer_threshold(f, ".pred")
 
   eng <- parsnip::linear_reg() %>% parsnip::set_engine("flatline")
@@ -213,8 +213,7 @@ parse_period <- function(x) {
     if (length(x) == 1L) x <- as.numeric(x)
     if (length(x) == 2L) {
       mult <- substr(x[2], 1, 3)
-      mult <- switch(
-        mult,
+      mult <- switch(mult,
         day = 1L,
         wee = 7L,
         cli::cli_abort("incompatible timespan in `aheads`.")

R/epi_recipe.R

@@ -456,11 +456,11 @@ print.epi_recipe <- function(x, form_width = 30, ...) {
     cli::cli_h3("Operations")
   }
 
-  i = 1
+  i <- 1
   for (step in x$steps) {
     cat(paste0(i, ". "))
     print(step, form_width = form_width)
-    i = i + 1
+    i <- i + 1
   }
   cli::cli_end()
 
@@ -469,20 +469,20 @@ print.epi_recipe <- function(x, form_width = 30, ...) {
 
 # Currently only used in the workflow printing
 print_preprocessor_recipe <- function(x, ...) {
-
   recipe <- workflows::extract_preprocessor(x)
   steps <- recipe$steps
   n_steps <- length(steps)
   if (n_steps == 1L) {
     step <- "Step"
-  }
-  else {
+  } else {
     step <- "Steps"
   }
   n_steps_msg <- glue::glue("{n_steps} Recipe {step}")
   cat_line(n_steps_msg)
 
-  if (n_steps == 0L) return(invisible(x))
+  if (n_steps == 0L) {
+    return(invisible(x))
+  }
 
   cat_line("")
 
@@ -498,8 +498,7 @@ print_preprocessor_recipe <- function(x, ...) {
 
   if (extra_steps == 1L) {
     step <- "step"
-  }
-  else {
+  } else {
     step <- "steps"
   }
 
@@ -512,7 +511,6 @@ print_preprocessor_recipe <- function(x, ...) {
 }
 
 print_preprocessor <- function(x) {
-
   has_preprocessor_formula <- workflows:::has_preprocessor_formula(x)
   has_preprocessor_recipe <- workflows:::has_preprocessor_recipe(x)
   has_preprocessor_variables <- workflows:::has_preprocessor_variables(x)
@@ -532,7 +530,7 @@ print_preprocessor <- function(x) {
     workflows:::print_preprocessor_formula(x)
   }
   if (has_preprocessor_recipe) {
-      print_preprocessor_recipe(x)
+    print_preprocessor_recipe(x)
   }
   if (has_preprocessor_variables) {
     workflows:::print_preprocessor_variables(x)

R/epi_workflow.R

@@ -219,7 +219,7 @@ new_epi_workflow <- function(
 print.epi_workflow <- function(x, ...) {
   print_header(x)
   print_preprocessor(x)
-  #workflows:::print_case_weights(x)
+  # workflows:::print_case_weights(x)
   workflows:::print_model(x)
   print_postprocessor(x)
   invisible(x)

R/flusight_hub_formatter.R

@@ -1,7 +1,9 @@
 abbr_to_fips <- function(abbr) {
   fi <- dplyr::left_join(
     tibble::tibble(abbr = tolower(abbr)),
-    state_census, by = "abbr") %>%
+    state_census,
+    by = "abbr"
+  ) %>%
     dplyr::mutate(fips = as.character(fips), fips = case_when(
       fips == "0" ~ "US",
       nchar(fips) < 2L ~ paste0("0", fips),
@@ -118,14 +120,15 @@ flusight_hub_formatter.data.frame <- function(
   } else if (!is.na(has_ahead)) { # ahead present, not target date
     object <- object %>%
       dplyr::rename(horizon = !!names(object)[has_ahead]) %>%
-      dplyr::mutate(target_end_date =  horizon * pp + reference_date)
+      dplyr::mutate(target_end_date = horizon * pp + reference_date)
   } else { # target_date present, not ahead
     object <- object %>%
       dplyr::rename(target_end_date = target_date) %>%
       dplyr::mutate(horizon = as.integer((target_end_date - reference_date)) / pp)
   }
-  object %>% dplyr::relocate(
-    reference_date, horizon, target_end_date, location, output_type_id, value
-  ) %>%
+  object %>%
+    dplyr::relocate(
+      reference_date, horizon, target_end_date, location, output_type_id, value
+    ) %>%
     dplyr::mutate(!!!dots)
 }

R/frosting.R

@@ -294,11 +294,11 @@ print.frosting <- function(x, form_width = 30, ...) {
   cli::cli_h1("Frosting")
 
   if (!is.null(x$layers)) cli::cli_h3("Layers")
-  i = 1
-  for (layer in x$layers){
+  i <- 1
+  for (layer in x$layers) {
     cat(paste0(i, ". "))
     print(layer, form_width = form_width)
-    i = i + 1
+    i <- i + 1
   }
   cli::cli_end()
   invisible(x)

R/layer_cdc_flatline_quantiles.R

@@ -86,22 +86,22 @@
 #'   mutate(target_date = forecast_date + ahead)
 #'
 #' if (require("ggplot2")) {
-#' four_states <- c("ca", "pa", "wa", "ny")
-#' preds %>%
-#'   filter(geo_value %in% four_states) %>%
-#'   ggplot(aes(target_date)) +
-#'   geom_ribbon(aes(ymin = `0.1`, ymax = `0.9`), fill = blues9[3]) +
-#'   geom_ribbon(aes(ymin = `0.25`, ymax = `0.75`), fill = blues9[6]) +
-#'   geom_line(aes(y = .pred), color = "orange") +
-#'   geom_line(
-#'     data = case_death_rate_subset %>% filter(geo_value %in% four_states),
-#'     aes(x = time_value, y = death_rate)
-#'   ) +
-#'   scale_x_date(limits = c(forecast_date - 90, forecast_date + 30)) +
-#'   labs(x = "Date", y = "Death rate") +
-#'   facet_wrap(~geo_value, scales = "free_y") +
-#'   theme_bw() +
-#'   geom_vline(xintercept = forecast_date)
+#'   four_states <- c("ca", "pa", "wa", "ny")
+#'   preds %>%
+#'     filter(geo_value %in% four_states) %>%
+#'     ggplot(aes(target_date)) +
+#'     geom_ribbon(aes(ymin = `0.1`, ymax = `0.9`), fill = blues9[3]) +
+#'     geom_ribbon(aes(ymin = `0.25`, ymax = `0.75`), fill = blues9[6]) +
+#'     geom_line(aes(y = .pred), color = "orange") +
+#'     geom_line(
+#'       data = case_death_rate_subset %>% filter(geo_value %in% four_states),
+#'       aes(x = time_value, y = death_rate)
+#'     ) +
+#'     scale_x_date(limits = c(forecast_date - 90, forecast_date + 30)) +
+#'     labs(x = "Date", y = "Death rate") +
+#'     facet_wrap(~geo_value, scales = "free_y") +
+#'     theme_bw() +
+#'     geom_vline(xintercept = forecast_date)
 #' }
 layer_cdc_flatline_quantiles <- function(
     frosting,
@@ -160,7 +160,9 @@ layer_cdc_flatline_quantiles_new <- function(
 #' @export
 slather.layer_cdc_flatline_quantiles <-
   function(object, components, workflow, new_data, ...) {
-    if (is.null(object$quantile_levels)) return(components)
+    if (is.null(object$quantile_levels)) {
+      return(components)
+    }
     the_fit <- workflows::extract_fit_parsnip(workflow)
     if (!inherits(the_fit, "_flatline")) {
       cli::cli_warn(
@@ -245,8 +247,10 @@ propagate_samples <- function(
   if (symmetrize) {
     r <- c(r, -r)
   }
-  samp <- quantile(r, probs = c(0, seq_len(nsim - 1)) / (nsim - 1),
-                   na.rm = TRUE, names = FALSE)
+  samp <- quantile(r,
+    probs = c(0, seq_len(nsim - 1)) / (nsim - 1),
+    na.rm = TRUE, names = FALSE
+  )
   res <- list()
 
   raw <- samp + p

R/make_smooth_quantile_reg.R

@@ -63,15 +63,15 @@
 #' lines(pl$x, pl$`0.5`, col = "red")
 #'
 #' if (require("ggplot2")) {
-#' ggplot(data.frame(x = x, y = y), aes(x)) +
-#'   geom_ribbon(data = pl, aes(ymin = `0.2`, ymax = `0.8`), fill = "lightblue") +
-#'   geom_point(aes(y = y), colour = "grey") + # observed data
-#'   geom_function(fun = sin, colour = "black") + # truth
-#'   geom_vline(xintercept = fd, linetype = "dashed") + # end of training data
-#'   geom_line(data = pl, aes(y = `0.5`), colour = "red") + # median prediction
-#'   theme_bw() +
-#'   coord_cartesian(xlim = c(0, NA)) +
-#'   ylab("y")
+#'   ggplot(data.frame(x = x, y = y), aes(x)) +
+#'     geom_ribbon(data = pl, aes(ymin = `0.2`, ymax = `0.8`), fill = "lightblue") +
+#'     geom_point(aes(y = y), colour = "grey") + # observed data
+#'     geom_function(fun = sin, colour = "black") + # truth
+#'     geom_vline(xintercept = fd, linetype = "dashed") + # end of training data
+#'     geom_line(data = pl, aes(y = `0.5`), colour = "red") + # median prediction
+#'     theme_bw() +
+#'     coord_cartesian(xlim = c(0, NA)) +
+#'     ylab("y")
 #' }
 smooth_quantile_reg <- function(
     mode = "regression",

R/print_epi_step.R

@@ -44,7 +44,8 @@ print_epi_step <- function(
   )
   more_dots <- ifelse(first_line == length(elements), "", ", ...")
   cli::cli_bullets(
-    c("\n    {title}: \\\n    {.pkg {cli::cli_vec(elements[seq_len(first_line)])}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}} \\\n    {vline_seperator} \\\n    {.emph {trained_text}}\\\n    {comma_seperator} \\\n    {.emph {case_weights_text}}\n    "))
+    c("\n    {title}: \\\n    {.pkg {cli::cli_vec(elements[seq_len(first_line)])}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}} \\\n    {vline_seperator} \\\n    {.emph {trained_text}}\\\n    {comma_seperator} \\\n    {.emph {case_weights_text}}\n    ")
+  )
 
   cli::cli_end(theme_div_id)
   invisible(NULL)

R/print_layer.R

@@ -25,7 +25,8 @@ print_layer <- function(
   )
   more_dots <- ifelse(first_line == length(elements), "", ", ...")
   cli::cli_bullets(
-    c("\n    {title}: \\\n    {.pkg {elements[seq_len(first_line)]}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}}"))
+    c("\n    {title}: \\\n    {.pkg {elements[seq_len(first_line)]}}\\\n    {more_dots} \\\n    {conjunction} \\\n    {.pkg {extra_text}}")
+  )
 
   invisible(NULL)
 }