Update more prob functions

Author: lshandross

R/prob_thief_wrapper.R

@@ -64,10 +64,15 @@ prob_thief_wrapper <-
     if (num_missing_obs >= 1) {
       truth_data <- truth_data |>
         dplyr::add_row(target_end_date = most_recent_date + 1:num_missing_obs) |>
+        tidyr::complete(!!!rlang::syms(c("target_end_date", "location"))) |>
         tidyr::fill(!!!rlang::syms(names(truth_data)))
       warning(paste(num_missing_obs, "missing truth data observations will be imputed using last available value."))
     }
 
+    remainder_observation <- as.numeric(end_date - start_date + 1) %% frequency
+    truth_dates_desc <- sort(unique(truth_data$target_end_date), decreasing = TRUE)
+    temp_res <- as.integer(as.Date(truth_dates_desc[1]) - as.Date(truth_dates_desc[2]))
+    start_date <- start_date + (remainder_observation) * temp_res
     thief_aggregation <- truth_data |>
       aggregate_thief_df(ts_col, start_date, end_date, fips_code,
                          aggregate_levels, NULL, frequency, transform.4root) |>

R/transform_matrix_to_hub_df.R

@@ -35,7 +35,7 @@
 transform_matrix_to_hub_df <-
   function(fc_matrix, forecast_date, fips_code, target_name, n_samples = NULL,
            quantile_levels = c(0.025, 0.25, 0.5, 0.75, 0.975), h_ahead = 56,
-           keep_bottommost_only = TRUE) {
+           temp_res = 1, keep_bottommost_only = TRUE) {
     if (!is.null(n_samples)) {
       if (n_samples > nrow(fc_matrix)) {
         stop("Requested number of samples cannot exceed the number that have been provided")
@@ -67,18 +67,27 @@ transform_matrix_to_hub_df <-
       ) |>
       dplyr::mutate(
         forecast_date = forecast_date,
+        level = .data[["k"]],
         location = fips_code,
         horizon = as.numeric(.data[["h"]]) * .data[["k"]],
-        temporal_resolution = "daily",
+        temporal_resolution = dplyr::case_when(
+          temp_res == 1 ~ "daily",
+          temp_res == 7 ~ "weekly",
+          temp_res == 30 ~ "monthly",
+          temp_res == 365 ~ "yearly",
+          .default = as.character(temp_res)
+        ),
         target = target_name,
-        target_end_date = forecast_date + .data[["horizon"]],
+        target_end_date = forecast_date + .data[["horizon"]] * temp_res,
         type = ifelse(as.numeric(.data[["Var1"]] < 1), "quantile", "sample"),
         quantile = as.numeric(.data[["Var1"]]),
         value = ifelse(.data[["Freq"]] < 0, 0, .data[["Freq"]]),
       )
 
     if (keep_bottommost_only) {
-      hub_df <- dplyr::filter(hub_df, .data[["k"]] == min(hub_df$k))
+      hub_df <- hub_df |>
+        dplyr::filter(.data[["k"]] == min(hub_df$k)) |>
+        dplyr::select(-"level")
     }
 
     hub_df |>