remove unnecessary pipes and combine filters

Author: nmdefries

backfill_corrections/delphiBackfillCorrection/R/beta_prior_estimation.R

@@ -53,7 +53,7 @@ objective <- function(theta, x, prob, ...) {
 #' @param model_save_dir directory containing trained models
 #' 
 #' @importFrom stats nlm predict
-#' @importFrom dplyr %>% filter
+#' @importFrom dplyr filter
 #' @importFrom quantgen quantile_lasso
 #' 
 est_priors <- function(train_data, prior_test_data, geo, value_type, dw, taus, 
@@ -63,8 +63,8 @@ est_priors <- function(train_data, prior_test_data, geo, value_type, dw, taus,
                        model_save_dir, start=c(0, log(10)),
                        base_pseudo_denom=1000, base_pseudo_num=10,
                        train_models = TRUE, make_predictions = TRUE) {
-  sub_train_data <- train_data %>% filter(train_data[[dw]] == 1)
-  sub_test_data <- prior_test_data %>% filter(prior_test_data[[dw]] == 1)
+  sub_train_data <- filter(train_data, train_data[[dw]] == 1)
+  sub_test_data <- filter(prior_test_data, prior_test_data[[dw]] == 1)
   if (nrow(sub_test_data) == 0) {
     pseudo_denom <- base_pseudo_denom
     pseudo_num <- base_pseudo_num

backfill_corrections/delphiBackfillCorrection/R/main.R

@@ -112,15 +112,17 @@ run_backfill <- function(df, params,
             )
           }
           combined_df <- add_params_for_dates(combined_df, refd_col, lag_col)
-          combined_df <- combined_df %>% filter(lag < params$ref_lag)
+          combined_df <- filter(combined_df, lag < params$ref_lag)
 
-          geo_train_data <- combined_df %>%
-            filter(issue_date < params$training_end_date) %>%
-            filter(target_date <= params$training_end_date) %>%
-            filter(target_date > params$training_start_date) %>%
+          geo_train_data <- filter(combined_df,
+              issue_date < params$training_end_date,
+              target_date <= params$training_end_date,
+              target_date > params$training_start_date,
+            ) %>%
             drop_na()
-          geo_test_data <- combined_df %>%
-            filter(issue_date %in% params$test_dates) %>%
+          geo_test_data <- filter(combined_df,
+              issue_date %in% params$test_dates
+            ) %>%
             drop_na()
 
           if (nrow(geo_test_data) == 0) {
@@ -134,9 +136,10 @@ run_backfill <- function(df, params,
 
           if (value_type == "fraction") {
             # Use beta prior approach to adjust fractions
-            geo_prior_test_data = combined_df %>%
-              filter(issue_date > min(params$test_dates) - 7) %>%
-              filter(issue_date <= max(params$test_dates))
+            geo_prior_test_data = filter(combined_df,
+                issue_date > min(params$test_dates) - 7,
+                issue_date <= max(params$test_dates)
+            )
             updated_data <- frac_adj(geo_train_data, geo_test_data, geo_prior_test_data,
                                      indicator = indicator, signal = signal,
                                      geo_level = geo_level, signal_suffix = signal_suffix,

backfill_corrections/delphiBackfillCorrection/R/model.R

@@ -5,6 +5,8 @@
 #' @param geo_train_data training data for a certain location
 #' @param geo_test_data testing data for a certain location
 #' 
+#' @importFrom dplyr filter
+#'
 #' @export
 data_filteration <- function(test_lag, geo_train_data, geo_test_data, lag_pad) {
   if (test_lag <= 14){
@@ -20,12 +22,14 @@ data_filteration <- function(test_lag, geo_train_data, geo_test_data, lag_pad) {
     test_lag_pad1=8
     test_lag_pad2=9
   }
-  train_data = geo_train_data %>% 
-    filter(lag >= test_lag - test_lag_pad ) %>%
-    filter(lag <= test_lag + test_lag_pad )
-  test_data = geo_test_data %>%
-    filter(lag >= test_lag - test_lag_pad1 ) %>%
-    filter(lag <= test_lag + test_lag_pad2)
+  train_data = filter(geo_train_data,
+    lag >= test_lag - test_lag_pad,
+    lag <= test_lag + test_lag_pad
+  )
+  test_data = filter(geo_test_data,
+    lag >= test_lag - test_lag_pad1,
+    lag <= test_lag + test_lag_pad2
+  )
 
   return (list(train_data, test_data))
 }

backfill_corrections/delphiBackfillCorrection/R/preprocessing.R

@@ -27,8 +27,10 @@ fill_rows <- function(df, refd_col, lag_col, min_refd, max_refd, ref_lag) {
   # +30 to have values for calculating 7-day averages
   lags <- min(df[[lag_col]]): (ref_lag + 30) 
   refds <- seq(min_refd, max_refd, by="day") # Full list reference date
-  row_inds_df <- as.data.frame(crossing(refds, lags)) %>%
-    setNames(c(refd_col, lag_col))
+  row_inds_df <- setNames(
+    as.data.frame(crossing(refds, lags)),
+    c(refd_col, lag_col)
+  )
   df_new = merge(x=df, y=row_inds_df,
                  by=c(refd_col, lag_col),  all.y=TRUE)
   return (df_new)
@@ -54,13 +56,14 @@ fill_missing_updates <- function(df, value_col, refd_col, lag_col) {
   if (any(diff(pivot_df[[lag_col]]) != 1)) {
     stop("Risk exists in forward filling")
   }
-  pivot_df <- pivot_df %>% fill(everything(), .direction="down")
+  pivot_df <- fill(pivot_df, everything(), .direction="down")
 
   # Fill NAs with 0s
   pivot_df[is.na(pivot_df)] <- 0
 
-  backfill_df <- pivot_df %>%
-    pivot_longer(-lag_col, values_to="value_raw", names_to=refd_col)
+  backfill_df <- pivot_longer(pivot_df,
+    -lag_col, values_to="value_raw", names_to=refd_col
+  )
   backfill_df[[refd_col]] = as.Date(backfill_df[[refd_col]])
 
   return (as.data.frame(backfill_df))
@@ -80,8 +83,9 @@ get_7dav <- function(pivot_df, refd_col) {
     if (col == refd_col) next
     pivot_df[, col] <- rollmeanr(pivot_df[, col], 7, align="right", fill=NA)
   }
-  backfill_df <- pivot_df %>%
-    pivot_longer(-refd_col, values_to="value_raw", names_to="issue_date")
+  backfill_df <- pivot_longer(pivot_df,
+    -refd_col, values_to="value_raw", names_to="issue_date"
+  )
   backfill_df[[refd_col]] = as.Date(backfill_df[[refd_col]])
   backfill_df[["issue_date"]] = as.Date(backfill_df[["issue_date"]])
   return (as.data.frame(backfill_df))
@@ -205,7 +209,7 @@ add_7davs_and_target <- function(df, value_col, refd_col, lag_col, ref_lag) {
   backfill_df$log_7dav_slope = backfill_df$log_value_7dav - backfill_df$log_value_prev_7dav
 
   # Remove invalid rows
-  backfill_df <- backfill_df %>% drop_na(c(lag_col))
+  backfill_df <- drop_na(backfill_df, c(lag_col))
 
   return (as.data.frame(backfill_df))
 }