interim 554 calendar submission

Author: usrbinr

554.R

@@ -1,31 +1,103 @@
 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")
 
 
 con <- dbplyr::remote_con(x@datum@data)
 
-# complete calendar with all attributes
 
-new_cal <- fpaR:::seq_date_sql(start_date = "2025-01-01",end_date = "2025-12-31",time_unit = "day",con =con ) |>
+## 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)
 
 
+
 ## next step add in new year indicator
 new_cal |>
   dplyr::mutate(
-    new_year_date_indicator=if_else(month_of_year==2&day_of_year==4,1,0)
+    new_week_indicator=if_else(day_of_week==1,1,0)
+    ,cumulative_week_count=cumsum(new_week_indicator)
+    ,quarter_554=case_when(
+      cumulative_week_count<=14~1
+      ,cumulative_week_count<=28~2
+      ,cumulative_week_count<=42~3
+      ,.default=4
+    )
+    ,month_554=case_when(
+      cumulative_week_count<=5~1
+      ,cumulative_week_count<=10~2
+      ,cumulative_week_count<=14~3
+      ,.default=0
+    )
     ,.before=1
   )
 
+
+
+
+# Example usage:
+map(2021:2024,\(x) closest_sunday_feb1(x))
+
+
+generate_5_5_4_daily <- function(start_date, num_years = 1) {
+  start_date <- as.Date(start_date)
+
+  # 5-5-4 pattern: weeks per month
+  weeks_per_quarter <- c(5, 5, 4)
+  weeks_per_year <- rep(weeks_per_quarter, 4)  # 12 months
+
+  # Total weeks to generate
+  total_weeks <- length(weeks_per_year) * num_years
+
+  # Generate week numbers
+  week_number <- 1:total_weeks
+
+  # Generate fiscal years
+  fiscal_year <- rep(1:num_years, each = length(weeks_per_year))
+
+  # Generate month assignment
+  month_pattern <- 1:12
+  month <- rep(month_pattern, times = weeks_per_year)  # expand by weeks per month
+  month <- rep(month, times = num_years)              # expand for multiple years
+  month <- month[1:total_weeks]                        # truncate if needed
+
+  # Generate start dates for each week
+  week_starts <- start_date + 7 * (week_number - 1)
+
+  # Generate daily dates
+  daily_dates <- unlist(lapply(week_starts, function(d) d + 0:6))
+
+  # Repeat week, month, fiscal year info for each day
+  week_number_daily <- rep(week_number, each = 7)
+  month_daily <- rep(month, each = 7)
+  fiscal_year_daily <- rep(fiscal_year, each = 7)
+
+  # Return daily calendar
+  data.frame(
+    date = daily_dates,
+    fiscal_year = fiscal_year_daily,
+    month = month_daily,
+    week_number = week_number_daily
+  ) |>
+    mutate(
+      date=as.Date(date)
+    )
+}
+
+# Example usage: daily calendar starting Feb 2, 2020, for 1 year
+generate_5_5_4_daily("2020-02-02", num_years = 1)
+
+
 ## next step add in new year indicator
 
 

R/utils-misc.R

@@ -418,15 +418,12 @@ augment_calendar <- function(.data,.date){
     ,msg = ".data must be regular tibble or DBI lazy object"
     )
 
-
-
   if(any(data_class %in% "tbl_lazy")){
 
     out <- augment_calendar_dbi(.data = .data,.date = .date_var)
 
     return(out)
 
-
   }
 
 
@@ -435,14 +432,32 @@ augment_calendar <- function(.data,.date){
     out <- augment_calendar_tbl(.data = .data,.date = !!.date_var)
 
     return(out)
+  }
 
+}
 
-  }
 
+#' Finds closet sunday to February 1st
+#'
+#' @param year year of the date
+#'
+#' @returns character vector
+#' @keywords internal
+closest_sunday_feb1 <- function(year) {
 
+  # Create a Date object for February 1st of the given year
+  feb1 <- as.Date(paste0(year, "-02-01"))
 
-}
+  # Get the day of the week (0 = Sunday, 1 = Monday, ..., 6 = Saturday)
+  wday <- as.integer(format(feb1, "%w"))
+
+  # Calculate offset to the nearest Sunday
+  # If wday <= 3, the closest Sunday is before; else it's after
+  offset <- ifelse(wday <= 3, -wday, 7 - wday)
 
+  # Return the closest Sunday
+  feb1 + offset
+}
 
 
 utils::globalVariables(

renv.lock

@@ -934,8 +934,8 @@
     },
     "contoso": {
       "Package": "contoso",
-      "Version": "1.2.0",
-      "Source": "Repository",
+      "Version": "1.2.2",
+      "Source": "GitHub",
       "Type": "Package",
       "Title": "Dataset of the 'Contoso' Company",
       "Authors@R": "c( person( \"Alejandro\", \"Hagan\", email = \"alejandro.hagan@outlook.com\", role = c(\"aut\", \"cre\") ) )",
@@ -945,24 +945,34 @@
         "DBI",
         "dplyr",
         "cli",
-        "duckdb (>= 1.4.0)"
+        "duckdb (>= 1.4.0)",
+        "assertthat",
+        "cli"
       ],
       "Suggests": [
-        "testthat (>= 3.0.0)"
+        "testthat (>= 3.0.0)",
+        "dbplyr"
       ],
       "Encoding": "UTF-8",
       "LazyData": "true",
       "RoxygenNote": "7.3.3",
+      "Roxygen": "list(markdown = TRUE)",
       "Depends": [
         "R (>= 4.1.0)"
       ],
       "URL": "https://usrbinr.github.io/contoso/, https://github.com/usrbinr/contoso",
       "Config/testthat/edition": "3",
       "BugReports": "https://github.com/usrbinr/contoso/issues",
+      "RemoteType": "github",
+      "RemoteHost": "api.github.com",
+      "RemoteRepo": "contoso",
+      "RemoteUsername": "usrbinr",
+      "RemotePkgRef": "usrbinr/contoso",
+      "RemoteRef": "HEAD",
+      "RemoteSha": "5157e022b4d5871cce95627d879a4a40da1d2b9f",
       "NeedsCompilation": "no",
       "Author": "Alejandro Hagan [aut, cre]",
-      "Maintainer": "Alejandro Hagan <alejandro.hagan@outlook.com>",
-      "Repository": "CRAN"
+      "Maintainer": "Alejandro Hagan <alejandro.hagan@outlook.com>"
     },
     "cpp11": {
       "Package": "cpp11",