Hanukkah of data 2022

R
Puzzles
Author

Philippe Massicotte

Published

December 28, 2022

Hanukkah of data 2022

If you are looking for some data science challenges, don’t look anymore, Hanukkah of Data is there for you. You can think of it as similar to Advent of Code but tailored toward data-oriented puzzles with only eight challenges. In this blog post, I will try to solve all the puzzles using R.

Close up on a grain field

Hanukkah of data 2022

Getting the data

The first step of the challenge is to get the data. The trick is that the data is contained in a password-protected zip file. The very first challenge is to find the password of the zip file. You have to find out the Hebrew year that corresponds to 2017-01-01. To do so, I simply used this website and found out that the password was 5777. With this information, let us download the compressed file and unzip it into a temporary folder.

url <- "https://hanukkah.bluebird.sh/5783/noahs-csv.zip"

td <- tempdir()
tf <- tempfile(tmpdir = td, fileext = ".zip")

curl::curl_download(url, destfile = tf)

system(command = paste0("unzip -o -P 5777 ", tf, " -d ", td))

If we look at all the unzipped files, we can see it consists in four CSV files that we can import in R.

files <- fs::dir_ls(td, glob = "*.csv")

files
#> /tmp/RtmpWhn7pc/noahs-customers.csv    /tmp/RtmpWhn7pc/noahs-orders.csv       
#> /tmp/RtmpWhn7pc/noahs-orders_items.csv /tmp/RtmpWhn7pc/noahs-products.csv

customers <- read_csv(files[str_detect(files, "noahs-customers.csv")])
orders_items <- read_csv(files[str_detect(files, "noahs-orders_items.csv")])
orders <- read_csv(files[str_detect(files, "noahs-orders.csv")])
products <- read_csv(files[str_detect(files, "noahs-products.csv")])

After exploring the data, I have found out that there is one duplicated customer in noahs-customers.csv. Specifically, customerid should uniquely identify each customer. Let’s remove this duplicated entry (more about that later).

customers |>
  janitor::get_dupes()

customers <- customers |>
  distinct(customerid, .keep_all = TRUE)

Explore the data

To explore the relationships across the different tables, I am using the {dm} R package. This was the first time using this package and it looks interesting if you work with relational databases. Let’s create a dm object using the dm() function with the four data frame we have.

# install.packages("dm")
# install.packages("DiagrammeR")
library(dm)

noahs_dm <- dm(customers, orders_items, orders, products)

noahs_dm
#> ── Metadata ────────────────────────────────────────────────────────────────────
#> Tables: `customers`, `orders_items`, `orders`, `products`
#> Columns: 19
#> Primary keys: 0
#> Foreign keys: 0

Then, we can specify the primary key of each table using the dm_add_pk() function.

noahs_dm <- noahs_dm |>
  dm_add_pk(customers, customerid) |>
  dm_add_pk(orders, orderid) |>
  dm_add_pk(products, sku)

noahs_dm
#> ── Metadata ────────────────────────────────────────────────────────────────────
#> Tables: `customers`, `orders_items`, `orders`, `products`
#> Columns: 19
#> Primary keys: 3
#> Foreign keys: 0

One condition to set up a primary key is that it must be unique. The enum_pk_candidates() function can be used to scan all values in a table and will determine if any variable is suitable to be used as a primary key. As we can see below, customerid in noahs-customers.csv is duplicated twice in the data. This is why I used the distinct() function earlier to remove the duplicated entry.

read_csv(files[str_detect(files, "noahs-customers.csv")]) |>
  enum_pk_candidates() |>
  gt::gt()
columns candidate why
customerid FALSE has duplicate values: 4308 (2)
name FALSE has duplicate values: Jennifer Smith (8), James Williams (7), David Johnson (6), James Johnson (6), Lisa Smith (6), …
address FALSE has duplicate values: 1 East River Pl (4), 12B Cooper Pl (3), 205 W 88th St (3), 1023 38th St (2), 1167A Lexington Ave (2), …
citystatezip FALSE has duplicate values: Brooklyn, NY 11234 (121), Corona, NY 11368 (121), Bronx, NY 10467 (111), Brooklyn, NY 11236 (99), Brooklyn, NY 11211 (98), …
birthdate FALSE has duplicate values: 1953-01-12 (5), 1970-04-15 (5), 1946-06-28 (4), 1949-11-16 (4), 1952-03-29 (4), …
phone FALSE has duplicate values: 838-616-4951 (2), 929-906-5980 (2)

We can now use the dm_add_fk() function to specify the foreign keys in each table. Basically, dm_add_fk(orders_items, sku, products) means that the sky variable/key is used to link the orders_items and products tables together.

noahs_dm <- noahs_dm |>
  dm_add_fk(orders_items, sku, products) |>
  dm_add_fk(orders_items, orderid, orders) |>
  dm_add_fk(orders, customerid, customers)

noahs_dm
#> ── Metadata ────────────────────────────────────────────────────────────────────
#> Tables: `customers`, `orders_items`, `orders`, `products`
#> Columns: 19
#> Primary keys: 3
#> Foreign keys: 3

Finally, we can visualize all the relationships with dm_draw().

noahs_dm |>
  dm_draw()

I am not going to use more of dm for the rest of this post, but I am sure there is a lot more to cover.

Puzzle 1: beehive

For this first puzzle, we have to find the phone number that matches the customer’s last name. The first step consists in extracting customers’ last names and filtering out to keep those with only 10 characters (the length of the phone numbers).

df <- customers |>
  select(name, phone) |>
  mutate(last_name = str_match(name, "\\s{1}(\\S+)$")[, 2]) |>
  mutate(last_name_n = nchar(last_name)) |>
  filter(last_name_n == 10)

df

Then, I am creating a lookup table that matches letters to the numbers of a phone. With that, I convert each letter of the last name into a string and filter to keep the phone number that is equal to the last name.

phone_lut <- c(
  "a" = 2,
  "b" = 2,
  "c" = 2,
  "d" = 3,
  "e" = 3,
  "f" = 3,
  "g" = 4,
  "h" = 4,
  "i" = 4,
  "j" = 5,
  "k" = 5,
  "l" = 5,
  "m" = 6,
  "n" = 6,
  "o" = 6,
  "p" = 7,
  "q" = 7,
  "r" = 7,
  "s" = 7,
  "t" = 8,
  "u" = 8,
  "v" = 8,
  "w" = 9,
  "x" = 9,
  "y" = 9,
  "z" = 9
)

df |>
  mutate(phone = str_remove_all(phone, "-")) |>
  mutate(
    number =
      map_chr(
        str_split(tolower(last_name), ""),
        \(x) paste0(phone_lut[x], collapse = "")
      )
  ) |>
  filter(phone == number)

Puzzle 2: snail

The first step is to extract customer initials and only keep “JD”.

customers_initials <- customers |>
  mutate(initials = gsub("[a-z]", "", name), .after = name) |>
  mutate(initials = str_remove_all(initials, " ")) |>
  filter(initials == "JD")

customers_initials

Now we can search for the customer who made Rug Cleaner orders in 2017.

customers_initials |>
  left_join(orders) |>
  filter(lubridate::year(ordered) == 2017) |>
  left_join(orders_items) |>
  left_join(products) |>
  filter(str_detect(desc, regex("Rug Cleaner", ignore_case = TRUE))) |>
  add_count(customerid) |>
  filter(n > 1) |>
  distinct(name, phone)

Puzzle 3: spider

We search for someone Aries born in the year of the Dog. After Googling around, I managed to get the corresponding years. Hence, the first step was to find out customers born in those years. The catch here is that we can not only look at the years for finding the possible candidates because Aries time is only between March 21st and April 19th. We also know that this person was also living in the same neighbourhood as Jeremy (the previous owner of the rug). It was just a matter of filtering out customers living in the same area.

jeremy <- customers |>
  filter(name == "Jeremy Davis")

customers |>
  filter(
    lubridate::year(birthdate) %in%
      c(1922, 1934, 1946, 1958, 1970, 1982, 1994, 2006, 2018, 2030),
    between(format(birthdate, "%m%d"), "0321", "0419")
  ) |>
  filter(citystatezip == jeremy$citystatezip) |>
  distinct(name, phone)

Puzzle 4: owl

For this puzzle, we have to find the woman who buys from bakeries daily before 5 am.

products |>
  filter(str_starts(sku, "BKY")) |>
  left_join(orders_items) |>
  left_join(orders) |>
  filter(lubridate::hour(ordered) < 5) |>
  left_join(customers) |>
  count(customerid, name, phone, sort = TRUE) |>
  slice(1)

Puzzle 5: koala

We are told that the next owner lives in the Queen’s village and also regularly buys food for his/her older cats.

customers |>
  filter(str_detect(citystatezip, regex("queens village", ignore_case = TRUE))) |>
  left_join(orders) |>
  left_join(orders_items) |>
  left_join(products) |>
  filter(str_detect(desc, regex("senior cat", ignore_case = TRUE))) |>
  group_by(name, phone) |>
  summarise(n = n_distinct(orderid), .groups = "drop") |>
  slice_max(n, n = 1)

Puzzle 6: squirrel

Here, we have to find the person who only bought items that were on discount. First, calculate the total paid price and the total wholesale cost.

purchases <- orders_items |>
  left_join(orders) |>
  left_join(products) |>
  group_by(orderid) |>
  summarise(
    across(c(unit_price, wholesale_cost),
      .fns = list("tot" = \(x) sum(qty * x))
    )
  ) |>
  left_join(orders) |>
  left_join(customers)

Now we can find customers who only buy when everything is on sale (i.e, when the total paid is lower than the total wholesale cost).

purchases |>
  group_by(customerid) |>
  filter(all(unit_price_tot < wholesale_cost_tot)) |>
  add_count(customerid) |>
  filter(n > 1) |>
  distinct(customerid, name, phone)

Puzzle 7: toucan

This puzzle was for me the most challenging. I had to think for a while before starting to implement the solution. The key ideas to solve this problem are:

  1. Extract the colour from the item description.
  2. Find the person who bought the same item as Emily a moment after her, but with a different colour.
colored_products <- products |>
  extract(desc,
    into = c("desc", "color"), "([^()\\n]+)(?:(?:\\()(\\w*)(?:\\)))?"
  ) |>
  mutate(desc = str_squish(desc)) |>
  mutate(color = na_if(color, "")) |>
  drop_na(color)

colored_products

Based on this list, we have to find the date on which Emily made purchases and for which the same item was bought in at least two colours.

colored_products |>
  left_join(orders_items) |>
  left_join(orders) |>
  left_join(customers) |>
  group_by(date = as.Date(ordered), desc) |>
  filter(length(unique(color)) > 1 & any(customerid == 8342)) |>
  ungroup() |>
  distinct(desc, color, name, color, phone, ordered) |>
  arrange(ordered)

Looking at the time of purchase, we can find that Jonathan Adams also bought an Electric Machine with a different colour just a few seconds after Emily.

Puzzle 8: snake

For this puzzle, we have to find the customer who is collecting the most different items sold by Noah’s.

products |>
  filter(str_detect(desc, "Noah's")) |>
  left_join(orders_items) |>
  left_join(orders) |>
  group_by(customerid) |>
  summarise(n = n_distinct(desc)) |>
  slice_max(n, n = 1) |>
  left_join(customers) |>
  select(name, phone)

Conclusions

These quick data challenges were quite fun to solve. It looks like that more puzzles will be added in the future, so keep an eye open if you are interested.

Session info 
#> ─ Session info ───────────────────────────────────────────────────────────────────────────────────────────────────────
#>  setting  value
#>  version  R version 4.4.0 (2024-04-24)
#>  os       Ubuntu 24.04 LTS
#>  system   x86_64, linux-gnu
#>  ui       X11
#>  language en_CA:en
#>  collate  en_CA.UTF-8
#>  ctype    en_CA.UTF-8
#>  tz       America/Toronto
#>  date     2024-05-02
#>  pandoc   3.1.3 @ /usr/bin/ (via rmarkdown)
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────────────────────────────────────────────
#>  ! package      * version date (UTC) lib source
#>  P backports      1.4.1   2021-12-13 [?] RSPM (R 4.4.0)
#>  P bit            4.0.5   2022-11-15 [?] RSPM (R 4.4.0)
#>  P bit64          4.0.5   2020-08-30 [?] RSPM (R 4.4.0)
#>  P cachem         1.0.8   2023-05-01 [?] RSPM (R 4.4.0)
#>  P cli            3.6.2   2023-12-11 [?] RSPM (R 4.4.0)
#>  P colorspace     2.1-0   2023-01-23 [?] RSPM (R 4.4.0)
#>  P crayon         1.5.2   2022-09-29 [?] RSPM (R 4.4.0)
#>  P curl           5.2.1   2024-03-01 [?] RSPM (R 4.4.0)
#>  P DBI            1.2.2   2024-02-16 [?] RSPM (R 4.4.0)
#>  P dbplyr         2.5.0   2024-03-19 [?] RSPM (R 4.4.0)
#>  P devtools       2.4.5   2022-10-11 [?] RSPM
#>  P DiagrammeR   * 1.0.11  2024-02-02 [?] RSPM (R 4.4.0)
#>  P digest         0.6.35  2024-03-11 [?] RSPM (R 4.4.0)
#>  P dm           * 1.0.10  2024-01-21 [?] RSPM (R 4.4.0)
#>  P dplyr        * 1.1.4   2023-11-17 [?] RSPM (R 4.4.0)
#>  P ellipsis       0.3.2   2021-04-29 [?] RSPM (R 4.4.0)
#>  P evaluate       0.23    2023-11-01 [?] RSPM (R 4.4.0)
#>  P extrafont      0.19    2023-01-18 [?] RSPM (R 4.4.0)
#>  P extrafontdb    1.0     2012-06-11 [?] RSPM (R 4.4.0)
#>  P fansi          1.0.6   2023-12-08 [?] RSPM (R 4.4.0)
#>  P fastmap        1.1.1   2023-02-24 [?] RSPM (R 4.4.0)
#>  P forcats      * 1.0.0   2023-01-29 [?] RSPM (R 4.4.0)
#>  P fs             1.6.4   2024-04-25 [?] CRAN (R 4.4.0)
#>  P generics       0.1.3   2022-07-05 [?] RSPM (R 4.4.0)
#>  P ggplot2      * 3.5.1   2024-04-23 [?] RSPM (R 4.4.0)
#>  P ggpmthemes   * 0.0.2   2024-05-02 [?] Github (pmassicotte/ggpmthemes@993d61e)
#>  P glue           1.7.0   2024-01-09 [?] RSPM (R 4.4.0)
#>  P gt             0.10.1  2024-01-17 [?] CRAN (R 4.4.0)
#>  P gtable         0.3.5   2024-04-22 [?] RSPM (R 4.4.0)
#>  P hms            1.1.3   2023-03-21 [?] RSPM (R 4.4.0)
#>  P htmltools      0.5.8.1 2024-04-04 [?] RSPM (R 4.4.0)
#>  P htmlwidgets    1.6.4   2023-12-06 [?] RSPM
#>  P httpuv         1.6.15  2024-03-26 [?] RSPM (R 4.4.0)
#>  P igraph         2.0.3   2024-03-13 [?] RSPM (R 4.4.0)
#>  P janitor        2.2.0   2023-02-02 [?] RSPM (R 4.4.0)
#>  P jsonlite       1.8.8   2023-12-04 [?] RSPM (R 4.4.0)
#>  P knitr          1.46    2024-04-06 [?] RSPM (R 4.4.0)
#>  P later          1.3.2   2023-12-06 [?] RSPM (R 4.4.0)
#>  P lifecycle      1.0.4   2023-11-07 [?] RSPM (R 4.4.0)
#>  P lubridate    * 1.9.3   2023-09-27 [?] RSPM (R 4.4.0)
#>  P magrittr       2.0.3   2022-03-30 [?] RSPM (R 4.4.0)
#>  P memoise        2.0.1   2021-11-26 [?] RSPM (R 4.4.0)
#>  P mime           0.12    2021-09-28 [?] RSPM (R 4.4.0)
#>  P miniUI         0.1.1.1 2018-05-18 [?] RSPM (R 4.4.0)
#>  P munsell        0.5.1   2024-04-01 [?] CRAN (R 4.4.0)
#>  R nvimcom      * 0.9.41  <NA>       [?] <NA>
#>  P pillar         1.9.0   2023-03-22 [?] RSPM (R 4.4.0)
#>  P pkgbuild       1.4.4   2024-03-17 [?] RSPM (R 4.4.0)
#>  P pkgconfig      2.0.3   2019-09-22 [?] RSPM (R 4.4.0)
#>  P pkgload        1.3.4   2024-01-16 [?] RSPM
#>  P processx       3.8.4   2024-03-16 [?] RSPM (R 4.4.0)
#>  P profvis        0.3.8   2023-05-02 [?] RSPM
#>  P promises       1.3.0   2024-04-05 [?] RSPM (R 4.4.0)
#>  P ps             1.7.6   2024-01-18 [?] RSPM (R 4.4.0)
#>  P purrr        * 1.0.2   2023-08-10 [?] RSPM (R 4.4.0)
#>  P quarto       * 1.4     2024-03-06 [?] RSPM
#>  P R.cache        0.16.0  2022-07-21 [?] RSPM
#>  P R.methodsS3    1.8.2   2022-06-13 [?] RSPM
#>  P R.oo           1.26.0  2024-01-24 [?] RSPM
#>  P R.utils        2.12.3  2023-11-18 [?] RSPM
#>  P R6             2.5.1   2021-08-19 [?] RSPM (R 4.4.0)
#>  P RColorBrewer   1.1-3   2022-04-03 [?] RSPM (R 4.4.0)
#>  P Rcpp           1.0.12  2024-01-09 [?] RSPM (R 4.4.0)
#>  P readr        * 2.1.5   2024-01-10 [?] RSPM (R 4.4.0)
#>  P remotes        2.5.0   2024-03-17 [?] RSPM
#>  P renv           1.0.7   2024-04-11 [?] RSPM (R 4.4.0)
#>  P rlang          1.1.3   2024-01-10 [?] RSPM (R 4.4.0)
#>  P rmarkdown      2.26    2024-03-05 [?] RSPM (R 4.4.0)
#>  P rstudioapi     0.16.0  2024-03-24 [?] RSPM
#>  P Rttf2pt1       1.3.12  2023-01-22 [?] RSPM (R 4.4.0)
#>  P sass           0.4.9   2024-03-15 [?] RSPM (R 4.4.0)
#>  P scales         1.3.0   2023-11-28 [?] CRAN (R 4.4.0)
#>  P sessioninfo    1.2.2   2021-12-06 [?] RSPM
#>  P shiny          1.8.1.1 2024-04-02 [?] RSPM (R 4.4.0)
#>  P snakecase      0.11.1  2023-08-27 [?] RSPM (R 4.4.0)
#>  P stringi        1.8.3   2023-12-11 [?] RSPM (R 4.4.0)
#>  P stringr      * 1.5.1   2023-11-14 [?] RSPM (R 4.4.0)
#>  P styler       * 1.10.3  2024-04-07 [?] RSPM
#>  P tibble       * 3.2.1   2023-03-20 [?] RSPM (R 4.4.0)
#>  P tidyr        * 1.3.1   2024-01-24 [?] RSPM (R 4.4.0)
#>  P tidyselect     1.2.1   2024-03-11 [?] RSPM (R 4.4.0)
#>  P tidyverse    * 2.0.0   2023-02-22 [?] RSPM (R 4.4.0)
#>  P timechange     0.3.0   2024-01-18 [?] RSPM (R 4.4.0)
#>  P tzdb           0.4.0   2023-05-12 [?] RSPM (R 4.4.0)
#>  P urlchecker     1.0.1   2021-11-30 [?] RSPM
#>  P usethis        2.2.3   2024-02-19 [?] RSPM
#>  P utf8           1.2.4   2023-10-22 [?] RSPM (R 4.4.0)
#>  P vctrs          0.6.5   2023-12-01 [?] RSPM (R 4.4.0)
#>  P visNetwork   * 2.1.2   2022-09-29 [?] RSPM (R 4.4.0)
#>  P vroom          1.6.5   2023-12-05 [?] RSPM (R 4.4.0)
#>  P withr          3.0.0   2024-01-16 [?] RSPM (R 4.4.0)
#>  P xfun           0.43    2024-03-25 [?] RSPM (R 4.4.0)
#>  P xml2           1.3.6   2023-12-04 [?] RSPM
#>  P xtable         1.8-4   2019-04-21 [?] RSPM (R 4.4.0)
#>  P yaml           2.3.8   2023-12-11 [?] RSPM (R 4.4.0)
#> 
#>  [1] /tmp/RtmpWhn7pc/renv-use-libpath-2f8c7d68666bbc
#>  [2] /home/filoche/.cache/R/renv/sandbox/linux-ubuntu-noble/R-4.4/x86_64-pc-linux-gnu/a71ef467
#> 
#>  P ── Loaded and on-disk path mismatch.
#>  R ── Package was removed from disk.
#> 
#> ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────