{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.0.5"}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"markdown","source":"# H&M Rule Base Solution in R\n\nMy solution based on ideas from these notebooks:\n\n- https://www.kaggle.com/code/cdeotte/recommend-items-purchased-together-0-021\n- https://www.kaggle.com/code/byfone/h-m-trending-products-weekly\n- https://www.kaggle.com/code/hechtjp/h-m-eda-rule-base-by-customer-age","metadata":{}},{"cell_type":"code","source":"library(tidyverse)","metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"transaction_train <- read_csv(\"../input/h-and-m-personalized-fashion-recommendations/transactions_train.csv\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"K <- 12\n\nmax_dat <- max(transaction_train$t_dat)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## 1. Recommend Purchased Items Scored by Recent Activities","metadata":{}},{"cell_type":"code","source":"n_weeks <- 8\n\ntransaction_weeks <- transaction_train %>%\n  mutate(week = lubridate::ceiling_date(t_dat, unit = \"week\", change_on_boundary = FALSE)) %>%\n  filter(t_dat > max_dat - n_weeks * 7)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"transaction_weeks %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"weekly_sales <- transaction_weeks %>%\n  count(week, article_id, name = \"count\")\n\nlast_week_sales <- weekly_sales %>%\n  filter(week == max(week)) %>%\n  select(article_id, count_targ = count)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"half_life <- 4","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Decay","metadata":{}},{"cell_type":"code","source":"curve(0.5 ^ (days / half_life), 0, 100, xname = \"days\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Note: I forgot to use `quotient` value!\n\nTo be correct, `value = quotient * 0.5 ^ (days / half_life))`","metadata":{}},{"cell_type":"code","source":"transaction_sales <- transaction_weeks %>%\n  inner_join(weekly_sales, by = c(\"week\", \"article_id\")) %>%\n  left_join(last_week_sales, by = c(\"article_id\")) %>%\n  mutate(count_targ = replace_na(count_targ, 0)) %>%\n  mutate(quotient = count_targ / count) %>%\n  mutate(days = as.numeric(max_dat - t_dat)) %>%\n  mutate(value = 0.5 ^ (days / half_life))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"transaction_sales %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"cutoff_score <- 0.01","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"scored_customer_purchases <- transaction_sales %>%\n  group_by(customer_id, article_id) %>%\n  summarise(score = sum(value), .groups = \"drop\") %>%\n  filter(score > cutoff_score)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"scored_customer_purchases %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## 2. Recommend Items Purchased Together","metadata":{}},{"cell_type":"code","source":"days_train <- 7\n\ncustomer_article <- transaction_train %>%\n  filter(t_dat > max_dat - days_train) %>%\n  distinct(customer_id, article_id)\n\npurchased_together_counts <- customer_article %>%\n  inner_join(customer_article, by = \"customer_id\", suffix = c(\"1\", \"2\")) %>%\n  filter(article_id1 != article_id2) %>%\n  count(article_id1, article_id2, name = \"count\") %>%\n  filter(count > 1)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"purchased_together_counts %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"cutoff_total <- 10\n\npurchased_together_rates <- purchased_together_counts %>%\n  inner_join(count(customer_article, article_id, name = \"total\"),\n             by = c(\"article_id1\" = \"article_id\")) %>%\n  mutate(rate = count / total) %>%\n  filter(total > cutoff_total) %>%\n  group_by(article_id1) %>%\n  slice_max(order_by = rate, n = K, with_ties = FALSE)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"purchased_together_rates %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## 3. Recommend Popular Items","metadata":{}},{"cell_type":"markdown","source":"### 3.1. Ages","metadata":{}},{"cell_type":"code","source":"customers <- read_csv(\"../input/h-and-m-personalized-fashion-recommendations/customers.csv\") %>%\n  select(customer_id, age)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"bin_breaks <- c(-1, 20, 30, 40, 50, 60, 120)\n\ncustomer_bins <- customers %>%\n  mutate(age_bin = cut(age, breaks = bin_breaks))\n\nmode_bin <- customer_bins %>%\n  count(age_bin, sort = TRUE) %>%\n  pull(age_bin) %>%\n  first","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"popular_articles_of <- function(transactions, k) {\n  transactions %>%\n    group_by(article_id) %>%\n    summarise(score = sum(value)) %>%\n    arrange(desc(score)) %>%\n    pull(article_id) %>%\n    head(k)\n}","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"popular_article_ages <- transaction_sales %>%\n  left_join(customer_bins, by = \"customer_id\") %>%\n  filter(!is.na(age_bin)) %>%\n  group_by(age_bin) %>%\n  summarise(popular_articles = list(popular_articles_of(cur_data(), K)))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"popular_article_ages","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### 3.2. Ladieswears","metadata":{}},{"cell_type":"code","source":"articles <- read_csv(\"../input/h-and-m-personalized-fashion-recommendations/articles.csv\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"customer_ladieswear_counts <- scored_customer_purchases %>%\n  select(customer_id, article_id) %>%\n  inner_join(select(articles, article_id, index_group_name), by = \"article_id\") %>%\n  filter(index_group_name %in% c(\"Ladieswear\", \"Menswear\")) %>%\n  count(customer_id, index_group_name) %>%\n  pivot_wider(names_from = index_group_name, values_from = n, values_fill = 0) %>%\n  mutate(total = Ladieswear + Menswear)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"ladieswear_rates <- map2_dbl(customer_ladieswear_counts$Ladieswear,\n                             customer_ladieswear_counts$total,\n                             ~ mean(binom.test(.x, .y)$conf.int))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"ladieswear_bin_breaks <- c(-1, 0.3, 0.9, 1)\n\ncustomer_ladieswear_rates <- customer_ladieswear_counts %>%\n  mutate(ladieswear_rate = ladieswear_rates) %>%\n  mutate(ladieswear_bin = cut(ladieswear_rate, breaks = ladieswear_bin_breaks))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"customer_ladieswear_rates %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"customer_ladieswear_rates %>% count(ladieswear_bin)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### 3.3. Ages x Ladieswears","metadata":{}},{"cell_type":"code","source":"popular_article_age_clusters <- transaction_sales %>%\n  inner_join(customer_bins, by = \"customer_id\") %>%\n  inner_join(customer_ladieswear_rates, by = \"customer_id\") %>%\n  filter(!is.na(age_bin)) %>%\n  group_by(age_bin, ladieswear_bin) %>%\n  summarise(age_cluster_popular_articles = list(popular_articles_of(cur_data(), K)), .groups = \"drop\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"popular_article_age_clusters","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Write Submission CSV","metadata":{}},{"cell_type":"code","source":"recommendations_purchased <- scored_customer_purchases %>%\n  group_by(customer_id) %>%\n  slice_max(order_by = score, n = K, with_ties = FALSE) %>%\n  summarise(purchased = list(article_id))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"cutoff_rate <- 0.05\n\nrecommendations_purchased_together <- scored_customer_purchases %>%\n  rename(purchased = article_id) %>%\n  left_join(purchased_together_rates, by = c(\"purchased\" = \"article_id1\")) %>%\n  rename(purchased_together = article_id2) %>%\n  filter(rate > cutoff_rate) %>%\n  group_by(customer_id) %>%\n  slice_max(order_by = rate, n = K, with_ties = FALSE) %>%\n  summarise(purchased_together = list(purchased_together))","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"recommendations <- recommendations_purchased %>%\n  left_join(recommendations_purchased_together)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"recommendations %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"sample_submission <- read_csv(\"../input/h-and-m-personalized-fashion-recommendations/sample_submission.csv\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"my_submission <- sample_submission %>%\n  select(customer_id) %>%\n  left_join(recommendations) %>%\n  left_join(customer_bins, by = \"customer_id\") %>%\n  mutate(age_bin = replace_na(age_bin, mode_bin)) %>%\n  left_join(popular_article_ages, by = \"age_bin\") %>%\n  left_join(customer_ladieswear_rates, by = \"customer_id\") %>%\n  left_join(popular_article_age_clusters, by = c(\"age_bin\", \"ladieswear_bin\")) %>%\n  rowwise() %>%\n  mutate(prediction = str_c(head(c(purchased,\n                                   na.omit(purchased_together),\n                                   age_cluster_popular_articles,\n                                   popular_articles),\n                                 K),\n                            collapse = \" \")) %>%\n  select(customer_id, prediction)","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"my_submission %>% head","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"my_submission %>% write_csv(\"submission.csv\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]}]}