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