segment_abc and segment_cohort

Author: usrbinr

R/abc.R

@@ -14,7 +14,7 @@
 #' -  If you do not provide a `.value` then it will count the transactions per group, if you provide `.value` then it will [sum()] the `.value` per group
 #' -  The function creates a `segment` object, which pre-processes the data into its components
 #'
-#' @returns segment object
+#' @returns abc object
 #' @export
 #'
 #' @examples
@@ -41,7 +41,7 @@ abc <- function(.data,category_values,.value){
   }
 
 
-  x <-   segment(
+  x <-   segment_abc(
     datum                      = datum(.data,date_vec = NA,calendar_type = NA)
     ,value                    = value(value_vec = value_vec,new_column_name_vec = "abc")
     ,category                 = category(category_values=category_values)
@@ -226,13 +226,12 @@ cohort <- function(.data,.date,.value,calendar_type,time_unit="month",period_lab
   # calendar_type <- "standard"
 
 
-  x <-  segment(
+  x <-  segment_cohort(
     datum= datum(
       .data
       ,calendar_type = calendar_type
       ,date_vec = rlang::as_label(rlang::enquo(.date))
     )
-    ,category = category(category_values = 0)
     ,fn = fn(
       fn_exec = cohort_fn
       ,fn_name = "cohort"

R/classes.R

@@ -370,9 +370,10 @@ category <- S7::new_class(
   )
 )
 
-segment <- S7::new_class(
 
-  ,name="segment"
+segment_abc <- S7::new_class(
+
+  ,name="segment_abc"
   ,package = "fpaR"
   ,properties = list(
     datum=datum
@@ -383,3 +384,18 @@ segment <- S7::new_class(
     ,value=value
   )
 )
+
+
+
+segment_cohort <- S7::new_class(
+
+  ,name="segment_cohort"
+  ,package = "fpaR"
+  ,properties = list(
+    datum=datum
+    ,time_unit=time_unit
+    ,fn=fn
+    ,action=action
+    ,value=value
+  )
+)

R/methods.R

@@ -77,55 +77,6 @@ S7::method(create_calendar,ti) <- function(x){
 }
 
 
-
-#' Create Calendar Table
-#' @name create_calendar
-#' @param x segment object
-#'
-#' @returns dbi object
-#' @export
-#' @description
-#' `create_calendar()` summarizes a tibble to target time unit and completes the calendar to ensure
-#' no missing days, month, quarter or years. If a grouped tibble is passed through it will complete the calendar
-#' for each combination of the group
-#' @details
-#' This is in internal function to make it easier to ensure data has no missing dates to
-#'  simplify the use of time intelligence functions downstream of the application.
-#' If you want to summarize to a particular group, simply pass the tibble through to the [dplyr::group_by()] argument
-#' prior to function and the function will make summarize and make a complete calendar for each group item.
-#' @keywords internal
-S7::method(create_calendar,segment) <- function(x){
-
-  ## summarize data table
-  summary_dbi <- x@datum@data |>
-    dplyr::mutate(
-      date = lubridate::floor_date(!!x@datum@date_quo,unit = "day")
-    ) |>
-    dplyr::summarise(
-      !!x@value@value_vec:= sum(!!x@value@value_quo,na.rm=TRUE)
-      ,.by=c(date,!!!x@datum@group_quo)
-    )
-
-  #create calendar table
-
-  calendar_dbi <- seq_date_sql(start_date = x@datum@min_date,end_date = x@datum@max_date,time_unit = x@time_unit@value,con=dbplyr::remote_con(x@datum@data)) |>
-      dplyr::cross_join(
-        summary_dbi |>
-          dplyr::distinct(!!!x@value@value_quo)
-      )
-
-
-
-  # Perform a full join to ensure all time frames are represented
-  full_dbi <- dplyr::full_join(
-    calendar_dbi
-    ,summary_dbi
-    ,by = dplyr::join_by(date,!!!x@value@value_quo)
-  )
-
-  return(full_dbi)
-}
-
 #' @title Execute time-intelligence or segments class objects to return the underlying transformed table
 #' @name calculate
 #' @param x ti object
@@ -161,7 +112,7 @@ S7::method(calculate,ti) <- function(x){
 #'     abc(category_values = c(.3,.5,.75,.85)) |>
 #'     calculate()
 #'}
-S7::method(calculate,segment) <- function(x){
+S7::method(calculate,segment_cohort) <- function(x){
 
   out <- x@fn@fn_exec(x)
 
@@ -171,6 +122,29 @@ S7::method(calculate,segment) <- function(x){
 
 
 
+#' @title Execute time-intelligence or segments class objects to return the underlying transformed table
+#' @name calculate
+#' @param x segment object
+#'
+#' @returns dbi object
+#' @export
+#' @examples
+#' \dontrun{
+#' sales |>
+#'     group_by(store_key) |>
+#'     abc(category_values = c(.3,.5,.75,.85)) |>
+#'     calculate()
+#'}
+S7::method(calculate,segment_abc) <- function(x){
+
+  out <- x@fn@fn_exec(x) |>
+    dplyr::arrange(row_id)
+
+  return(out)
+
+}
+
+
 #' @title complete_calendar
 #' @name complete_calendar
 #' @param x ti object
@@ -299,7 +273,7 @@ print_next_steps()
 #' @return segment object
 #' @keywords internal
 #'
-S7::method(print,segment) <- function(x,...){
+S7::method(print,segment_abc) <- function(x,...){
 
 
   n_values_len <- length(x@category@category_values)
@@ -309,7 +283,6 @@ S7::method(print,segment) <- function(x,...){
   ### Category Values information
   cli::cli_h2("Category Information")
 
-  if(x@fn@fn_name=="abc"){
 
   if(x@value@value_vec=="n"){
 
@@ -327,7 +300,7 @@ S7::method(print,segment) <- function(x,...){
 
     )
 
-  }else {
+  }else{
 
     cli::cat_bullet(
       paste(
@@ -353,9 +326,38 @@ S7::method(print,segment) <- function(x,...){
       ,cli::col_br_blue(stringr::str_flatten_comma(x@category@category_names))
     )
   )
-  }else{
+
+
   cli::cat_line("")
 
+  print_actions_steps(x)
+
+  print_next_steps()
+
+}
+
+
+
+#' Print segment objects
+#' @name print
+#' @param x A \code{ti} object.
+#' @param ... Unused. Present for S3/S7 compatibility; additional arguments are ignored.
+#
+#'
+#' @return segment object
+#' @keywords internal
+#'
+S7::method(print,segment_cohort) <- function(x,...){
+
+
+
+  print_fn_info(x)
+
+  ### Category Values information
+  cli::cli_h2("Category Information")
+
+    cli::cat_line("")
+
     cli::cat_bullet(
       paste(
         "The data set is grouped by the"
@@ -378,15 +380,14 @@ S7::method(print,segment) <- function(x,...){
 
 
 
-  ## add if condition for abc vs. cohort
-  cli::cli_h2("Calendar:")
-  cli::cat_bullet(paste("The calendar aggregated",cli::col_br_magenta(x@datum@date_vec),"to the",cli::col_yellow(x@time_unit@value),"time unit"))
-  cli::cat_bullet("A ",cli::col_br_red(x@datum@calendar_type)," calendar is created with ",cli::col_green(x@datum@group_count," groups"))
-  cli::cat_bullet(paste("Calendar ranges from",cli::col_br_green(x@datum@min_date),"to",cli::col_br_green(x@datum@max_date)))
-  cli::cat_bullet(paste(cli::col_blue(x@datum@date_missing),"days were missing and replaced with 0"))
-  cli::cat_bullet("New date column ",stringr::str_flatten_comma(cli::col_br_red(x@fn@new_date_column_name),last = " and ")," was created from ",cli::col_br_magenta(x@datum@date_vec))
-  cli::cat_line("")
-}
+    ## add if condition for abc vs. cohort
+    cli::cli_h2("Calendar:")
+    cli::cat_bullet(paste("The calendar aggregated",cli::col_br_magenta(x@datum@date_vec),"to the",cli::col_yellow(x@time_unit@value),"time unit"))
+    cli::cat_bullet("A ",cli::col_br_red(x@datum@calendar_type)," calendar is created with ",cli::col_green(x@datum@group_count," groups"))
+    cli::cat_bullet(paste("Calendar ranges from",cli::col_br_green(x@datum@min_date),"to",cli::col_br_green(x@datum@max_date)))
+    cli::cat_bullet(paste(cli::col_blue(x@datum@date_missing),"days were missing and replaced with 0"))
+    cli::cat_bullet("New date column ",stringr::str_flatten_comma(cli::col_br_red(x@fn@new_date_column_name),last = " and ")," was created from ",cli::col_br_magenta(x@datum@date_vec))
+    cli::cat_line("")
 
   cli::cat_line("")
 
@@ -395,4 +396,3 @@ S7::method(print,segment) <- function(x,...){
   print_next_steps()
 
 }
-