data_tbl <- rawdata_tbl %>% set_colnames(names(.) %>% to_snake_case())

data_tbl %>% glimpse()

data_tbl %>%
  plot_intro(
    title   = "High Level Table Summary",
    ggtheme = theme_cowplot()
    )

### _TEMPLATE_
### ADD CODE TO CORRECT FOR DATA ENCODING HERE

coltype_lst <- create_coltype_list(data_tbl)

count_levels <- ~ .x %>% unique() %>% length()

catvar_valuecount_tbl <- data_tbl %>%
  summarise(
    .groups = "drop",

    across(coltype_lst$split$discrete, count_levels)
    ) %>%
  pivot_longer(
    cols      = everything(),
    names_to  = "var_name",
    values_to = "level_count"
    ) %>%
  arrange(desc(level_count))

print(catvar_valuecount_tbl)

row_count <- data_tbl %>% nrow()

cat(glue("Dataset has {row_count} rows\n"))

unique_vars <- catvar_valuecount_tbl %>%
  filter(level_count == row_count) %>%
  pull(var_name)

print(unique_vars)

explore_data_tbl <- data_tbl %>%
  select(-one_of(unique_vars))

highcount_vars <- catvar_valuecount_tbl %>%
  filter(level_count >= dataexp_level_exclusion_threshold,
         level_count < row_count) %>%
  pull(var_name)

cat(str_c(highcount_vars, collapse = ", "))

### You may want to comment out these next few lines to customise which
### categoricals are kept in the exploration.
drop_vars <- c(highcount_vars)

if (length(drop_vars) > 0) {
  explore_data_tbl <- explore_data_tbl %>%
      select(-one_of(drop_vars))

  cat(str_c(drop_vars, collapse = ", "))
}

plot_bar(
    data_tbl,
    ncol    = 2,
    nrow    = 2,
    title   = "Barplots of Data",
    ggtheme = theme_cowplot()
    )

plot_histogram(
    data_tbl,
    ncol    = 2,
    nrow    = 2,
    title   = "Histograms of Data",
    ggtheme = theme_cowplot()
    )

coltype_lst <- create_coltype_list(explore_data_tbl)

print(coltype_lst)

logical_vars <- coltype_lst$split$logical %>% sort()

for (plot_varname in logical_vars) {
  cat("--\n")
  cat(glue("{plot_varname}\n"))

  na_count <- explore_data_tbl %>% pull(.data[[plot_varname]]) %>% are_na() %>% sum()

  plot_title <- glue("Barplot of Counts for Variable: {plot_varname} ({na_count} missing values)")

  explore_plot <- ggplot(explore_data_tbl) +
    geom_bar(aes(x = .data[[plot_varname]])) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(plot_title) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  plot(explore_plot)
}

numeric_vars <- coltype_lst$split$continuous %>% sort()

for (plot_varname in numeric_vars) {
  cat("--\n")
  cat(glue("{plot_varname}\n"))

  plot_var <- explore_data_tbl %>% pull(.data[[plot_varname]])
  na_count <- plot_var %>% are_na() %>% sum()

  plot_var %>% summary() %>% print()

  plot_title <- glue("Histogram Plot for Variable: {plot_varname} ({na_count} missing values)")


  all_plot <- ggplot() +
    geom_histogram(aes(x = plot_var), bins = dataexp_hist_bins_count) +
    geom_vline(xintercept = mean(plot_var, na.rm = TRUE),
               colour = "red", size = 1.5) +
    geom_vline(xintercept = median(plot_var, na.rm = TRUE),
               colour = "green", size = 1.5) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_continuous(labels = label_comma()) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(
      plot_title,
      subtitle = "(red line is mean, green line is median)"
      )

  pos_data_tbl <- explore_data_tbl %>%
    filter(.data[[plot_varname]] >= 0) %>%
    mutate(var_val = abs(.data[[plot_varname]]))

  pos_log_plot <- ggplot(pos_data_tbl) +
    geom_histogram(aes(x = var_val), bins = dataexp_hist_bins_count) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_log10(labels = label_comma()) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle("Positive Values")

  
  neg_data_tbl <- explore_data_tbl %>%
    filter(.data[[plot_varname]] < 0) %>%
    mutate(var_val = abs(.data[[plot_varname]]))

  neg_log_plot <- ggplot(neg_data_tbl) +
    geom_histogram(aes(x = var_val), bins = dataexp_hist_bins_count) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_log10(labels = label_comma()) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle("Negative Values")


  plot_grid(
      all_plot,
      NULL,
      pos_log_plot,
      neg_log_plot,
      nrow = 2
      ) %>%
    print()
}

categorical_vars <- coltype_lst$split$discrete %>% sort()

for (plot_varname in categorical_vars) {
  cat("--\n")
  cat(glue("{plot_varname}\n"))

  na_count <- explore_data_tbl %>% pull(.data[[plot_varname]]) %>% are_na() %>% sum()

  plot_title <- glue("Barplot of Counts for Variable: {plot_varname} ({na_count} missing values)")

  standard_plot_tbl <- explore_data_tbl %>%
    count(.data[[plot_varname]])

  standard_plot <- ggplot(standard_plot_tbl) +
    geom_bar(aes(x = .data[[plot_varname]], weight = n)) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_discrete(labels = ~ abbreviate(.x, minlength = 10)) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(plot_title) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  standard_plot %>% print()


  desc_plot_tbl <- explore_data_tbl %>%
    pull(.data[[plot_varname]]) %>%
    fct_lump(n = dataexp_cat_level_count) %>%
    fct_count() %>%
    mutate(f = fct_relabel(f, str_trunc, width = 15))

  desc_plot <- ggplot(desc_plot_tbl) +
    geom_bar(aes(x = fct_reorder(f, -n), weight = n)) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_discrete(labels = abbreviate) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(plot_title) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  desc_plot %>% print()
}

datetime_vars <- coltype_lst$split$datetime %>% sort()

for (plot_varname in datetime_vars) {
  cat("--\n")
  cat(glue("{plot_varname}\n"))

  plot_var <- explore_data_tbl %>% pull(.data[[plot_varname]])
  na_count <- plot_var %>% are_na() %>% sum()

  plot_var %>% summary() %>% print()

  plot_title <- glue("Barplot of Dates/Times in Variable: {plot_varname} ({na_count} missing values)")


  explore_plot <- ggplot(explore_data_tbl) +
    geom_histogram(aes(x = .data[[plot_varname]]), bins = dataexp_hist_bins_count) +
    xlab(plot_varname) +
    ylab("Count") +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(plot_title)

  plot(explore_plot)
}

logical_vars <- logical_vars[!logical_vars %in% facet_varname] %>% sort()


for (plot_varname in logical_vars) {
  cat("--\n")
  cat(plot_varname)

  plot_tbl <- data_tbl %>% filter(!are_na(.data[[plot_varname]]))

  explore_plot <- ggplot(plot_tbl) +
    geom_bar(aes(x = .data[[plot_varname]])) +
    facet_wrap(facet_varname, scales = "free") +
    xlab(plot_varname) +
    ylab("Count") +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(glue("{facet_varname}-Faceted Histogram for Variable: {plot_varname}")) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  plot(explore_plot)
}

for (plot_varname in numeric_vars) {
  cat("--\n")
  cat(plot_varname)

  plot_tbl <- data_tbl %>% filter(!are_na(.data[[plot_varname]]))

  explore_plot <- ggplot(plot_tbl) +
    geom_histogram(aes(x = .data[[plot_varname]]), bins = dataexp_hist_bins_count) +
    facet_wrap(facet_varname, scales = "free") +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_continuous(labels = label_comma()) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(glue("{facet_varname}-Faceted Histogram for Variable: {plot_varname}")) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  print(explore_plot)
}

categorical_vars <- categorical_vars[!categorical_vars %in% facet_varname] %>% sort()

for (plot_varname in categorical_vars) {
  cat("--\n")
  cat(plot_varname)

  plot_tbl <- data_tbl %>%
    filter(!are_na(.data[[plot_varname]])) %>%
    mutate(
      varname_trunc = fct_relabel(.data[[plot_varname]], str_trunc, width = 10)
      )

  explore_plot <- ggplot(plot_tbl) +
    geom_bar(aes(x = varname_trunc)) +
    facet_wrap(facet_varname, scales = "free") +
    xlab(plot_varname) +
    ylab("Count") +
    scale_x_discrete(labels = abbreviate) +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(glue("{facet_varname}-Faceted Histogram for Variable: {plot_varname}")) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  plot(explore_plot)
}

for (plot_varname in datetime_vars) {
  cat("--\n")
  cat(plot_varname)

  plot_tbl <- data_tbl %>% filter(!are_na(.data[[plot_varname]]))

  explore_plot <- ggplot(plot_tbl) +
    geom_histogram(aes(x = .data[[plot_varname]]), bins = dataexp_hist_bins_count) +
    facet_wrap(facet_varname, scales = "free") +
    xlab(plot_varname) +
    ylab("Count") +
    scale_y_continuous(labels = label_comma()) +
    ggtitle(glue("{facet_varname}-Faceted Histogram for Variable: {plot_varname}")) +
    theme(axis.text.x = element_text(angle = 30, vjust = 0.5))

  plot(explore_plot)
}

stock_codes_lookup_tbl <- data_tbl %>%
  select(stock_code_upr, description) %>%
  distinct() %>%
  arrange(stock_code_upr, description) %>%
  drop_na(description)

stock_codes_lookup_tbl %>% glimpse()

stock_codes_lookup_tbl %>% datatable()

append_calendar_columns <- function(data_tbl, date_col) {
  updated_data_tbl <- data_tbl %>%
    mutate(
      invoice_date   = {{date_col}} %>% as.Date(),
      
      invoice_month  = {{date_col}} %>% format("%B"),
      invoice_dow    = {{date_col}} %>% format("%A"),
      invoice_dom    = {{date_col}} %>% format("%d"),
      invoice_hour   = {{date_col}} %>% format("%H"),
      invoice_minute = {{date_col}} %>% format("%M"),
      invoice_woy    = {{date_col}} %>% format("%V"),
      invoice_ym     = {{date_col}} %>% format("%Y%m"),
      
      .after = {{date_col}}
      )
  
  return(updated_data_tbl)
}

data_tbl %>%
  select(excel_sheet, invoice_id, invoice_date, stock_value) %>%
  append_calendar_columns(invoice_date) %>%
  glimpse()

daily_distribution_tbl <- data_tbl %>%
  group_by(invoice_date, invoice_id) %>%
  summarise(
    .groups = "drop",
    
    total_spend = sum(stock_value)
    )

daily_distribution_tbl %>% glimpse()

plot_tbl <- daily_distribution_tbl %>%
  filter(total_spend > 0) %>%
  group_by(invoice_date) %>%
  summarise(
    .groups = "drop",
    
    qn   = c("total_spend", "p10", "p25", "p50", "p75", "p90"),
    vals = c(
      sum(total_spend),
      quantile(total_spend, probs = c(0.10, 0.25, 0.50, 0.75, 0.90))
      )
    ) %>%
  pivot_wider(
    names_from = qn,
    values_from = vals
  )

ggplot(plot_tbl) +
  geom_errorbar(aes(x = invoice_date, ymin = p25, ymax = p75, colour = total_spend),
                width = 0) +
  scale_y_log10(labels = label_comma()) +
  scale_colour_continuous(labels = label_comma()) +
  labs(x = "Date", y = "Transaction Amount", colour = "Spend") +
  ggtitle("P25-P75 Quartile of Transaction Amounts by Date")

plot_tbl <- daily_distribution_tbl %>%
  filter(total_spend < 0) %>%
  mutate(total_refund = abs(total_spend)) %>%
  group_by(invoice_date) %>%
  summarise(
    .groups = "drop",
    
    qn   = c("total_refund", "p10", "p25", "p50", "p75", "p90"),
    vals = c(
      sum(total_refund),
      quantile(total_refund, probs = c(0.10, 0.25, 0.50, 0.75, 0.90))
      )
    ) %>%
  pivot_wider(
    names_from = qn,
    values_from = vals
  )

ggplot(plot_tbl) +
  geom_errorbar(aes(x = invoice_date, ymin = p25, ymax = p75, colour = total_refund),
                width = 0) +
  scale_y_log10(labels = label_comma()) +
  scale_colour_continuous(labels = label_comma()) +
  labs(x = "Date", y = "Transaction Amount", colour = "Spend") +
  ggtitle("P25-P75 Quartile of Refund Amounts by Date")

filter_returns_transactions <- function(use_stock, use_customer,  use_dttm,
                                        data_tbl) {
  matches_tbl <- data_tbl %>%
    filter(stock_code   == use_stock,
           customer_id  == use_customer,
           invoice_dttm <= use_dttm,
           quantity     >  0)

  return(matches_tbl)
}

match_tnx_prices <- function(data_tbl, return_price, return_quantity) {
  matched_tbl <- data_tbl %>%
    filter(abs(price) == abs(return_price)) %>%
    select(row_id, invoice_id, stock_code, quantity, price, invoice_dttm) %>%
    arrange(desc(invoice_dttm)) %>%
    mutate(
      cuml_quantity   = cumsum(quantity),
      return_quantity = return_quantity,
      remaining       = cuml_quantity + return_quantity
      )

  return(matched_tbl)
}


detemine_return_records <- function(data_tbl) {
  negative_tbl <- data_tbl %>%
    filter(remaining <= 0)
  
  first_tbl <- data_tbl %>%
    filter(remaining > 0) %>%
    arrange(desc(invoice_dttm)) %>%
    head(1)
  
  
  matched_tbl <- list(negative_tbl, first_tbl) %>%
    bind_rows() %>%
    arrange(desc(invoice_dttm)) %>%
    rename(orig_row_id = row_id)
  
  return(matched_tbl)
}


returns_data_tbl <- data_tbl %>%
  filter(quantity < 0) %>%
  select(row_id, stock_code, customer_id, quantity, price, invoice_dttm) %>%
  mutate(
    prev_tnx_data = future_pmap(
      list(use_stock    = stock_code,
           use_customer = customer_id,
           use_dttm     = invoice_dttm),
      filter_returns_transactions,
      data_tbl = data_tbl,
      
      .options  = furrr_options(seed = 421),
      .progress = TRUE      
      ),
    price_data = future_pmap(
      list(data_tbl        = prev_tnx_data,
           return_price    = price,
           return_quantity = quantity),
      match_tnx_prices,
      
      .options  = furrr_options(seed = 422),
      .progress = TRUE
      ),
    match_data = map(price_data, detemine_return_records)
    )


returns_data_tbl %>% glimpse()

returns_lookup_tbl <- returns_data_tbl %>%
  select(return_row_id = row_id, return_dttm = invoice_dttm, match_data) %>%
  unnest(match_data) %>%
  select(
    orig_row_id, return_row_id, return_dttm,
    adjust_quantity = return_quantity
    ) %>%
  group_by(return_row_id) %>%
  arrange(orig_row_id) %>%
  slice_head(n = 1) %>%
  ungroup()

returns_lookup_tbl %>% glimpse()

orig_data_tbl <- data_tbl %>%
  select(orig_row_id   = row_id, purchase_dttm = invoice_dttm)

ret_data_tbl <- data_tbl %>%
  select(return_row_id = row_id, return_dttm   = invoice_dttm)

return_times_tbl <- returns_lookup_tbl %>%
  select(orig_row_id, return_row_id) %>%
  left_join(orig_data_tbl, by = "orig_row_id") %>%
  left_join(ret_data_tbl,  by = "return_row_id") %>%
  mutate(
    return_time = return_dttm - purchase_dttm,
    return_days  = as.numeric(return_time) / (24 * 60 * 60)
    )

base_plot <- ggplot(return_times_tbl) +
  geom_histogram(aes(x = return_days), bins = 50) +
  geom_vline(aes(xintercept = 90), colour = "red") +
  xlab("Days") +
  ylab("Count") +
  ggtitle("Histogram of Days Between Purchase and Return per Item Transaction")

norm_plot <- base_plot +
  scale_x_continuous(labels = label_comma())

log_plot <- base_plot +
  scale_x_log10(labels = label_comma())

plot_grid(norm_plot, log_plot, nrow = 2)

screen_stock_code <- c(
  "B", "C2", "C3", "D", "M", "S", "CRUK", "POST", "DOT", "BANK CHARGES",
  "AMAZONFEE", "ADJUST", "ADJUST2", "TEST001", "TEST002"
  )

clean_stock_code_tbl <- data_tbl %>%
  filter(stock_code_upr %in% screen_stock_code) %>%
  select(row_id)

clean_stock_code_tbl %>% glimpse()

clean_gift_tbl <- data_tbl %>%
  filter(str_detect(stock_code_upr, "GIFT")) %>%
  select(row_id)

clean_gift_tbl %>% glimpse()

exclusions_tbl <- list(
    clean_stock_code_tbl,
    clean_gift_tbl
    ) %>%
  bind_rows() %>%
  mutate(exclude = TRUE)

cleaned_data_tbl <- data_tbl %>%
  left_join(exclusions_tbl, by = "row_id") %>%
  replace_na(list(exclude = FALSE))

cleaned_data_tbl %>% glimpse()

ggplot(customer_cohort_tbl) +
  geom_histogram(aes(x = first_tnx_date), bins = 50) +
  labs(
    x = "Date of First Transaction",
    y = "Count",
    title = "Histogram of New Customer Start Dates"
    )

plot_tbl <- customer_cohort_tbl %>%
  count(cohort_qtr, name = "customer_count") %>%
  mutate(cohort_qtr = cohort_qtr %>% as.character())
  
ggplot(plot_tbl) +
  geom_col(aes(x = cohort_qtr, y = customer_count)) +
  scale_y_continuous(labels = label_comma()) +
  labs(
    x = "Customer Cohort",
    y = "Customer Count",
    title = "Bar Plot of Customer Quarterly Cohort Sizes"
    )

plot_tbl <- customer_cohort_tbl %>%
  count(cohort_ym, name = "customer_count") %>%
  mutate(cohort_ym = cohort_ym %>% as.character())

ggplot(plot_tbl) +
  geom_col(aes(x = cohort_ym, y = customer_count)) +
  scale_y_continuous(labels = label_comma()) +
  labs(
    x = "Customer Cohort",
    y = "Customer Count",
    title = "Bar Plot of Customer Monthly Cohort Sizes"
    ) +
  theme(
    axis.text.x = element_text(size = 10, angle = 20, vjust = 0.5)
    )

plot_tbl <- customer_cohort_tbl %>%
  inner_join(customer_tnx_diffs_tbl, by = "customer_id") %>%
  mutate(cohort_qtr = cohort_qtr %>% as.character())

ggplot(plot_tbl) +
  geom_boxplot(aes(x = cohort_qtr, y = time_diff)) +
  scale_y_log10() +
  labs(
    x = "Cohort",
    y = "Time Difference (weeks)",
    title = "Boxplot of Time Differences by Starting Cohort"
    )

ggplot(plot_tbl, aes(x = time_diff, colour = cohort_qtr)) +
  geom_line(stat = "density") +
  geom_dl(aes(label = cohort_qtr), method = "top.bumpup", stat = "density") +
  labs(
    x = "Time Difference (weeks)",
    y = "Density",
    title = "Comparison Density Plot for Transaction Time Differences Between Cohorts"
    ) +
  theme(legend.position = "none")

ggplot(plot_tbl) +
  geom_histogram(aes(x = time_diff), bins = 50) +
  facet_wrap(vars(cohort_qtr), scales = "free_y") +
  scale_y_continuous(labels = label_comma()) +
  labs(
    x = "Time Difference (weeks)",
    y = "Count",
    title = "Facetted Histograms of Time Between Transactions"
    )

cohort_dropout_est_tbl <- customer_cohort_tbl %>%
  select(
    customer_id, first_tnx_date, cohort_qtr, cohort_ym
    ) %>%
  inner_join(daily_spend_tbl, by = "customer_id") %>%
  group_by(cohort_qtr, customer_id) %>%
  mutate(
    final_tnx_date = max(invoice_date)
    ) %>%
  ungroup() %>%
  select(
    customer_id, cohort_qtr, first_tnx_date, final_tnx_date
    ) %>%
  distinct() %>%
  mutate(
    obs_lifetime = difftime(final_tnx_date, first_tnx_date, units = "week") %>%
      as.numeric()
    ) %>%
  filter(obs_lifetime > 0) %>%
  group_by(cohort_qtr) %>%
  summarise(
    .groups = "drop",
    
    lifetimes = list(obs_lifetime)
    ) %>%
  mutate(
    exp_fit    = map(lifetimes, MASS::fitdistr, densfun = "exponential"),
    param_data = map(exp_fit, broom::tidy)
    ) %>%
  select(cohort_qtr, lifetimes, param_data) %>%
  unnest(param_data)

cohort_dropout_est_tbl %>% glimpse()

cohort_dropout_est_tbl %>% datatable()