From 57962d7756d4a7fd499321a61353dbf89ed1eb93 Mon Sep 17 00:00:00 2001 From: alejandrohagan Date: Sun, 29 Dec 2024 14:09:53 -0600 Subject: [PATCH] working prototype --- README.qmd | 19 ++-- test.R | 278 +++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 268 insertions(+), 29 deletions(-) diff --git a/README.qmd b/README.qmd index e8693f7..14c06d9 100644 --- a/README.qmd +++ b/README.qmd @@ -124,23 +124,18 @@ make_aggregation_tbl # method 2024-12-28 - factor analysis API is finalized -- still needs execution -- needs to figure how to do ti functions -- I keep getting stuck - +- finalized ti api + + - need to add calendar class that calculates missing dates across x groups + - need to add group count indicator + - need to add printing logic + - Option 1: sales |> # dataframe totalytd(quantity,order_date) |> # returns ti object with printed instructions calculate() # returns data.frame - -- informs what is going on -- complexity in execution, i need to have multiple classes and calculate for each or come up with something else -- one class, ti_tbl() that fills in all information -- one method per custom class, ti_tbl,totalytd_tbl - -Option 2: - sales |> - totalytd(quantity,order_date) # returns dataframe -- easier to deploy but miss custom print function +s custom print function ## to do list diff --git a/test.R b/test.R index 77e5475..5e81ef4 100644 --- a/test.R +++ b/test.R @@ -77,12 +77,206 @@ test <- sales |> -totalytd_tbl <- new_class("totalytd_tbl" - ,parent = ti_tbl) + +#### time intelligence functions + + + +time_unit <- S7::new_class( + ,name="time_unit" + ,properties = list( + value=S7::new_property( + class=S7::class_character + ,default = "day" + ,setter=\(self,value){ + value <- stringr::str_to_lower(value) + self@value <- value + self + } + ,validator = \(value){ + if(length(value)!=1) cli::format_error("Please enter only one time unit") + } + ) + ) + ,validator = \(self){ + valid_units <- c("day","week","month","quarter","year") + if(!any(self@value %in% valid_units)) return(cli::format_error("Please only enter {valid_units}")) + } +) + + + + +# action class + +action <- S7::new_class( + name="action" + ,properties=list( + value=S7::new_property( + class=S7::class_character + ,setter = \(self,value){ + value <- stringr::str_to_lower(value) + self@value <- value + self + } + ) + ) + ,validator = \(self){ + if(!any(self@value %in% c("shift","compare","aggregate"))) return('Action must return "shift","compare" or "aggregate"') + } +) + + +## calendar class + +calendar_tbl <- new_class( + name="calendar_tbl" + ,properties = + list( + data=S7::new_property( + class=class_data.frame + ) + ,type=S7::new_property( + class=S7::class_character + ,validator = \(value){ + if(!any(value %in% c("standard","554"))) return(cli::format_error("Please return either 'standard' or '554'")) + } + ,setter=\(self,value){ + value <- stringr::str_to_lower(value) + self@type <- value + self + } + ) + ,date_vec=S7::new_property( + class=class_any + ) + ,date_quo=S7::new_property( + class=S7::class_any + ,getter=\(self){ + x <- rlang::parse_expr(self@date_vec) + x + } + ) + ,min_date=S7::new_property( + class=S7::class_numeric + ,getter=\(self){ + x <- self@data |> + dplyr::pull(dplyr::any_of(self@date_vec)) |> + min(na.rm=TRUE) + x + } + ) + ,max_date=S7::new_property( + class=S7::class_numeric + ,getter=\(self){ + x <- self@data |> + dplyr::pull(dplyr::any_of(self@date_vec)) |> + max(na.rm=TRUE) + x + } + ) + ,date_range=S7::new_property( + class=S7::class_numeric + ,getter =\(self){ + x <- as.numeric(self@max_date-self@min_date) + x + } + ) + ,date_count=S7::new_property( + class=S7::class_numeric + ,getter=\(self){ + x <- self@data |> + dplyr::pull(self@date_quo) |> + unique() |> + length() + x + } + ) + ,date_missing=S7::new_property( + class=S7::class_numeric + ,getter=\(self){ + x <- as.numeric(self@date_range-self@date_count) + x + } + ) + ,group_indicator=S7::new_property( + class=S7::class_logical + ,getter=\(self){ + x <- dplyr::if_else(!purrr::is_empty(dplyr::groups(self@data)),TRUE,FALSE) + x + } + ) + ,group_quo=S7::new_property( + class=S7::class_any + ,getter = \(self){ + x <- dplyr::groups(self@data) + x + } + ) + ,group_vec=S7::new_property( + class=S7::class_any + ,getter = \(self){ + x <- as.character(unlist(dplyr::groups(self@data))) + x + } + ) + ,group_count=S7::new_property( + class=S7::class_numeric + ,getter=\(self){ + if(!self@group_indicator){ + + x <- 0 + x + + }else{ + x <- length(self@group_vec) + x + } + } + ) + ) + ) + + +### ti table + +ti_tbl <- S7::new_class( + name="ti_tbl" + ,properties = list( + calendar_tbl=calendar_tbl + ,time_unit=time_unit + ,value_vec=S7::new_property(class=class_character) + ,value_quo=S7::new_property( + class=S7::class_any + ,getter=\(self){ + x <- rlang::parse_expr(self@value_vec) + x + } + ) + ,new_column_name=S7::new_property(class=S7::class_character) + ,sort_logic=S7::new_property(class=S7::class_logical) + #custom classes + ,action=S7::new_property(class=action) + ) + ,validator = \(self){ + + if(!any(self@calendar_tbl@data |> dplyr::pull(self@calendar_tbl@date_vec) |> class() %in% c("Date"))){ + + return(cli::format_error("'{self@date_vec}' is not in Date format")) + } + } +) + + +totalytd_tbl <- new_class("totalytd_tbl" + ,parent = ti_tbl) + + + totalytd <- function(.data,date,value,type){ # Validate inputs @@ -91,12 +285,14 @@ totalytd <- function(.data,date,value,type){ out <- totalytd_tbl( - data = .data - ,date_vec = rlang::as_label(enquo(date)) + calendar_tbl( + data=.data + ,type =type + ,date_vec = rlang::as_label(rlang::enquo(date)) + ) ,time_unit = time_unit("day") - ,type=type - ,value_vec = rlang::as_label(enquo(value)) ,action=action("aggregate") + ,value_vec = rlang::as_label(rlang::enquo(value)) ,new_column_name = "ytd" ,sort_logic = TRUE ) @@ -105,6 +301,13 @@ totalytd <- function(.data,date,value,type){ } +x <- totalytd( + .data=sales |> group_by(store_key,currency_code,product_key) + ,value = unit_price + ,date = order_date + ,type="standard" + ) + x |> class() @@ -138,32 +341,73 @@ method(calculate,totalytd_tbl) <- function(x){ method(print,totalytd_tbl) <- function(x){ + group_count <- x@calendar_tbl@group_count + value_chr <- x@value_vec + show <- cli::cli_div(theme = cli::simple_theme()) + cli::cli_h1("Total Year To Date: totalytd") cli::cli_h2("Description:") - cli::cat_bullet((paste("This will create a rolling sum of",x@value_vec,"from the beginning to the end of the year"))) + cli::cli_par() + cli::cli_text("This will create a rolling sum of {.field {value_chr}}, from the beginning to the end of the year") + cli::builtin_theme() + cli::cli_h2("Calendar:") - cli::cat_bullet(paste("The calendar was aggregated to the",x@time_unit@value,"time unit")) - cli::cat_bullet(paste("A",x@type,"calendar is used with 0 groups")) - cli::cat_bullet(paste("Calendar ranges from",x@min_date,"to",x@max_date)) + cli::cat_bullet(paste("The calendar was aggregated to the",cli::col_yellow(x@time_unit@value),"time unit")) + cli::cat_bullet(cli::cli_text("A ",cli::bg_br_white(cli::col_br_red(x@calendar_tbl@type))," calendar is created with {group_count} group{?s}")) + cli::cat_bullet(paste("Calendar ranges from",cli::col_br_green(x@calendar_tbl@min_date),"to",cli::col_br_green(x@calendar_tbl@max_date))) + cli::cat_bullet(paste(cli::col_blue(x@calendar_tbl@date_missing),"days are missing and replaced")) + cli::cli_h2("Actions:") - out <- tribble( - ~name,~shift,~aggregate,~compare, - "totalytd",NA,x@value_vec,NA - ) - print(out) -} + cat(cli::col_green(symbol$tick), " Aggregate\n", cli::col_red(symbol$cross), " Shift\n", cli::col_red(symbol$cross), " Compare\n", sep = "") + cli::cli_blockquote("this is a block quote -- what else can it do?") + cli::cli_code("totalytd()") + # cli::cli_par() + cli::cli_rule() + cli::cli_text("Use {.fn calculate} to return results") + cli::cli_end(show) +} + sales|> - totalytd(date = order_date,value = unit_price,type="standard") |> + group_by(store_key) |> + totalytd(date = order_date,value = unit_price,type="standard") calculate() +?cli::spark_bar(c(1,2,5,1,10)) + x <- seq(0, 1, length = 6) + spark_bar(x) + + previous_count <- x@data |> pull(x@date_vec) |> unique() |> length() + + current_count <- full_tbl |> pull(date) |> unique() |> length() + + missing_dates <- current_count-previous_count + + + full_tbl <- + make_aggregation_tbl(date_var=!!x@date_quo,value_var=!!x@value_quo,time_unit=x@time_unit@value) |> + dplyr::mutate( + year=lubridate::year(date) + ,.before = 1 + ) + + + + out_tbl <- full_tbl |> + dplyr::group_by(year) |> + dplyr::arrange(date,.by_group = TRUE) |> + dplyr::mutate( + !!x@new_column_name:=base::cumsum(!!x@value_quo) + ) |> + dplyr::ungroup() + names(letters) <- 1:26