Merge pull request #156 from microsoft/mitokic/03132024/hts-fs-fix

fix hts future drivers issue and feature selection issue

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: finnts
 Title: Microsoft Finance Time Series Forecasting Framework
-Version: 0.4.0.9001
+Version: 0.4.0.9002
 Authors@R: 
     c(person(given = "Mike",
            family = "Tokic",

NEWS.md

@@ -1,4 +1,4 @@
-# finnts 0.4.0.9001 (DEVELOPMENT VERSION)
+# finnts 0.4.0.9002 (DEVELOPMENT VERSION)
 
 ## Improvements
 
@@ -7,6 +7,7 @@
 ## Bug Fixes
 
 -   Error in run_type column join in final forecast output
+-   Error in running feature selection
 
 # finnts 0.4.0
 

R/feature_selection.R

@@ -110,8 +110,8 @@ select_features <- function(input_data,
     # botuta feature selection
     boruta_results <- tibble::tibble(
       Feature = boruta_fn(
-        input_data,
-        seed
+        data = input_data,
+        seed = seed
       ),
       Vote = 1,
       Auto_Accept = 0
@@ -204,7 +204,7 @@ select_features <- function(input_data,
 
   # get final selected features list
   fs_list <- final_feature_votes %>%
-    dplyr::filter(Votes >= votes_needed) %>%
+    dplyr::filter(Votes >= votes_needed | Auto_Accept > 0) %>%
     dplyr::pull(Feature) %>%
     sort()
 

R/hierarchy.R

@@ -165,7 +165,6 @@ prep_hierarchical_data <- function(input_data,
             by = c("Combo", "Date")
           )
       } else if (value_level == "All") {
-
         bottom_level_temp_tbl <- input_data_adj %>%
           dplyr::select(Combo, Date, tidyselect::all_of(regressor_var)) %>%
           tidyr::pivot_wider(

R/prep_data.R

@@ -311,8 +311,7 @@ prep_data <- function(run_info,
         xregs_future_tbl <- get_xregs_future_values_tbl(
           initial_prep_combo_tbl,
           external_regressors,
-          hist_end_date,
-          forecast_approach
+          hist_end_date
         )
 
         if (length(colnames(xregs_future_tbl)) > 2) {
@@ -484,8 +483,7 @@ prep_data <- function(run_info,
         xregs_future_tbl <- get_xregs_future_values_tbl(
           df,
           external_regressors,
-          hist_end_date,
-          forecast_approach
+          hist_end_date
         )
 
         if (length(colnames(xregs_future_tbl)) > 2) {
@@ -809,42 +807,34 @@ combo_cleanup_fn <- function(df,
 #' @param data_tbl data frame
 #' @param external_regressors list of external regressors
 #' @param hist_end_date date of when your historical data ends
-#' @param forecast_approach indicates what type of hierarchical time series method
 #'
 #' @return tbl with external regressors with future values
 #' @noRd
 get_xregs_future_values_tbl <- function(data_tbl,
                                         external_regressors,
-                                        hist_end_date,
-                                        forecast_approach) {
-  if (forecast_approach != "bottoms_up") {
-    data_tbl %>%
-      tibble::tibble() %>%
-      dplyr::select(Combo, Date)
-  } else {
-    xregs_future_values_list <- c()
-
-    for (variable in external_regressors) {
-      temp <- data_tbl %>%
-        dplyr::filter(Date > hist_end_date) %>%
-        dplyr::select(variable) %>%
-        tidyr::drop_na()
-
-      if (nrow(temp) > 0) {
-        xregs_future_values_list <- append(
-          xregs_future_values_list,
-          variable
-        )
-      }
-    }
-
-    data_tbl %>%
-      dplyr::select(
-        Combo,
-        Date,
-        tidyselect::all_of(xregs_future_values_list)
+                                        hist_end_date) {
+  xregs_future_values_list <- c()
+
+  for (variable in external_regressors) {
+    temp <- data_tbl %>%
+      dplyr::filter(Date > hist_end_date) %>%
+      dplyr::select(variable) %>%
+      tidyr::drop_na()
+
+    if (nrow(temp) > 0) {
+      xregs_future_values_list <- append(
+        xregs_future_values_list,
+        variable
       )
+    }
   }
+
+  data_tbl %>%
+    dplyr::select(
+      Combo,
+      Date,
+      tidyselect::all_of(xregs_future_values_list)
+    )
 }
 
 #' Function to replace outliers and fill in missing values

R/utility.R

@@ -13,7 +13,7 @@ utils::globalVariables(c(
   "x", "num_cores", "run_info", "negative_forecast", "Forecast_Adj", "Final_Col", "lag_val", "libs",
   ".config", "Forecast_Tbl", "Model_Workflow", "id", "model_run",
   "Auto_Accept", "Feature", "Imp", "Importance", "LOFO_Var", "Var_RMSE", "Vote", "Votes", "desc",
-  "term", "Column", "Box_Cox_Lambda", "get_recipie_configurable", "Agg", "Unique", "Var", 
+  "term", "Column", "Box_Cox_Lambda", "get_recipie_configurable", "Agg", "Unique", "Var",
   "Var_Combo", "regressor", "regressor_tbl", "value_level_iter"
 ))
 

tests/testthat/test-hierarchical.R

@@ -1,8 +1,7 @@
 
 test_that("prep_hierarchical_data returns correct grouped hierarchies", {
-
   skip_if(getRversion() < "3.7.0", "Skipping for R 3.6.0 and below")
-  
+
   # Mock data setup
   data <- tibble::tibble(
     Segment = as.character(c(
@@ -79,9 +78,8 @@ test_that("prep_hierarchical_data returns correct grouped hierarchies", {
 })
 
 test_that("prep_hierarchical_data returns correct standard hierarchies", {
-
   skip_if(getRversion() < "3.7.0", "Skipping for R 3.6.0 and below")
-  
+
   # Mock data setup
   data <- tibble::tibble(
     Area = as.character(c("EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "United States", "United States", "United States", "United States")),