working augment_non_standard calendar, waiting on chagnes to commplete calendar to extend horizon and start on new fiscal date so that we get the right non-standard calendar

Author: usrbinr

554.R

@@ -1,62 +1,71 @@
 library(tidyverse)
 library(contoso)
+devtools::document()
 devtools::load_all()
 
 ## create 5-5-4 calendar
 
-x <-  contoso::sales |> fpaR::mtd(order_date,revenue,calendar_type = "standard")
+x <-  contoso::sales |> fpaR::mtd(order_date,margin,calendar_type = "standard")
 
 
-con <- dbplyr::remote_con(x@datum@data)
 
 
 ## find beginng date indicator
 
-min_year <- year(x@datum@min_date)
 
-start_year <- closest_sunday_feb1(min_year)
 
-new_cal <- fpaR:::seq_date_sql(start_date = start_year,end_date=x@datum@max_date,time_unit = "day",con =con ) |>
-  augment_calendar(.date = date)
+
 
 #  this should generate a type of calendar
-# need to validate year logic -- I am getting 53 weeks all the time
+#  lets start with this for now -- we need to add a 5th year rebalancing logic (eg specify which year we have an extra week)
+#  lets use this for a momnth over month calculation to see how we would do that
 
 
 
-pattern <- "544"
 
 
-days_in_week=7
-weeks_in_quarter=13
-quarters_in_year=4
 
-# out <-
-  new_cal |>
-  dbplyr::window_order(date) |>
-  select(date,day_of_week) |>
-  dplyr::mutate(
-      year_index=dplyr::if_else(dplyr::row_number()%%(days_in_week*weeks_in_quarter*quarters_in_year)==1,1,0)
-      ,year_ns=cumsum(year_index)
-  ) |>
-  dplyr::mutate(
-    week_index=dplyr::if_else(dplyr::row_number()%%7==1,1,0)
-    ,week_ns=cumsum(week_index)
-    ,.by=year_ns
-  ) |>
-  create_ns_month(pattern=pattern) |>
-  dplyr::mutate(
-    quarter_ns=dplyr::case_when(
-      month_ns<=3~1
-      ,month_ns<=6~2
-      ,month_ns<=9~3
-      ,.default=4
-    )
-  ) |> collect() |> arrange(date)
+## replicate mtd to see this would work in this system
+
+
+#create claendar
+## take the create_Calendar output and then siply pass then through to the augmnet_ns_calendar rather than default calendar so that I
+## sot aht I don't need to recreate that
+
+# full_dbi <-
+## this should say complete_calendar
 
 
 
-out |> collect() |> arrange(date)
+  if(x@datum@calendar_type=="standard"){
+    full_dbi <- create_calendar(x) |>
+      dplyr::mutate(
+        year=lubridate::year(date)
+        ,month=lubridate::month(date)
+        ,.before = 1
+      )
 
+  }
+
+
+if(x@datum@calendar_type!="standard")
+
+  full_dbi <- create_calendar(x) |>
+    augment_non_standard_calendar(pattern="544")
+  )
+    #this should be augment_standard_calendar
+
+
+out_dbi <-
+  full_dbi |>
+  dbplyr::window_order(date) |>
+  dplyr::mutate(
+    !!x@value@new_column_name_vec:=cumsum(!!x@value@value_quo)
+    ,.by=c(year,month,!!!x@datum@group_quo)
+  ) |>
+  dplyr::mutate(
+    days_in_current_period=lubridate::day(date)
+  )
 
 
+return(out)

NAMESPACE

@@ -2,7 +2,7 @@
 
 export(abc)
 export(atd)
-export(augment_calendar)
+export(augment_standard_calendar)
 export(calculate)
 export(cohort)
 export(create_calendar)

R/methods.R

@@ -29,6 +29,14 @@ complete_calendar <- S7::new_generic("complete_calendar","x")
 #' @keywords internal
 S7::method(create_calendar,ti) <- function(x){
 
+
+  ## neeed to add in standard and non-standard logic here.
+
+  # start_year <- closest_sunday_feb1(min_year)
+
+
+
+
   ## summarize data table
   summary_dbi <- x@datum@data |>
     dplyr::ungroup() |>

R/utils-misc.R

@@ -419,7 +419,6 @@ augment_standard_calendar <- function(.data,.date){
 
     out <- augment_standard_calendar_dbi(.data = .data,.date = .date_var)
 
-    return(out)
 
   }
 
@@ -428,9 +427,11 @@ augment_standard_calendar <- function(.data,.date){
 
     out <- augment_standard_calendar_tbl(.data = .data,.date = !!.date_var)
 
-    return(out)
   }
 
+
+
+
 }
 
 
@@ -465,7 +466,7 @@ closest_sunday_feb1 <- function(year) {
 #' @returns DBI object
 #'
 #' @keywords internal
-create_ns_month <- function(.data,pattern){
+create_non_standard_month <- function(.data,pattern){
 
 
   valid_colnames <- c("week_ns","year_ns")
@@ -491,21 +492,21 @@ create_ns_month <- function(.data,pattern){
     out <-
       .data |>
       dplyr::mutate(
-        .by=year_ns
-        ,month_ns=dplyr::case_when(
+        .by=year
+        ,month=dplyr::case_when(
           # either framing it in advance or somehow passing a arg to it
-          week_ns<=!!valid_cumulative_months[[1]]~1
-          ,week_ns<=!!valid_cumulative_months[[2]]~2
-          ,week_ns<=!!valid_cumulative_months[[3]]~3
-          ,week_ns<=!!valid_cumulative_months[[4]]~4
-          ,week_ns<=!!valid_cumulative_months[[5]]~5
-          ,week_ns<=!!valid_cumulative_months[[6]]~6
-          ,week_ns<=!!valid_cumulative_months[[7]]~7
-          ,week_ns<=!!valid_cumulative_months[[8]]~8
-          ,week_ns<=!!valid_cumulative_months[[9]]~9
-          ,week_ns<=!!valid_cumulative_months[[10]]~10
-          ,week_ns<=!!valid_cumulative_months[[11]]~11
-          ,week_ns<=!!valid_cumulative_months[[12]]~12
+          week<=!!valid_cumulative_months[[1]]~1
+          ,week<=!!valid_cumulative_months[[2]]~2
+          ,week<=!!valid_cumulative_months[[3]]~3
+          ,week<=!!valid_cumulative_months[[4]]~4
+          ,week<=!!valid_cumulative_months[[5]]~5
+          ,week<=!!valid_cumulative_months[[6]]~6
+          ,week<=!!valid_cumulative_months[[7]]~7
+          ,week<=!!valid_cumulative_months[[8]]~8
+          ,week<=!!valid_cumulative_months[[9]]~9
+          ,week<=!!valid_cumulative_months[[10]]~10
+          ,week<=!!valid_cumulative_months[[11]]~11
+          ,week<=!!valid_cumulative_months[[12]]~12
           ,.default=13
         )
       )
@@ -517,21 +518,21 @@ create_ns_month <- function(.data,pattern){
 
     out <- .data |>
       dplyr::mutate(
-        .by=year_ns
-        ,month_ns=dplyr::case_when(
+        .by=year
+        ,month=dplyr::case_when(
           # either framing it in advance or somehow passing a arg to it
-          week_ns<=!!valid_cumulative_months[[1]]~1
-          ,week_ns<=!!valid_cumulative_months[[2]]~2
-          ,week_ns<=!!valid_cumulative_months[[3]]~3
-          ,week_ns<=!!valid_cumulative_months[[4]]~4
-          ,week_ns<=!!valid_cumulative_months[[5]]~5
-          ,week_ns<=!!valid_cumulative_months[[6]]~6
-          ,week_ns<=!!valid_cumulative_months[[7]]~7
-          ,week_ns<=!!valid_cumulative_months[[8]]~8
-          ,week_ns<=!!valid_cumulative_months[[9]]~9
-          ,week_ns<=!!valid_cumulative_months[[10]]~10
-          ,week_ns<=!!valid_cumulative_months[[11]]~11
-          ,week_ns<=!!valid_cumulative_months[[12]]~12
+          week<=!!valid_cumulative_months[[1]]~1
+          ,week<=!!valid_cumulative_months[[2]]~2
+          ,week<=!!valid_cumulative_months[[3]]~3
+          ,week<=!!valid_cumulative_months[[4]]~4
+          ,week<=!!valid_cumulative_months[[5]]~5
+          ,week<=!!valid_cumulative_months[[6]]~6
+          ,week<=!!valid_cumulative_months[[7]]~7
+          ,week<=!!valid_cumulative_months[[8]]~8
+          ,week<=!!valid_cumulative_months[[9]]~9
+          ,week<=!!valid_cumulative_months[[10]]~10
+          ,week<=!!valid_cumulative_months[[11]]~11
+          ,week<=!!valid_cumulative_months[[12]]~12
           ,.default=13
         )
       )
@@ -544,21 +545,21 @@ create_ns_month <- function(.data,pattern){
 
     out <- .data |>
       dplyr::mutate(
-        .by=year_ns
-        ,month_ns=dplyr::case_when(
+        .by=year
+        ,month=dplyr::case_when(
           # either framing it in advance or somehow passing a arg to it
-          week_ns<=!!valid_cumulative_months[[1]]~1
-          ,week_ns<=!!valid_cumulative_months[[2]]~2
-          ,week_ns<=!!valid_cumulative_months[[3]]~3
-          ,week_ns<=!!valid_cumulative_months[[4]]~4
-          ,week_ns<=!!valid_cumulative_months[[5]]~5
-          ,week_ns<=!!valid_cumulative_months[[6]]~6
-          ,week_ns<=!!valid_cumulative_months[[7]]~7
-          ,week_ns<=!!valid_cumulative_months[[8]]~8
-          ,week_ns<=!!valid_cumulative_months[[9]]~9
-          ,week_ns<=!!valid_cumulative_months[[10]]~10
-          ,week_ns<=!!valid_cumulative_months[[11]]~11
-          ,week_ns<=!!valid_cumulative_months[[12]]~12
+          week<=!!valid_cumulative_months[[1]]~1
+          ,week<=!!valid_cumulative_months[[2]]~2
+          ,week<=!!valid_cumulative_months[[3]]~3
+          ,week<=!!valid_cumulative_months[[4]]~4
+          ,week<=!!valid_cumulative_months[[5]]~5
+          ,week<=!!valid_cumulative_months[[6]]~6
+          ,week<=!!valid_cumulative_months[[7]]~7
+          ,week<=!!valid_cumulative_months[[8]]~8
+          ,week<=!!valid_cumulative_months[[9]]~9
+          ,week<=!!valid_cumulative_months[[10]]~10
+          ,week<=!!valid_cumulative_months[[11]]~11
+          ,week<=!!valid_cumulative_months[[12]]~12
           ,.default=13
         )
       )
@@ -572,6 +573,64 @@ create_ns_month <- function(.data,pattern){
 
 
 
+#' Augment non-standard calendar
+#'
+#' @param .data data
+#' @param pattern 554,445 or 545
+#'
+#' @returns DBI object
+#'
+augment_non_standard_calendar <- function(.data,pattern){
+
+  #test inputs
+  # pattern <- "544"
+
+  # assign variables
+  days_in_week=7
+  weeks_in_quarter=13
+  quarters_in_year=4
+  # start_year <- closest_sunday_feb1(min_year)
+
+
+  #
+  # new_cal <- seq_date_sql(start_date = start_year,end_date=x@datum@max_date,time_unit = "day",con =con ) |>
+  #   augment_standard_calendar(.date = date) |>
+  #   dplyr::select(date,day_of_week)
+
+  out <-
+    .data |>
+    dbplyr::window_order(date) |>
+    dplyr::mutate(
+      year_index=dplyr::if_else(dplyr::row_number()%%(days_in_week*weeks_in_quarter*quarters_in_year)==1,1,0)
+      ,year=cumsum(year_index)
+    ) |>
+    dplyr::mutate(
+      week_index=dplyr::if_else(dplyr::row_number()%%7==1,1,0)
+      ,week=cumsum(week_index)
+      ,.by=year
+    ) |>
+    create_non_standard_month(pattern=pattern) |>
+    dplyr::mutate(
+      quarter=dplyr::case_when(
+        month<=3~1
+        ,month<=6~2
+        ,month<=9~3
+        ,.default=4
+      )
+    ) |>
+    dplyr::mutate(
+      day=lubridate::day(date)
+    ) |>
+    dplyr::select(
+      date,day,week,month,quarter,year
+    )
+
+  return(out)
+
+}
+
+
+
 utils::globalVariables(
   c(
     "desc",