Top Product Category Total Sales Bar
Chart
Exploring top product category by total sales with income group. This
shows the demographic of top items in terms of sales to see which income
group purchase the most in each of the top category.
library(tidyverse)
library(ggplot2)
library(scales)
library(dplyr)
library(completejourney)
df <- transactions_sample %>%
inner_join(products) %>%
inner_join(demographics)
Joining with `by = join_by(product_id)`Joining with `by = join_by(household_id)`
# total sales
df_top <- df %>%
group_by(income, product_category) %>%
summarize(total_sales = sum(sales_value, na.rm = TRUE), .groups = "drop") %>%
arrange(desc(total_sales)) %>%
group_by(income) %>%
slice_head(n = 4)
# plot
ggplot(df_top, aes(x = reorder(product_category, total_sales), y = total_sales, fill = income)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_y_continuous(labels = label_comma()) +
labs(title = "Top Product Category by Income Group",
x = "Product Category",
y = "Total Sales",
fill = "Income Group") +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text.y = element_text(size = 10),
axis.title = element_text(size = 12),
axis.title.y = element_text(margin = margin(r = 20))
)

National vs Private Brand Bar
Chart
Since the above chart shows the top product category is soft drinks
(coupon misc not included), we can dig deeper into what brand generate
more sales, National or Private.
df_soft_drinks <- df %>%
filter(product_category == "SOFT DRINKS") %>%
group_by(brand) %>% # Group by brand
summarize(total_sales = sum(sales_value, na.rm = TRUE)) %>%
arrange(desc(total_sales))
# bar plot
ggplot(df_soft_drinks, aes(x = reorder(brand, total_sales), y = total_sales, fill = brand)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_y_continuous(labels = label_comma()) +
labs(title = "National versus Private Brand for SOFT DRINKS",
x = "Brand",
y = "Total Sales",
fill = "Brand") +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text.y = element_text(size = 10),
axis.title.y = element_text(margin = margin(r = 20)),
axis.title.x = element_text(margin = margin(t = 20))
)

Day of the Week Total Sales
Scatteplot
From the scatterplot, you can easily see which day of the week has
the most sales and compare married and unmarried total sales.
dt <- transactions_sample %>%
inner_join(products) %>%
inner_join(demographics)
Joining with `by = join_by(product_id)`Joining with `by = join_by(household_id)`
# data
dt <- transactions_sample %>%
inner_join(products) %>%
inner_join(demographics) %>%
mutate(
day_of_week = weekdays(as.Date(transaction_timestamp)),
day_of_week = factor(day_of_week, levels = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")),
sales_value = as.numeric(sales_value)
) %>%
group_by(day_of_week, marital_status) %>%
summarise(total_sales_value = sum(sales_value, na.rm = TRUE))
Joining with `by = join_by(product_id)`Joining with `by = join_by(household_id)``summarise()` has grouped output by 'day_of_week'. You can override using the `.groups` argument.
# scatterplot
ggplot(dt %>% filter(!is.na(marital_status)), aes(x = day_of_week, y = total_sales_value, color = marital_status)) +
geom_point(size = 4, alpha = 0.7) +
scale_y_continuous(labels = scales::comma) +
scale_color_manual(values = c("Married" = "forestgreen", "Unmarried" = "purple")) +
labs(
x = "Day of Week",
y = "Total Sales Value",
title = "Total Sales by Day of the Week",
subtitle = "Data shows total sales value split into day of the week with comparison of marrital status",
color = "Marital Status"
) +
theme_minimal() +
theme(
axis.title.x = element_text(margin = margin(t = 20)),
axis.title.y = element_text(margin = margin(r = 20)),
)

LS0tDQp0aXRsZTogIk1vZHVsZSA1IFZpc3VhbGl6YXRpb24gTGFiOiBRdXluaCBUcmFuIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KDQojIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjojOTJDNURFOyI+IFRvcCBQcm9kdWN0IENhdGVnb3J5IFRvdGFsIFNhbGVzIEJhciBDaGFydDwvc3Bhbj4NCg0KRXhwbG9yaW5nIHRvcCBwcm9kdWN0IGNhdGVnb3J5IGJ5IHRvdGFsIHNhbGVzIHdpdGggaW5jb21lIGdyb3VwLiBUaGlzIHNob3dzIHRoZSBkZW1vZ3JhcGhpYyBvZiB0b3AgaXRlbXMgaW4gdGVybXMgb2Ygc2FsZXMgdG8gc2VlIHdoaWNoIGluY29tZSBncm91cCBwdXJjaGFzZSB0aGUgbW9zdCBpbiBlYWNoIG9mIHRoZSB0b3AgY2F0ZWdvcnkuDQoNCmBgYHtyfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHNjYWxlcykgDQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShjb21wbGV0ZWpvdXJuZXkpDQoNCmRmIDwtIHRyYW5zYWN0aW9uc19zYW1wbGUgJT4lDQogIGlubmVyX2pvaW4ocHJvZHVjdHMpICU+JSAgIA0KICBpbm5lcl9qb2luKGRlbW9ncmFwaGljcykNCg0KDQojIHRvdGFsIHNhbGVzDQpkZl90b3AgPC0gZGYgJT4lDQogIGdyb3VwX2J5KGluY29tZSwgcHJvZHVjdF9jYXRlZ29yeSkgJT4lDQogIHN1bW1hcml6ZSh0b3RhbF9zYWxlcyA9IHN1bShzYWxlc192YWx1ZSwgbmEucm0gPSBUUlVFKSwgLmdyb3VwcyA9ICJkcm9wIikgJT4lDQogIGFycmFuZ2UoZGVzYyh0b3RhbF9zYWxlcykpICU+JQ0KICBncm91cF9ieShpbmNvbWUpICU+JQ0KICBzbGljZV9oZWFkKG4gPSA0KSANCg0KIyBwbG90DQpnZ3Bsb3QoZGZfdG9wLCBhZXMoeCA9IHJlb3JkZXIocHJvZHVjdF9jYXRlZ29yeSwgdG90YWxfc2FsZXMpLCB5ID0gdG90YWxfc2FsZXMsIGZpbGwgPSBpbmNvbWUpKSArDQogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiKSArDQogIGNvb3JkX2ZsaXAoKSArIA0KICBzY2FsZV95X2NvbnRpbnVvdXMobGFiZWxzID0gbGFiZWxfY29tbWEoKSkgKyANCiAgbGFicyh0aXRsZSA9ICJUb3AgUHJvZHVjdCBDYXRlZ29yeSBieSBJbmNvbWUgR3JvdXAiLA0KICAgICAgIHggPSAiUHJvZHVjdCBDYXRlZ29yeSIsDQogICAgICAgeSA9ICJUb3RhbCBTYWxlcyIsDQogICAgICAgZmlsbCA9ICJJbmNvbWUgR3JvdXAiKSArDQogIHRoZW1lX21pbmltYWwoKSArDQogIHRoZW1lKA0KICAgIGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSksICANCiAgICBheGlzLnRleHQueSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTApLCAgDQogICAgYXhpcy50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTIpLCAgDQogICAgYXhpcy50aXRsZS55ID0gZWxlbWVudF90ZXh0KG1hcmdpbiA9IG1hcmdpbihyID0gMjApKSAgDQogICkNCmBgYA0KDQojIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjojOTJDNURFOyI+TmF0aW9uYWwgdnMgUHJpdmF0ZSBCcmFuZCBCYXIgQ2hhcnQ8L3NwYW4+DQoNClNpbmNlIHRoZSBhYm92ZSBjaGFydCBzaG93cyB0aGUgdG9wIHByb2R1Y3QgY2F0ZWdvcnkgaXMgc29mdCBkcmlua3MgKGNvdXBvbiBtaXNjIG5vdCBpbmNsdWRlZCksIHdlIGNhbiBkaWcgZGVlcGVyIGludG8gd2hhdCBicmFuZCBnZW5lcmF0ZSBtb3JlIHNhbGVzLCBOYXRpb25hbCBvciBQcml2YXRlLiANCg0KYGBge3J9DQpkZl9zb2Z0X2RyaW5rcyA8LSBkZiAlPiUNCiAgZmlsdGVyKHByb2R1Y3RfY2F0ZWdvcnkgPT0gIlNPRlQgRFJJTktTIikgJT4lDQogIGdyb3VwX2J5KGJyYW5kKSAlPiUgICMgR3JvdXAgYnkgYnJhbmQNCiAgc3VtbWFyaXplKHRvdGFsX3NhbGVzID0gc3VtKHNhbGVzX3ZhbHVlLCBuYS5ybSA9IFRSVUUpKSAlPiUNCiAgYXJyYW5nZShkZXNjKHRvdGFsX3NhbGVzKSkgIA0KDQojIGJhciBwbG90DQpnZ3Bsb3QoZGZfc29mdF9kcmlua3MsIGFlcyh4ID0gcmVvcmRlcihicmFuZCwgdG90YWxfc2FsZXMpLCB5ID0gdG90YWxfc2FsZXMsIGZpbGwgPSBicmFuZCkpICsNCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIpICsgIA0KICBjb29yZF9mbGlwKCkgKyANCiAgc2NhbGVfeV9jb250aW51b3VzKGxhYmVscyA9IGxhYmVsX2NvbW1hKCkpICsgDQogIGxhYnModGl0bGUgPSAiTmF0aW9uYWwgdmVyc3VzIFByaXZhdGUgQnJhbmQgZm9yIFNPRlQgRFJJTktTIiwNCiAgICAgICB4ID0gIkJyYW5kIiwNCiAgICAgICB5ID0gIlRvdGFsIFNhbGVzIiwNCiAgICAgICBmaWxsID0gIkJyYW5kIikgKw0KICB0aGVtZV9taW5pbWFsKCkgKw0KICB0aGVtZSgNCiAgICBheGlzLnRleHQueCA9IGVsZW1lbnRfdGV4dChhbmdsZSA9IDQ1LCBoanVzdCA9IDEpLCAgDQogICAgYXhpcy50ZXh0LnkgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDEwKSwgIA0KICAgIGF4aXMudGl0bGUueSA9IGVsZW1lbnRfdGV4dChtYXJnaW4gPSBtYXJnaW4ociA9IDIwKSksICANCiAgICBheGlzLnRpdGxlLnggPSBlbGVtZW50X3RleHQobWFyZ2luID0gbWFyZ2luKHQgPSAyMCkpICAgDQogICkNCmBgYA0KDQoNCg0KDQoNCiMjIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiM5MkM1REU7Ij4gRGF5IG9mIHRoZSBXZWVrIFRvdGFsIFNhbGVzIFNjYXR0ZXBsb3Q8L3NwYW4+DQoNCkZyb20gdGhlIHNjYXR0ZXJwbG90LCB5b3UgY2FuIGVhc2lseSBzZWUgd2hpY2ggZGF5IG9mIHRoZSB3ZWVrIGhhcyB0aGUgbW9zdCBzYWxlcyBhbmQgY29tcGFyZSBtYXJyaWVkIGFuZCB1bm1hcnJpZWQgdG90YWwgc2FsZXMuIA0KDQpgYGB7cn0NCmR0IDwtIHRyYW5zYWN0aW9uc19zYW1wbGUgJT4lDQogIGlubmVyX2pvaW4ocHJvZHVjdHMpICU+JQ0KICBpbm5lcl9qb2luKGRlbW9ncmFwaGljcykNCg0KIyBkYXRhDQpkdCA8LSB0cmFuc2FjdGlvbnNfc2FtcGxlICU+JQ0KICBpbm5lcl9qb2luKHByb2R1Y3RzKSAlPiUNCiAgaW5uZXJfam9pbihkZW1vZ3JhcGhpY3MpICU+JQ0KICBtdXRhdGUoDQogICAgZGF5X29mX3dlZWsgPSB3ZWVrZGF5cyhhcy5EYXRlKHRyYW5zYWN0aW9uX3RpbWVzdGFtcCkpLCANCiAgICBkYXlfb2Zfd2VlayA9IGZhY3RvcihkYXlfb2Zfd2VlaywgbGV2ZWxzID0gYygiU3VuZGF5IiwgIk1vbmRheSIsICJUdWVzZGF5IiwgIldlZG5lc2RheSIsICJUaHVyc2RheSIsICJGcmlkYXkiLCAiU2F0dXJkYXkiKSksDQogICAgc2FsZXNfdmFsdWUgPSBhcy5udW1lcmljKHNhbGVzX3ZhbHVlKSANCiAgKSAlPiUNCiAgZ3JvdXBfYnkoZGF5X29mX3dlZWssIG1hcml0YWxfc3RhdHVzKSAlPiUNCiAgc3VtbWFyaXNlKHRvdGFsX3NhbGVzX3ZhbHVlID0gc3VtKHNhbGVzX3ZhbHVlLCBuYS5ybSA9IFRSVUUpKSANCg0KIyBzY2F0dGVycGxvdA0KZ2dwbG90KGR0ICU+JSBmaWx0ZXIoIWlzLm5hKG1hcml0YWxfc3RhdHVzKSksIGFlcyh4ID0gZGF5X29mX3dlZWssIHkgPSB0b3RhbF9zYWxlc192YWx1ZSwgY29sb3IgPSBtYXJpdGFsX3N0YXR1cykpICsNCiAgZ2VvbV9wb2ludChzaXplID0gNCwgYWxwaGEgPSAwLjcpICsNCiAgc2NhbGVfeV9jb250aW51b3VzKGxhYmVscyA9IHNjYWxlczo6Y29tbWEpICsgDQogIHNjYWxlX2NvbG9yX21hbnVhbCh2YWx1ZXMgPSBjKCJNYXJyaWVkIiA9ICJmb3Jlc3RncmVlbiIsICJVbm1hcnJpZWQiID0gInB1cnBsZSIpKSArDQogIGxhYnMoDQogICAgeCA9ICJEYXkgb2YgV2VlayIsIA0KICAgIHkgPSAiVG90YWwgU2FsZXMgVmFsdWUiLCANCiAgICB0aXRsZSA9ICJUb3RhbCBTYWxlcyBieSBEYXkgb2YgdGhlIFdlZWsiLA0KICAgIHN1YnRpdGxlID0gIkRhdGEgc2hvd3MgdG90YWwgc2FsZXMgdmFsdWUgc3BsaXQgaW50byBkYXkgb2YgdGhlIHdlZWsgd2l0aCBjb21wYXJpc29uIG9mIG1hcnJpdGFsIHN0YXR1cyIsDQogICAgY29sb3IgPSAiTWFyaXRhbCBTdGF0dXMiDQogICkgKw0KICB0aGVtZV9taW5pbWFsKCkgKw0KICB0aGVtZSgNCiAgICBheGlzLnRpdGxlLnggPSBlbGVtZW50X3RleHQobWFyZ2luID0gbWFyZ2luKHQgPSAyMCkpLCAgDQogICAgYXhpcy50aXRsZS55ID0gZWxlbWVudF90ZXh0KG1hcmdpbiA9IG1hcmdpbihyID0gMjApKSwNCg0KKQ0KDQpgYGANCg0KDQoNCg0KDQoNCg0K