starbucks-cust-segmentation.Rmd

---
title: "Data Brew: Brewing Success with Starbucks Customer Insights"
subtitle: "TEAM 6 - Chekitha Swayampu, Hrushikesh Sai Seshagiri Chowdary Uppalapati, Swathi Murali Srinivasan, Vaishnavi Tamilvanan"
date: "2023-10-20"
output:
  prettydoc::html_pretty:
    theme: hpstr
    toc: true
  pdf_document:
    toc: yes
    toc_depth: 3
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r, results='markup'}
# Load required libraries
library(jsonlite)
library(dplyr)

# Load data
portfolio_orig <- read.csv("data/portfolio.csv", row.names = 1)
profile <- read.csv("data/profile.csv", row.names = 1)
transcript <- read.csv("data/transcript.csv", row.names = 1)

#profile <- stream_in(file("data_json/profile.json"))
#transcript <- stream_in(file("data_json/transcript.json"))
```

```{r}
# Print the dimensions (shape) of the 'portfolio' data frame
cat("Dimensions of 'portfolio_orig':", nrow(portfolio_orig), "rows and", ncol(portfolio_orig), "columns\n")

# Display the first few rows of the 'portfolio' data frame
head(portfolio_orig)
```
```{r}
portfolio_orig['channels']
```

```{r}
# Print the dimensions (shape) of the 'portfolio' data frame
cat("Dimensions of 'profile':", nrow(profile), "rows and", ncol(profile), "columns\n")

# Display the first few rows of the 'portfolio' data frame
head(profile)
```
```{r}
# Print the dimensions (shape) of the 'portfolio' data frame
cat("Dimensions of 'profile':", nrow(transcript), "rows and", ncol(transcript), "columns\n")

# Display the first few rows of the 'portfolio' data frame
head(transcript)
```

```{r}
# Rename the id columns for ease of understanding
#portfolio_orig$offer_id <- portfolio_orig$id
#portfolio_orig <- subset(portfolio, select = -id)

#profile$customer_id <- profile$id
#profile <- subset(profile, select = -id)

#transcript$customer_id <- transcript$person
#transcript <- subset(transcript, select = -person)
```

```{r}
portfolio_orig
```
```{r}
#library(tidyverse)
#library(stringr)

# Create binary columns for each channel
#channels <- unique(unlist(str_split(portfolio_orig$channels, ",")))
#for (channel in channels) {
  #col_name <- paste0("channel_", gsub("[[:space:]]|[[:punct:]]", "_", channel))
  #portfolio[col_name] <- as.integer(str_detect(portfolio_orig$channels, fixed(channel)))
#}

# Create binary columns for each offer type
#offer_types <- unique(portfolio_orig$offer_type)
#for (offer_type in offer_types) {
  #col_name <- paste0("offer_type_", gsub("[[:space:]]|[[:punct:]]", "_", offer_type))
  #portfolio[col_name] <- as.integer(portfolio_orig$offer_type == offer_type)
#}

# Print portfolio
#print(portfolio)
#print(colnames(portfolio))
```

```{r}
# Additional columns
additional_columns <- tibble(
  email = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
  mobile = c(1, 1, 1, 1, 0, 1, 1, 1, 1, 1),
  social = c(1, 1, 0, 0, 0, 1, 1, 1, 1, 0),
  web = c(0, 1, 1, 1, 1, 1, 1, 1, 1, 1),
  bogo = c(1, 1, 0, 1, 0, 0, 0, 0, 1, 0),
  discount = c(0, 0, 0, 0, 1, 1, 1, 0, 0, 1),
  informational = c(0, 0, 1, 0, 0, 0, 0, 1, 0, 0)
)

# Add additional columns to the original portfolio DataFrame
portfolio_df_new <- cbind(portfolio_orig, additional_columns)

# Print updated portfolio DataFrame
print(portfolio_df_new)
```

```{r}
#length(unique(portfolio$id)) == nrow(portfolio)
```
```{r}
head(transcript)
```

Transcript cleanup:

```{r}
# Assuming 'transcript' is a data frame in R
library(dplyr)
library(tidyr)
library(jsonlite)

# Convert strings to lists in 'value' column
transcript$value <- lapply(transcript$value, function(x) try(fromJSON(gsub("'", "\"", x)), silent = TRUE))

transcript <- mutate(transcript,
                     value_type = sapply(value, function(x) ifelse(!inherits(x, "try-error") && length(x) > 0, names(x), NA)),
                     value = sapply(value, function(x) ifelse(!inherits(x, "try-error") && length(x) > 0, x[[1]], NA))
)

# Make sure 'time' is an integer
transcript$time <- as.integer(transcript$time)

# Print the first few rows of the updated 'transcript' data frame
head(transcript)
tail(transcript)
```
Profile cleanup:

```{r}
# For Gender, replace missing values with 'U' (Unknown)
#profile$gender[is.na(profile$gender)] <- 'U'

# Replace empty strings in 'gender' with 'U' (Unknown)
profile$gender[profile$gender == ""] <- 'U'

# Convert 'income' column to numeric
profile$income <- as.numeric(profile$income)

# Convert 'age' column to integer
profile$age <- as.integer(profile$age)
```

```{r}
# Plot the histogram
hist(profile$income, breaks = 10, col = "lightblue", main = "Income Distribution", xlab = "Income", ylab = "Frequency")

# Add a vertical line at the mean
abline(v = mean(profile$income), col = "red", lwd = 2)
```

```{r}
# Calculate the mean of the 'income' column
mean_val <- mean(profile$income, na.rm = TRUE)
mean_val
# Replace missing values with the mean value
profile$income[is.na(profile$income)] <- mean_val
```
```{r}
# Convert 'became_member_on' to character type
profile$became_member_on <- as.character(profile$became_member_on)

# Create new columns for year, month, day, and date
profile$member_year <- as.integer(substr(profile$became_member_on, 1, 4))
profile$member_month <- as.integer(substr(profile$became_member_on, 5, 6))
profile$member_day <- as.integer(substr(profile$became_member_on, 7, 8))
profile$member_date <- as.Date(profile$became_member_on, format = "%Y%m%d")

# Remove the original 'became_member_on' column
profile <- subset(profile, select = -c(became_member_on))
head(profile)
```

# Exploratory Analysis
## Gender Analysis

Approximately half of the individuals in the Starbucks demographic are identified as males, with females, individuals of unknown gender, and those with other gender identities comprising the remainder of the population. While examining the average income for each gender, there doesn't appear to be a significant difference among them. However, a nuanced perspective emerges when scrutinizing their income distributions. Unknown gender individuals lack a discernible distribution as they have all been replaced with the mean income of the overall population. For females, a notable portion of users falls within the income range of $55,000 to $90,000. In contrast, the upper quartile of male users exhibits an income level that aligns closely with the average income for female customers, approximately $60,000.

```{r}

# Calculate percentage of users by gender
gender_counts <- table(profile$gender)
gender_percentage <- prop.table(gender_counts) * 100

# Define custom colors for each gender
custom_colors <- c("lightblue", "pink", "lightgreen", "lightcoral")

# Create a bar plot with customized labels, colors, and y-axis limit
barplot(gender_percentage, 
        main="Gender Distribution", 
        xlab="Gender", 
        ylab="Percentage of Users",
        col=custom_colors,
        ylim=c(0, 50))

```

```{r}

# Calculate average income by gender
gender_income <- aggregate(income ~ gender, data=profile, FUN=mean)
# Define custom colors for each gender
custom_colors <- c("lightblue", "pink", "lightgreen", "lightcoral")

# Create a bar plot with a square border
par(mar=c(5, 6, 4, 5) + 0.1)  # Adjust the margins for the border and labels
barplot(gender_income$income, 
        names.arg=gender_income$gender,
        main="Average Income vs Gender",
        xlab="Gender",
        ylab="Income",
        ylim=c(0, max(gender_income$income) + 1000),
        col=custom_colors)

# Add a horizontal line for the overall average income
abline(h=mean(profile$income), col="red", lty=2)

# Add labels and title
text(1, mean(profile$income) + 500, "Overall Average Income", col="red")
title("Average Income vs Gender", xlab="Gender", ylab="Income")

# Add a square border
box(lwd=2)


```

```{r}
# Calculate mean income
mean_val <- mean(profile$income)

# Set up the plotting area
par(mfrow=c(1, 1), mar=c(5, 5, 2, 2) + 0.1)
# Define custom colors for each gender
custom_colors <- c("lightblue", "pink", "lightgreen", "lightcoral")
# Create a boxplot
boxplot(income ~ gender, data = profile, main = 'Income Distribution vs. Gender',
        xlab = 'Gender', ylab = 'Income', col = custom_colors, border = 'black')

# Add a horizontal line for the overall mean income
abline(h = mean_val, col = 'blue')

# Add labels and title
text(1, mean_val + 1000, "Overall Mean Income", col = 'red')
title('Income Distribution vs. Gender', xlab = 'Gender', ylab = 'Income')

```

## Customer Sign Ups
Exploring the registration patterns of customers proves intriguing. Notably, three distinct periods stand out, marked by substantial surges in customer registrations, followed by relatively stable trends. Noteworthy is a significant decline, particularly evident at the commencement of 2018, adding an interesting dimension to the analysis.

```{r}
# Assuming 'profile' is a data frame in R

# Install and load the necessary package
# install.packages("ggplot2")
library(ggplot2)

# Convert member_date to Date type
profile$member_date <- as.Date(profile$member_date)

# Number of sign-ups each day
signups_by_day <- aggregate(income ~ member_date, data = profile, FUN = length)

# Plotting with black border and no inside grids
ggplot(signups_by_day, aes(x = member_date, y = income)) +
  geom_line(color = "blue") +
  labs(x = 'Date', y = 'Number of Sign Ups', title = 'Number of Sign Ups Each Day') +
  theme_minimal() +
  theme(
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(color = "black", fill = NA, size = 1)
  )


```
An additional aspect to consider is customer subscriptions analyzed on a monthly basis. Notably, a recurring trend is observed in each year, wherein subscriptions experience a decline at the beginning of the year, followed by a notable surge around July. This pattern raises the hypothesis that the upturn might be associated with customers signing up for fall promotions, coinciding with the introduction of fall-themed beverages. It could be plausible that these promotions are strategically linked to the unveiling of fall drinks.

A noteworthy observation is the consistent nature of subscriptions in even years, while odd years exhibit significant spikes. This phenomenon prompts speculation about potential correlations with new app releases during odd years.

Furthermore, the year 2018 appears to be challenging, particularly evident in reduced customer sign-ups during the summer months compared to the corresponding periods in prior years. This anomaly warrants further investigation to discern the underlying factors influencing the observed decline in customer registrations during the specified timeframe.

```{r}

library(ggplot2)

# Filter data for member_year >= 2014
filtered_profile <- subset(profile, member_year >= 2014)

# Group by member_year and member_month and count the number of ids
membership_subs <- aggregate(id ~ member_year + member_month, data = filtered_profile, length)

# Rename the 'id' column to 'count'
names(membership_subs)[3] <- 'count'

# Convert member_month to numeric
membership_subs$member_month <- as.numeric(membership_subs$member_month)

# Plotting with connected dots, black border, and filled dots with respective color
ggplot(membership_subs, aes(x = member_month, y = count, color = factor(member_year), fill = factor(member_year))) +
  geom_point(shape = 21, size = 3) +
  geom_line() +
  labs(x = 'Month', y = 'Customer Subscriptions', title = 'Customer Subscriptions by Month and Year') +
  scale_color_manual(values = c("2014" = "blue", "2015" = "green", "2016" = "red", "2017" = "purple")) +
  scale_fill_manual(values = c("2014" = "blue", "2015" = "green", "2016" = "red", "2017" = "purple")) +
  theme_minimal() +
  theme(
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(color = "black", fill = NA, size = 1),
    axis.line = element_line(color = "black")
  ) +
  scale_x_continuous(breaks = 1:12) +
  scale_y_continuous(breaks = seq(0, max(membership_subs$count), by = 200), limits = c(0, max(membership_subs$count) + 200))

```
## Customer Transactions

The walkthrough of the customer transactions table pursued diverse directions. Two distinct types of 'value_types' were explored: 'amount,' representing the purchase amount for a specific transaction, and 'offer id,' signifying the offer that occurred. The 'offer id' can progress through various stages, including 'offer received,' 'offer reviewed,' and 'offer completed.' The dual nature of 'value_types' introduces complexity to the analysis, involving both transaction amounts and the lifecycle of promotional offers.

```{r}

# Subset for the specific discount offer
subset_transcript <- subset(transcript, person == '9fa9ae8f57894cc9a3b8a9bbe0fc1b2f' & value == '2906b810c7d4411798c6938adc9daaa5')

# Print the result
print(subset_transcript)

```
```{r}

# Subset for the specific ID
subset_portfolio <- subset(portfolio_orig, id == '2906b810c7d4411798c6938adc9daaa5')

# Print the result
print(subset_portfolio)

```
```{r}

# Calculate the relative frequency of each event
event_counts <- table(transcript$event) / length(transcript$event)

# Print the result
print(event_counts)

```
```{r}

# Filter for completed offers and merge with the portfolio data
trans_and_offers <- merge(
  subset(transcript, value_type == 'offer_id' & event == 'offer completed'),
  subset(portfolio_orig),
  by.x = 'value',
  by.y = 'id',
  all.x = TRUE
)

# Calculate the relative frequency of each offer type
offer_type_counts <- table(trans_and_offers$offer_type) / nrow(trans_and_offers)

# Print the result
print(offer_type_counts)

```

# Data Analysis
## Analysis of Offer Types

Numerous insights can be gleaned from examining a customer's transactional journey. By sequencing all transactions, we gain valuable insights into purchase trends and the completion status of various offers.

Initially, we will focus on a single individual's transaction amounts. This entails calculating the average transaction value and determining the time gaps between purchases.

```{r}

# Filter for amount transactions of a specific person
test_person_transactions <- subset(transcript, person == '8dbfa485249f409aa223a2130f40634a' & value_type == 'amount')

# Reset index
test_person_transactions <- test_person_transactions[order(test_person_transactions$time), ]
rownames(test_person_transactions) <- NULL

# Calculate the difference in days between purchases
test_person_transactions$DaysFromLastPurchase <- c(0, diff(test_person_transactions$time))

# Set the first value in 'DaysFromLastPurchase' to be the same as the first transaction time
test_person_transactions$DaysFromLastPurchase[1] <- test_person_transactions$time[1]

# Convert 'value' column to numeric
test_person_transactions$value <- as.numeric(test_person_transactions$value)

# Remove the index column
test_person_transactions <- test_person_transactions[, !(names(test_person_transactions) %in% "index")]

# Print the result
print(head(test_person_transactions, 10))

```

```{r}


library(dplyr)

# Group by 'person' and calculate aggregates with the same column names
result <- test_person_transactions %>%
  group_by(person) %>%
  summarise(
    value = mean(value),
    DaysFromLastPurchase = mean(DaysFromLastPurchase),
    time = max(time)
  )

# Print the result
print(result)


```

## Analysis of Promotion Activity

Exploring customer interactions with different promotions is crucial. The objective is to understand which promotions the customer received and subsequently completed, specifically focusing on each promotion type.

```{r}

# Load necessary libraries
library(dplyr)

# Filter 'transcript' for 'offer received' events
received_df <- transcript %>%
  filter(event == 'offer received')

# Filter 'transcript' for 'offer completed' events
completed_df <- transcript %>%
  filter(event == 'offer completed')

# Merge DataFrames based on 'person' and 'value'
test_completion <- left_join(received_df, completed_df, by = c('person', 'value'))


# Display the resulting DataFrame
head(test_completion)

```
Now that the joins have been made for the individual and the offer ID, it's evident that there are instances of redundant joins due to the possibility of a single person receiving the same offer multiple times. The focus should be on retaining only those offers that align correctly within the same time frame, eliminating duplications.

```{r}
library(dplyr)
library(tidyr)

# Assuming 'test_completion' is your DataFrame in R

completion <- test_completion %>%
  filter(
    (time.y <= (time.x + 20) & time.y >= time.x) |
    is.na(event.y)
  ) %>%
  select(person, time.x, value, event.y, time.y) %>%
  mutate(
    DaysToCompleteOffer = time.y - time.x,
    CompletedOffer = ifelse(is.na(event.y), 0, 1)
  )

tail(completion)

```
Examining the same test person as previously mentioned, it becomes apparent that despite having numerous transactions, they received two offers but did not complete either of them.

```{r}

person_completion <- completion %>% filter(person == '8dbfa485249f409aa223a2130f40634a')
print(person_completion)

```
Analyzing an individual who has successfully completed some offers, let's delve into the details of their transactional history.
```{r}

person_completion <- completion %>% filter(person == '9dc1421481194dcd9400aec7c9ae6366')
print(person_completion)

```
```{r}

person_summary <- completion %>%
  filter(person == '9dc1421481194dcd9400aec7c9ae6366') %>%
  group_by(person) %>%
  summarise(
    time.x = min(time.x),
    CompletedOffer = mean(CompletedOffer),
    DaysToCompleteOffer = mean(DaysToCompleteOffer)
  )

print(person_summary)

```
```{r}
















```
```{r}
offers_final_df <- merge(completion
                        , portfolio_orig
                        , by.x = "value"
                        , by.y = "id"
                        , all = FALSE
                        )


offers_final_df$reward <- as.numeric(offers_final_df$reward)
offers_final_df$difficulty <- as.numeric(offers_final_df$difficulty)

offers_final_df$NetReward <- offers_final_df$reward - offers_final_df$difficulty

tail(offers_final_df)

```

```{r}
library(dplyr)

# Assuming 'offers_final_df' is your DataFrame in R

# Group by offer_type, difficulty, and reward
overall_offers_df <- offers_final_df %>%
  group_by(offer_type, difficulty, reward) %>%
  summarise(
    CompletedOffers = mean(CompletedOffer),
    TotalCompletions = sum(CompletedOffer),
    AvgDaysToComplete = ifelse(all(is.na(DaysToCompleteOffer)), NA, mean(DaysToCompleteOffer, na.rm = TRUE)),
    NetReward = max(NetReward)
  )

# Drop the second level of column names

# Rename columns
colnames(overall_offers_df) <- c('offer_type', 'difficulty', 'reward', 'CompletedOffers', 'TotalCompletions', 'AvgDaysToComplete', 'NetReward')

# Calculate NetWorth
overall_offers_df$NetWorth <- (overall_offers_df$CompletedOffers * overall_offers_df$NetReward) * -1

# Filter out 'informational' offers
final_overall_offers_df <- overall_offers_df[overall_offers_df$offer_type != 'informational', ]

# Display the resulting DataFrame
final_overall_offers_df

```
## Individual metrics

```{r}
library(dplyr)

# Assuming 'transcript' is your data frame in R
all_transactions <- transcript %>%
  filter(value_type == 'amount') %>%
  mutate(value = as.numeric(value))

# Display the first few rows
head(all_transactions)

```


```{r}
library(dplyr)
library(tidyr)

df_all_customers <- data.frame(
  person = character(),
  discount_total_offers = numeric(),
  discount_completion_pct = numeric(),
  discount_min_completion_days = numeric(),
  discount_max_completion_days = numeric(),
  discount_completed_offers = numeric(),
  discount_avg_completion_days = numeric(),
  discount_avg_net_reward = numeric(),
  bogo_total_offers = numeric(),
  bogo_completion_pct = numeric(),
  bogo_completed_offers = numeric(),
  bogo_min_completion_days = numeric(),
  bogo_max_completion_days = numeric(),
  bogo_avg_completion_days = numeric(),
  bogo_avg_net_reward = numeric(),
  informational_promotions = numeric(),
  age = numeric(),
  gender = character(),
  income = numeric(),
  member_date = character(),
  total_transactions = numeric(),
  min_transaction_day = numeric(),
  max_transaction_day = numeric(),
  avg_transaction = numeric(),
  total_transaction_amount = numeric(),
  median_days_between_purchases = numeric(),
  avg_days_between_purchases = numeric()
)
for (person in unique(profile$id)) {
  personal_profile <- profile[profile$id == person, c('id', 'age', 'gender', 'income', 'member_date')]
  personal_profile <- rename(personal_profile, person = id)  # Rename 'id' to 'person'
  
  personal_transactions <- all_transactions[all_transactions$person == person, ]
  if (nrow(personal_transactions) > 0) {
    personal_transactions$DaysFromLastPurchase <- c(NA, diff(personal_transactions$time))
    personal_agg_trans <- personal_transactions %>%
      group_by(person) %>%
      summarize(
        total_transactions = n(),
        min_transaction_day = min(time),
        max_transaction_day = max(time),
        avg_transaction = mean(value),
        total_transaction_amount = sum(value),
        median_days_between_purchases = median(DaysFromLastPurchase, na.rm = TRUE),
        avg_days_between_purchases = mean(DaysFromLastPurchase, na.rm = TRUE)
      )
  } else {
    personal_agg_trans <- data.frame(
      person = person,
      total_transactions = NA,
      min_transaction_day = NA,
      max_transaction_day = NA,
      avg_transaction = NA,
      total_transaction_amount = NA,
      median_days_between_purchases = NA,
      avg_days_between_purchases = NA
    )
  }
  
  personal_df_1 <- inner_join(personal_profile, personal_agg_trans, by = 'person')
  
  for (offer_type in c('discount', 'bogo')) {
    offer_df <- offers_final_df %>%
      filter(person == person, offer_type == offer_type) %>%
      group_by(person) %>%
      summarize(
        !!paste0(offer_type, '_total_offers') := n(),
        !!paste0(offer_type, '_completion_pct') := mean(CompletedOffer),
        !!paste0(offer_type, '_completed_offers') := sum(CompletedOffer),
        !!paste0(offer_type, '_min_completion_days') := min(DaysToCompleteOffer),
        !!paste0(offer_type, '_max_completion_days') := max(DaysToCompleteOffer),
        !!paste0(offer_type, '_avg_completion_days') := mean(DaysToCompleteOffer),
        !!paste0(offer_type, '_avg_net_reward') := mean(NetReward)
      )
    if (nrow(offer_df) == 0) {
      offer_df <- data.frame(
        person = person,
        !!paste0(offer_type, '_total_offers') := NA,
        !!paste0(offer_type, '_completion_pct') := NA,
        !!paste0(offer_type, '_completed_offers') := NA,
        !!paste0(offer_type, '_min_completion_days') := NA,
        !!paste0(offer_type, '_max_completion_days') := NA,
        !!paste0(offer_type, '_avg_completion_days') := NA,
        !!paste0(offer_type, '_avg_net_reward') := NA
      )
    }
    
    assign(paste0(offer_type, '_df'), offer_df)
  }
  

  bogo_and_discounts <- inner_join(get(paste0('discount_df')), get(paste0('bogo_df')), by = 'person') %>%
    mutate(informational_promotions = length(offers_final_df[person == person & offer_type == 'informational', ]))
  person_final <- inner_join(bogo_and_discounts, personal_df_1, by = 'person')

  person_final$member_date <- as.character(person_final$member_date)

  df_all_customers <- bind_rows(df_all_customers, person_final)


}

```

```{r}
df_all_customers <- df_all_customers[, c('person', 'discount_total_offers', 'discount_completion_pct',
       'discount_min_completion_days', 'discount_max_completion_days', 'discount_completed_offers',
       'discount_avg_completion_days', 'discount_avg_net_reward',
       'bogo_total_offers', 'bogo_completion_pct', 'bogo_completed_offers', 'bogo_min_completion_days',
       'bogo_max_completion_days', 'bogo_avg_completion_days',
       'bogo_avg_net_reward', 'informational_promotions', 'age', 'gender',
       'income', 'member_date', 'total_transactions', 'min_transaction_day',
       'max_transaction_day', 'avg_transaction', 'total_transaction_amount',
       'median_days_between_purchases', 'avg_days_between_purchases')]

df_all_customers
```
## Final Analysis
```{r}
install.packages("fastDummies")
library(fastDummies)

# Select the relevant columns
X <- df_all_customers[, c('discount_total_offers', 'discount_completion_pct',
                           'discount_min_completion_days', 'discount_max_completion_days', 'discount_completed_offers',
                           'discount_avg_completion_days', 'discount_avg_net_reward',
                           'bogo_total_offers', 'bogo_completion_pct', 'bogo_completed_offers',
                           'bogo_min_completion_days', 'bogo_max_completion_days', 'bogo_avg_completion_days',
                           'bogo_avg_net_reward', 'informational_promotions', 'age', 'gender',
                           'income', 'total_transactions', 'min_transaction_day',
                           'max_transaction_day', 'avg_transaction', 'total_transaction_amount',
                           'median_days_between_purchases', 'avg_days_between_purchases')]

# Replace missing values with 0
X[is.na(X)] <- 0

# Create dummy variables for 'gender'
new_x <- dummy_cols(X, select_columns = 'gender')

```

```{r}

library(flexclust)

features_matrix <- data.matrix(new_x)
features_matrix[is.na(features_matrix)] <- colMeans(features_matrix, na.rm = TRUE)
features_matrix[!is.finite(features_matrix)] <- 0

if (any(!is.finite(features_matrix))) {
  print("There are still non-finite values in the matrix.")
} else {
  k_values <- 1:10
  sse_values <- sapply(k_values, function(k) kmeans(features_matrix, centers = k)$tot.withinss)

  # Plot the SSE vs. K
  plot(k_values, sse_values, type = "b", pch = 19, col = "blue",
       xlab = "K", ylab = "SSE", main = "SSE vs. K")
}

```
```{r}
df_all_customers[is.na(df_all_customers)] <- 0

columns_to_use <- c('discount_total_offers', 'discount_completion_pct',
                    'discount_min_completion_days', 'discount_max_completion_days', 'discount_completed_offers',
                    'discount_avg_completion_days', 'discount_avg_net_reward',
                    'bogo_total_offers', 'bogo_completion_pct', 'bogo_completed_offers',
                    'bogo_min_completion_days', 'bogo_max_completion_days', 'bogo_avg_completion_days',
                    'bogo_avg_net_reward', 'informational_promotions', 'age', 'gender',
                    'income', 'total_transactions', 'min_transaction_day',
                    'max_transaction_day', 'avg_transaction', 'total_transaction_amount',
                    'median_days_between_purchases', 'avg_days_between_purchases')

X <- df_all_customers[, columns_to_use]

X <- cbind(X, model.matrix(~gender - 1, data = df_all_customers))

set.seed(123)

hc <- hclust(dist(X), method = "ward.D2")

cluster_labels <- cutree(hc, k = 4)
df_all_customers$Cluster_4 <- as.factor(cluster_labels)
```
```{r}
head(df_all_customers)

```
```{r}
cluster_counts <- table(df_all_customers$Cluster_4)

cluster_relative_frequencies <- prop.table(cluster_counts)
print(cluster_relative_frequencies)
```

```{r}

library(ggplot2)

visual_columns <- c('age', 'income', 'total_transactions', 'avg_transaction', 'total_transaction_amount')

df_all_customers[is.na(df_all_customers)] <- 0

for (cluster in unique(df_all_customers$Cluster_4)) {
  cluster_data <- df_all_customers[df_all_customers$Cluster_4 == cluster, ]
  png(paste("cluster_", cluster, "_scatterplot.png", sep = ""))
  pairs(cluster_data[visual_columns], col = cluster)
  dev.off()
}

```

```{r}
library(ggplot2)
library(gridExtra)

visual_columns <- c('age', 'income', 'total_transactions', 'avg_transaction', 'total_transaction_amount')
df_all_customers[is.na(df_all_customers)] <- 0

scatterplots <- lapply(unique(df_all_customers$Cluster_4), function(cluster) {
  cluster_data <- df_all_customers[df_all_customers$Cluster_4 == cluster, ]
  pairs(cluster_data[visual_columns], col = cluster)
})

grid.arrange(grobs = scatterplots, ncol = 2)
```
```{r}
visual_columns <- c('discount_completion_pct', 'bogo_completion_pct', 'total_transactions', 'total_transaction_amount', 'median_days_between_purchases', 'Cluster_4')

df_all_customers[is.na(df_all_customers)] <- 0

scatterplots <- lapply(unique(df_all_customers$Cluster_4), function(cluster) {
  cluster_data <- df_all_customers[df_all_customers$Cluster_4 == cluster, ]
  pairs(cluster_data[visual_columns], col = cluster)
})

grid.arrange(grobs = scatterplots, ncol = 2)

```
```{r}
visual_columns <- c('total_transaction_amount', 'total_transactions', 'Cluster_4')

df_all_customers[is.na(df_all_customers)] <- 0

library(GGally)

ggpairs(df_all_customers[visual_columns], mapping = aes(color = Cluster_4))

```
```{r}
visual_columns <- c('total_transaction_amount', 'total_transactions', 'Cluster_4')

df_all_customers[is.na(df_all_customers)] <- 0

library(ggplot2)

ggplot(df_all_customers, aes(x = total_transaction_amount, y = total_transactions, color = as.factor(Cluster_4))) +
  geom_point(size = 3) +
  labs(title = "Scatterplot of Total Transaction Amount vs. Total Transactions",
       x = "Total Transaction Amount",
       y = "Total Transactions") +
  theme_minimal() +
  theme(legend.position = "top") +
  scale_color_discrete(name = "Cluster")

```

```{r}
visual_columns <- c('median_days_between_purchases', 'total_transaction_amount', 'Cluster_4')
df_all_customers[is.na(df_all_customers)] <- 0

library(ggplot2)

ggplot(df_all_customers, aes(x = median_days_between_purchases, y = total_transaction_amount, color = as.factor(Cluster_4))) +
  geom_point(size = 3) +
  labs(title = "Scatterplot of Median Days Between Purchases vs. Total Transaction Amount",
       x = "Median Days Between Purchases",
       y = "Total Transaction Amount") +
  theme_minimal() +
  theme(legend.position = "top") +
  scale_color_discrete(name = "Cluster")

```
```{r}
visual_columns <- c('income', 'Cluster_4')


ggplot(df_all_customers, aes(x = income, y = as.factor(Cluster_4), color = as.factor(Cluster_4))) +
  geom_point(size = 3) +
  labs(title = "Scatterplot of Income vs. Cluster",
       x = "Income",
       y = "Cluster") +
  theme_minimal() +
  theme(legend.position = "top") +
  scale_color_discrete(name = "Cluster")
```


```{r}
library(dplyr)

merged_df <- inner_join(offers_final_df, df_all_customers[, c('person', 'Cluster_4')], by = 'person')

clust_offer_aggs <- merged_df %>%
  group_by(Cluster_4, offer_type, difficulty, reward, .drop = FALSE) %>%
  summarize(
    CompletedOffers = mean(CompletedOffer),
    TotalCompletions = sum(CompletedOffer),
    AvgDaysToCompleteOffer = mean(DaysToCompleteOffer, na.rm = TRUE),
    NetReward = max(NetReward),
    .groups = 'keep'
  ) %>%
  filter(offer_type != 'informational') %>%
  rename(
    Cluster_4 = Cluster_4,
    offer_type = offer_type,
    difficulty = difficulty,
    reward = reward,
    CompletedOffers = CompletedOffers,
    TotalCompletions = TotalCompletions,
    AvgDaysToCompleteOffer = AvgDaysToCompleteOffer,
    NetReward = NetReward
  )

clust_offer_aggs

```


```{r}
library(dplyr)
final_comparisons <- inner_join(
  clust_offer_aggs,
  final_overall_offers_df %>% select(offer_type, difficulty, reward, CompletedOffers),
  by = c('offer_type', 'difficulty', 'reward')
) %>%
  arrange(Cluster_4, offer_type, difficulty, reward)

colnames(final_comparisons) <- c('Cluster_4', 'offer_type', 'difficulty', 'reward', 'ClusterCompletedOffers',
                                  'TotalCompletions', 'AvgDaysToCompleteOffer', 'NetReward',
                                  'AvgCompletedOffers')

bogo_or_discount <- function(row) {


  cluster_val <- as.numeric(row['ClusterCompletedOffers'])
  avg_val <- as.numeric(row['AvgCompletedOffers'])

  if (!is.na(cluster_val) && !is.na(avg_val) && cluster_val + 0.05 > avg_val) {
    return('discount')
  } else {
    return('bogo')
  }
}

final_comparisons$BOGO_or_Discount <- apply(final_comparisons, 1, bogo_or_discount)

result <- final_comparisons %>%
  select(c('Cluster_4', 'offer_type', 'difficulty', 'reward',
           'ClusterCompletedOffers', 'AvgCompletedOffers', 'BOGO_or_Discount')) %>%
  arrange(Cluster_4, offer_type, difficulty, reward) %>%
  arrange(Cluster_4, offer_type, difficulty, reward)

print(result)

```