style: consistent use of %<>% over x <- x %>%

Author: dsweber2

R/forecaster_scaled_pop.R

@@ -84,7 +84,7 @@ scaled_pop <- function(epi_data,
   # preprocessing supported by epipredict
   preproc <- epi_recipe(epi_data)
   if (pop_scaling) {
-    preproc <- preproc %>% step_population_scaling(
+    preproc %<>% step_population_scaling(
       all_numeric(),
       df = epipredict::state_census,
       df_pop_col = "pop",
@@ -93,14 +93,14 @@ scaled_pop <- function(epi_data,
       by = c("geo_value" = "abbr")
     )
   }
-  preproc <- preproc %>% arx_preprocess(outcome, predictors, args_list)
+  preproc %<>% arx_preprocess(outcome, predictors, args_list)
 
   # postprocessing supported by epipredict
   postproc <- frosting()
-  postproc <- postproc %>% arx_postprocess(trainer, args_list)
+  postproc %<>% arx_postprocess(trainer, args_list)
   postproc
   if (pop_scaling) {
-    postproc <- postproc %>% layer_population_scaling(
+    postproc %<>% layer_population_scaling(
       .pred, .pred_distn,
       df = epipredict::state_census,
       df_pop_col = "pop",

R/formatters.R

@@ -37,12 +37,12 @@ format_storage <- function(pred, true_forecast_date, target_end_date) {
 #' @param quantile_levels the quantile levels
 #' @importFrom dplyr group_by rename reframe mutate
 format_covidhub <- function(pred, true_forecast_date, target_end_date, quantile_levels) {
-  pred <- pred %>%
+  pred %<>%
     group_by(forecast_date, geo_value, target_date) %>%
     rename(target_end_date = target_date) %>%
     reframe(quantile = quantile_levels, value = quantile(.pred_distn, quantile_levels)[[1]])
   forecasts$ahead <- ahead
-  forecasts <- forecasts %>%
+  forecasts %<>%
     group_by(forecast_date, geo_value, target_date) %>%
     mutate(forecast_date = target_date - ahead) %>%
     rename(target_end_date = target_date) %>%

R/scoring_functions.R

@@ -88,10 +88,10 @@ evaluate_predictions <- function(
     as_of = Sys.Date()
   )
   score_card <- collapse_cards(score_card)
-  score_card <- score_card %>%
+  score_card %<>%
     select(-.data$quantile, -.data$value)
 
-  score_card <- score_card %>%
+  score_card %<>%
     relocate(attr(err_measures, "names"), .after = last_col())
   return(score_card)
 }
@@ -117,14 +117,14 @@ collapse_cards <- function(cards) {
       "predictions_cards or score_cards classes."
     )
   )
-  cards <- cards %>%
+  cards %<>%
     filter(abs(.data$quantile - 0.5) < 1e-8 | is.na(.data$quantile)) %>%
     mutate(quantile = ifelse(is.na(.data$quantile), "p", "m"))
   if (n_distinct(cards$quantile) == 1) {
-    cards <- cards %>%
+    cards %<>%
       mutate(quantile = ifelse(.data$quantile == "p", NA, 0.5))
   } else {
-    cards <- cards %>%
+    cards %<>%
       pivot_wider(names_from = .data$quantile, values_from = .data$value) %>%
       mutate(
         quantile = ifelse(is.na(.data$p), 0.5, NA),
@@ -133,7 +133,7 @@ collapse_cards <- function(cards) {
       select(-.data$p, -.data$m)
   }
   if ("geo_value" %in% colnames(cards)) {
-    cards <- cards %>%
+    cards %<>%
       relocate(.data$quantile:.data$value, .after = .data$geo_value)
   }
   class(cards) <- c(cls, class(cards))

R/small_utils.R

@@ -28,7 +28,7 @@ add_id <- function(df, n_adj = 2) {
     mutate(id = paste(across(everything()), sep = "", collapse = ""), .keep = "none") %>%
     mutate(id = hash_animal(id, n_adj = n_adj)$words) %>%
     mutate(id = paste(id[1:n_adj], sep = "", collapse = "."))
-  df <- df %>%
+  df %<>%
     ungroup() %>%
     mutate(parent_id = stringified$id) %>%
     rowwise() %>%
@@ -81,7 +81,7 @@ id_ahead_ensemble_grid <- function(ensemble_grid, aheads, n_adj = 2) {
     tibble(ahead = aheads)
   )
 
-  ensemble_grid <- ensemble_grid %>%
+  ensemble_grid %<>%
     add_id(., n_adj = 2) %>%
     rowwise() %>%
     mutate(forecaster_ids = list(map2_vec(forecasters, ahead, single_id, n_adj = 2)))

extras/plotting.R

@@ -47,12 +47,12 @@ get_points_df <- function(predictions_cards) {
         is.na(.data$quantile)
     )
   if (any(is.na(points_df$quantile))) {
-    points_df <- points_df %>%
+    points_df %<>%
       pivot_wider(names_from = "quantile", values_from = "value") %>%
       mutate(value = if_else(!is.na(.data$`NA`), .data$`NA`, .data$`0.5`)) %>%
       select(-.data$`0.5`, -.data$`NA`)
   } else {
-    points_df <- points_df %>%
+    points_df %<>%
       select(-.data$quantile)
   }
 
@@ -102,7 +102,7 @@ plot_state_forecasters <- function(
     return(NULL)
   }
 
-  predictions_cards <- predictions_cards %>%
+  predictions_cards %<>%
     filter(!geo_value %in% exclude_geos)
 
   td1 <- tar_read("hhs_latest_data_2022") %>%
@@ -123,11 +123,11 @@ plot_state_forecasters <- function(
   td2_max <- td2_max %>%
     left_join(td1_max, by = "geo_value", suffix = c(".2", ".1")) %>%
     mutate(max_ratio = max_value.1 / max_value.2)
-  td2 <- td2 %>%
+  td2 %<>%
     left_join(td2_max, by = "geo_value") %>%
     mutate(scaled_value = value * max_ratio)
-  td1 <- td1 %>% mutate(forecaster = "hhs hosp truth")
-  td2 <- td2 %>% mutate(forecaster = "chng smoothed_adj_outpatient_flu current, scaled")
+  td1 %<>% mutate(forecaster = "hhs hosp truth")
+  td2 %<>% mutate(forecaster = "chng smoothed_adj_outpatient_flu current, scaled")
 
   # Setup plot
   g <- ggplot(td1, mapping = aes(
@@ -164,7 +164,7 @@ plot_nation_forecasters <- function(
     return(NULL)
   }
 
-  predictions_cards <- predictions_cards %>%
+  predictions_cards %<>%
     filter(!geo_value %in% exclude_geos) %>%
     group_by(forecaster, forecast_date, quantile, target_end_date) %>%
     summarize(value = sum(value)) %>%
@@ -194,7 +194,7 @@ plot_nation_forecasters <- function(
   td2.max <- td2 %>%
     summarize(max_value = max(value)) %>%
     pull(max_value)
-  td2 <- td2 %>%
+  td2 %<>%
     mutate(scaled_value = value * td1.max / td2.max)
 
   # Setup plot