Nick Enouen Midterm Project Report - Final Draft
Nick Enouen
2024-10-13
How Regork Can Increase Sales to Larger Households
Introduction
The key business problem being addressed throughout this report is how to best capitalize on the potential value larger households could provide. The company currently does not fully capture all value offered by its current large household customer base and could potentially grow this demographic. Sales for each product were grouped by household size and analyzed. This allowed for potential value within the demographic to be shown. Product type sales were compared between household sizes to show potential new sales. I believe that this company could increase its sales to its current larger household customer base and increase its overall customer base in this demographic by creating new deals and changing how certain products are sold.
# Libraries
suppressWarnings(suppressMessages(library(tidyverse))) #Relatively Standard R Packages to improve
suppressWarnings(suppressMessages(library(lubridate))) # plotting, dataframe use, and dealing with
suppressWarnings(suppressMessages(library(ggplot2))) # time.
suppressWarnings(suppressMessages(library(completejourney)))# Provides data.
suppressWarnings(suppressMessages(library(cowplot))) # Allows easy plotting of multiple plots.Exploratory Data Analysis
# Load Datatables
transactions <- get_transactions()
demo_tran <- inner_join(demographics, transactions)## Joining with `by = join_by(household_id)`total_df <- left_join(demo_tran, products)## Joining with `by = join_by(product_id)`total_df <- total_df %>% select(-package_size, -brand, )
str(total_df)## tibble [828,850 × 22] (S3: tbl_df/tbl/data.frame)
## $ household_id : chr [1:828850] "1" "1" "1" "1" ...
## $ age : Ord.factor w/ 6 levels "19-24"<"25-34"<..: 6 6 6 6 6 6 6 6 6 6 ...
## $ income : Ord.factor w/ 12 levels "Under 15K"<"15-24K"<..: 4 4 4 4 4 4 4 4 4 4 ...
## $ home_ownership : Ord.factor w/ 5 levels "Renter"<"Probable Renter"<..: 3 3 3 3 3 3 3 3 3 3 ...
## $ marital_status : Ord.factor w/ 3 levels "Married"<"Unmarried"<..: 1 1 1 1 1 1 1 1 1 1 ...
## $ household_size : Ord.factor w/ 5 levels "1"<"2"<"3"<"4"<..: 2 2 2 2 2 2 2 2 2 2 ...
## $ household_comp : Ord.factor w/ 5 levels "1 Adult Kids"<..: 4 4 4 4 4 4 4 4 4 4 ...
## $ kids_count : Ord.factor w/ 5 levels "0"<"1"<"2"<"3+"<..: 1 1 1 1 1 1 1 1 1 1 ...
## $ store_id : chr [1:828850] "436" "436" "436" "436" ...
## $ basket_id : chr [1:828850] "31317046240" "31317046240" "31317046240" "31317046240" ...
## $ product_id : chr [1:828850] "823721" "832990" "854920" "856942" ...
## $ quantity : num [1:828850] 1 2 1 1 1 1 1 1 1 1 ...
## $ sales_value : num [1:828850] 2.99 5.98 1.49 2.99 0.59 2.5 0.34 2.42 3.59 1.69 ...
## $ retail_disc : num [1:828850] 0 0 0 0 0 0.89 0 0 0 0 ...
## $ coupon_disc : num [1:828850] 0 0 0 0 0 0 0 0 0 0 ...
## $ coupon_match_disc : num [1:828850] 0 0 0 0 0 0 0 0 0 0 ...
## $ week : int [1:828850] 2 2 2 2 2 2 2 2 2 2 ...
## $ transaction_timestamp: POSIXct[1:828850], format: "2017-01-07 13:55:24" "2017-01-07 13:55:24" ...
## $ manufacturer_id : chr [1:828850] "317" "1266" "1251" "159" ...
## $ department : chr [1:828850] "GROCERY" "GROCERY" "GROCERY" "GROCERY" ...
## $ product_category : chr [1:828850] "CHEESE" "MOLASSES/SYRUP/PANCAKE MIXS" "SOUP" "BAKED BREAD/BUNS/ROLLS" ...
## $ product_type : chr [1:828850] "GRATED CHEESE" "MOLASSES & SYRUPS" "CONDENSED SOUP" "FRUIT/BREAKFAST BREAD" ...Simply loading the data and creating a total dataframe containing most of the necessary demographic, transaction, and product information.
pct_hh <- demographics %>%
group_by(household_size) %>%
summarize(count = n()) %>%
mutate(percentage = count / sum(count) * 100)
p1 <- ggplot(pct_hh, aes(x = "", y = count, fill = household_size)) +
geom_bar(stat = "identity", width = 1) +
geom_text(aes(label = paste0(round(percentage, 1), "%")), position = position_stack(vjust = 0.5), color = "white", size = 3) +
coord_polar("y") +
ggtitle("Customer Base by Household Size")
pct_tran <- total_df %>%
group_by(household_size) %>%
summarize(total_sales = sum(sales_value)) %>%
mutate(percentage = total_sales / sum(total_sales) * 100)
p2 <- ggplot(pct_tran, aes(x = household_size, y = total_sales)) +
geom_bar(stat = "identity") +
ggtitle("Sales from Each Household Size") +
xlab("Household Size") +
ylab("Total Sales") +
geom_text(aes(label = round(total_sales, 2), vjust = -.5), size = 3)
plot_grid(p1)
p3 <- ggplot(pct_tran, aes(x= "", y = total_sales, fill = household_size)) +
geom_bar(stat = "identity", width = 1) +
geom_text(aes(label = paste0(round(percentage, 1), "%")), position = position_stack(vjust = 0.5), color = "white", size = 2) +
coord_polar("y") +
ggtitle("Total Sales by Household Size")
plot_grid(p2, p3, ncol = 2)
These initial plots compares our 5+ household size customer base to our
5+ household size sales. While the average American household size is
only 2.5 with a standard deviation of 1.4 people, larger households are
becoming more rare but still exist and should have larger sales value
per transaction due to their larger household size, making this a
valuable demographic. While the demographic makes up 8.2% of households,
they only account for 9.7% of total sales. There is potential to
increase the number of sales within this demographic.
quan_df <- total_df %>%
filter(product_category != "COUPON/MISC ITEMS" & product_category != "FUEL") %>%
filter(quantity > 0) %>%
group_by(household_size) %>%
summarise(avg_qty = mean(quantity), total_qty_per = sum(quantity))
ggplot(quan_df, aes(x = household_size, y = avg_qty)) +
geom_bar(stat = "identity") +
ggtitle("Average Quantity per Transaction") +
xlab("Household Size") +
ylab("Average Quantity") +
geom_text(aes(label = round(avg_qty, 2), vjust = -.5))
Transactions to household sizes of 5+ transactions averaged a higher
quantity of items per transaction. This reinforces the idea that there
is potential value if we can increase this demographic.
s_df <- total_df %>%
group_by(household_size, week) %>%
summarize(total_sales = sum(sales_value, na.rm = TRUE))## `summarise()` has grouped output by 'household_size'. You can override using
## the `.groups` argument.ggplot(s_df, aes(x = week, y = total_sales, color = household_size, group = household_size)) +
geom_line(size = 1) +
geom_point(size = 2) +
ggtitle("Sales Per Week by Household Size") +
xlab("Week") +
ylab("Sales")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
The total sales to households of this size recently dropped to about
equal with households of 4. This reinforces the idea that this company
could be performing better in this demographic.
numh5_income <- demographics %>%
filter(household_size == "5+")
ggplot(numh5_income, aes(x = income)) +
geom_bar() +
ggtitle("Number of 5+ Person Households per Each Income Range") +
xlab("Income") +
ylab("Number of Households")
This income distribution for households of five or more shows that there
may not be much extra disposable income in this demographic relative to
other demographics, meaning the solution to this lack of sales will not
come from trying to sell extraneous products, but rather offering deals
and increasing our market share in specific products and
necessities.
tdf <- total_df %>%
mutate(lhh_sales_value = ifelse(household_size == "5+", sales_value, 0)) %>%
group_by(product_type) %>%
summarise(total_sales = sum(sales_value), total_lhh_sales = sum(lhh_sales_value)) %>%
arrange(desc(total_sales))
tdft <- tdf %>%
slice_head(n = 10)
tdf5 <- tdf %>%
arrange(desc(total_lhh_sales)) %>%
slice_head(n = 10)
p1 <- ggplot(tdft, aes(x = product_type, y = total_sales)) +
geom_bar(stat = "identity") +
ggtitle("Best Selling Products Overall") +
xlab("Product") +
ylab("Total Sales") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
p2 <- ggplot(tdf5, aes(x = product_type, y = total_lhh_sales)) +
geom_bar(stat = "identity") +
ggtitle("Best Selling to Households of 5+") +
xlab("Product") +
ylab("Sales to Households of 5+") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
plot_grid(p1, p2, ncol = 2)
This plot shows the top selling product types overall and to households
of five or more. The plots are mostly similar, with gasoline and white
milk offering the largest total sales for each category and many entries
of the top tens being the same. One key difference is the inclusion of
Kid’s Cereal in Households of 5+. This recognizes a key product type for
this demographic.
pct_df <- total_df %>%
mutate(lhh_sales_value = ifelse(household_size == "5+", sales_value, 0)) %>%
group_by(product_type) %>%
summarise(total_sales = sum(sales_value), total_lhh_sales = sum(lhh_sales_value)) %>%
arrange(desc(total_sales)) %>%
mutate(pct_sales = ifelse(total_sales > 0, total_lhh_sales / total_sales, 0)) %>%
filter(total_sales > 1000)
pct_df_small <- pct_df %>%
arrange(pct_sales) %>%
slice_head(n = 15)
pct_df_big <- pct_df %>%
arrange(desc(pct_sales)) %>%
slice_head(n = 15)
p1 <- ggplot(pct_df_small, aes(x = product_type, y = pct_sales)) +
geom_line(stat = "identity") +
ggtitle("Products that Don't Sell to 5+ Households") +
xlab("Product") +
ylab("Percent of Sales to HH of 5+") +
geom_text(aes(label = (round(pct_sales, 4) * 100), vjust = -.5), size = 2) +
ylim(0, 0.03) +
geom_point(size = 2) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 4))
p2 <- ggplot(pct_df_big, aes(x = product_type, y = pct_sales)) +
geom_line(stat = "identity") +
ggtitle("Products that Do Sell to 5+ Households") +
xlab("Product") +
ylab("Percent of Sales to HH of 5+") +
geom_text(aes(label = (round(pct_sales, 4) * 100), vjust = -.5), size = 2) +
ylim(0, 0.6) +
geom_point(size = 2) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 4))
plot_grid(p1, p2, ncol = 2) ## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
This plot shows the highest percentages of total sales and lowest
percentages of total sales by product type made from households of five
or more. While milk is one of the largest sellers overall and to this
demographic, sales to this demographic only represent 0.84% of total
Fluid Milk sales. There is room to increase the amount of sales, and the
lack of sales of yogurt to this demographic could help identify a
problem that this demographic is having with our dairy department. This
demographic buys plenty of other perishables such as clementines and
raspberries, and tomato cherries, which could help identify a solution.
## Summary A problem that the company currently faces is that it does
not fully capture all value offered by its current large household
customer base. This report shows the value within this demographic as
well as products that could perform better within this demographic,
offering a potential increase in sales. Fluid Milk should be a better
seller to this demographic. Gasoline is a necessary part of this
company’s sales to all demographics. There is not much disposable income
within this demographic. I believe that Regork should attempt to sell
more to households of five or more as they currently do not fully
capture this demographics value. This demographic does not have a
plethora of disposable income, and its current highest selling products
include necessities such as gasoline, milk, diapers, and cereal. I
believe we should offer deals on milk of all varieties, cereal, and
gasoline to satisfy demand for this demographic and increase sales. I
believe the dairy section of the stores could use investing to ensure to
all customers that our dairy products are of the highest quality,
helping maintain and grow our market share in this product, specifically
in but not limited to this demographic. There are limitations to this
report. I have no information as to why regork lacks sales to this
demographic, especially in certain products, I just believe they should
be higher. The lack of sales could be due to competition, but ensuring
the quality of certain high selling products is never a bad idea.