narrate_forecast fixes

.gitignore

@@ -6,4 +6,5 @@ inst/doc
 docs
 sandbox
 package_prep.R
+profiling.R
 .DS_Store

R/helpers.R

@@ -111,12 +111,12 @@ ytd_volume <- function(
   if (nrow(df) == 0) stop("df must have at least one row, execution is stopped")
 
   # Getting the right data types
-  df <- df %>%
-    dplyr::ungroup() %>%
-    tibble::as_tibble() %>%
-    readr::type_convert(na = c("")) %>%
-    suppressMessages() %>%
-    suppressWarnings()
+  # df <- df %>%
+  #   dplyr::ungroup() %>%
+  #   tibble::as_tibble() %>%
+  #   readr::type_convert(na = c("")) %>%
+  #   suppressMessages() %>%
+  #   suppressWarnings()
 
   # Summarization Assertion
   if (!summarization %in% c("sum", "count", "average")) stop("summarization must of be one of: 'sum', 'count' or 'mean'.")
@@ -187,6 +187,7 @@ ytd_volume <- function(
 #' @param summarization summarization field in series, one of the following methods - 'count', 'mean', 'sum'
 #' @param current_year add current year to avoid situation when some of the groups don't have data in latest periods and current year is estimated incorrectly
 #' @param py_date date to be used for PYTD calculation, if NULL then \code{get_py_date()} will be used by default
+#' @param frequency time series frequency
 #'
 #' @return \code{numeric} value
 #' @noRd
@@ -196,19 +197,20 @@ pytd_volume <- function(
     date = NULL,
     summarization = "sum",
     current_year = NULL,
-    py_date = NULL) {
+    py_date = NULL,
+    frequency = NULL) {
 
   # Table must be a data.frame and have at least one row
   if (!is.data.frame(df)) stop("df must be a data.frame or tibble")
   if (nrow(df) == 0) stop("df must have at least one row, execution is stopped")
 
   # Getting the right data types
-  df <- df %>%
-    dplyr::ungroup() %>%
-    tibble::as_tibble() %>%
-    readr::type_convert(na = c("")) %>%
-    suppressMessages() %>%
-    suppressWarnings()
+  # df <- df %>%
+  #   dplyr::ungroup() %>%
+  #   tibble::as_tibble() %>%
+  #   readr::type_convert(na = c("")) %>%
+  #   suppressMessages() %>%
+  #   suppressWarnings()
 
   # Summarization Assertion
   if (!summarization %in% c("sum", "count", "average")) stop("summarization must of be one of: 'sum', 'count' or 'mean'.")
@@ -242,7 +244,7 @@ pytd_volume <- function(
 
   # PY Date
   if (is.null(py_date)) {
-    py_date <- get_py_date(df)
+    py_date <- get_py_date(df, frequency = frequency)
   } else {
     py_date <- as.Date(py_date)
   }
@@ -393,6 +395,7 @@ get_descriptive_outliers <- function(
 #' @param coverage Portion of variability to be covered by narrative, 0 to 1
 #' @param coverage_limit Maximum number of elements to be narrated, overrides
 #' coverage to avoid extremely verbose narrative creation
+#' @param frequency Time series frequency
 #'
 #' @noRd
 get_trend_outliers <- function(
@@ -402,7 +405,8 @@ get_trend_outliers <- function(
     total = NULL,
     summarization = "sum",
     coverage = 0.5,
-    coverage_limit = 5) {
+    coverage_limit = 5,
+    frequency = NULL) {
 
   table <- df %>%
     dplyr::group_by(dplyr::across(dplyr::all_of(dimension))) %>%
@@ -413,7 +417,8 @@ get_trend_outliers <- function(
                                    measure = measure),
       prev_volume = purrr::map_dbl(data, pytd_volume,
                                    summarization = summarization,
-                                   measure = measure),
+                                   measure = measure,
+                                   frequency = frequency),
       change = curr_volume - prev_volume,
       change_p = paste(round(change/prev_volume*100, 2), "%"),
       abs_change = abs(change),

R/narrate_forecast.R

@@ -60,7 +60,7 @@ narrate_forecast <- function(
     presence_penalty = 0,
     forecast = "Forecast",
     actuals = "Actuals",
-    template_cy = "Forecasted volume for {current_year} is {format_num(cy_forecast)}",
+    template_cy = "Forecasted volumes for {current_year} are equal to {format_num(cy_forecast)}",
     template_ftm = "Overall forecast for the next 12 months is {format_num(ftm_forecast)}",
     template_ftm_change = "Projected {trend} in the next 12 months is equal to {format_num(ftm_change)} ({ftm_change_p}%).",
     use_renviron = FALSE,
@@ -106,6 +106,10 @@ narrate_forecast <- function(
     }
   }
 
+  # leaving only the neccessary fields
+  df <- df %>%
+    dplyr::select(dplyr::all_of(c(date, forecast, actuals)))
+
   if (!date %in% names(df)) stop("{date} is not a column in the data frame")
 
   if (!any(class(df[[date]]) %in% c("Date", "POSIXct", "POSIXlt"))) {

R/narrate_trend.R

@@ -356,7 +356,8 @@ narrate_trend <- function(
                          "count" = NULL),
           summarization = summarization,
           coverage = coverage,
-          coverage_limit = coverage_limit)
+          coverage_limit = coverage_limit,
+          frequency = frequency)
 
       if (is.null(output)) next
 
@@ -375,6 +376,27 @@ narrate_trend <- function(
         outlier_change <- format_num(outlier_change)
       }
 
+      ###
+      # inc <- which(trend == "increase")
+      # dec <- which(trend == "decrease")
+      #
+      # outlier_insight_inc <- list(
+      #   outlier_levels[inc], " (", outlier_change[inc], ", ", outlier_change_p[inc], ", ",
+      #   outlier_prev_volume[inc], " to ", outlier_curr_volume[inc],")"
+      # ) %>%
+      #   purrr::pmap(paste0) %>%
+      #   unlist() %>%
+      #   toString()
+      #
+      # outlier_insight_dec <- list(
+      #   outlier_levels[dec], " (", outlier_change[dec], ", ", outlier_change_p[dec], ", ",
+      #   outlier_prev_volume[dec], " to ", outlier_curr_volume[dec],")"
+      # ) %>%
+      #   purrr::pmap(paste0) %>%
+      #   unlist() %>%
+      #   toString()
+      ###
+
       outlier_insight <- list(
         outlier_levels, " (", outlier_change, ", ", outlier_change_p, ", ",
         outlier_prev_volume, " to ", outlier_curr_volume,")"
@@ -463,7 +485,8 @@ narrate_trend <- function(
                              "count" = NULL),
               summarization = summarization,
               coverage = coverage,
-              coverage_limit = coverage_limit)
+              coverage_limit = coverage_limit,
+              frequency = frequency)
 
           if (is.null(output)) next