R Solution for Excel Puzzles

[This article was first published on Numbers around us - Medium, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Puzzles no. 334–338


Author: ExcelBI

# 334: content file
# 335: content file
# 336: content file
# 337: content file
# 338: content file

Lets dive into solutions!

Puzzle 334

We are given pairs of numbers and we have to find if they are amicable. But what does it mean? That mean that numbers are like they are complementing each other one fascinating way, like yin and yang. Sum of divisors of one number is equal to the second number and vice versa. So lets find out if they are.

Load libraries and data


input = read_excel("Amicable Numbers.xlsx", range = "A1:B10") %>% janitor::clean_names()
test = read_excel("Amicable Numbers.xlsx", range = "C1:D6") %>% janitor::clean_names()

Approach 1: tidyverse

divs = function(x) {
  divs_x = divisors(x)
  divs_x[divs_x != x]

are_amicable = function(x, y) {
  map2_lgl(x, y,  ~ sum(divs(.x)) == .y && sum(divs(.y)) == .x)

result = input %>%
  filter(are_amicable(number_1, number_2))

colnames(test) <- c("number_1", "number_2")

Approach 2: base R

divs_base <- function(x) {
  divisors <- x : 1
  divisors <- divisors[x %% divisors == 0]
  divisors[divisors != x]

are_amicable_base <- function(x, y) {
  amicable <- logical(length(x))
  for (i in seq_along(x)) {
    div_x <- divs_base(x[i])
    div_y <- divs_base(y[i])
    sum_x <- sum(div_x)
    sum_y <- sum(div_y)
    amicable[i] <- (sum_x == y[i] && sum_y == x[i])

result_base <- input %>% 
  filter(are_amicable_base(number_1, number_2)) %>%
  select(answer_expected= number_1, x2 = number_2)


identical(result, test)
# [1] TRUE

identical(result_base, test)
# [1] TRUE

Puzzle 335

This time we had some decryption job to do. If you would like to know more about it, read here. We have simple clue how to solve it: by reversing long string and break it into 5 strings. Lets do it.

Loading library and data


input = read_excel("Feynman Challenge Cipher.xlsx", range = "A1:A2")
test = read_excel("Feynman Challenge Cipher.xlsx", range = "B1:B2")

Approach 1: tidyverse

result = input$`Encrypted Text` %>%
  stri_reverse() %>%
  str_split("") %>%
  unlist() %>%
  matrix(ncol = 5, byrow = TRUE) %>%
  t() %>%
  as_tibble() %>%
  pmap_chr(~paste(c(...), collapse = "")) %>%
  paste(collapse = "") 

Approach 2: base R

reversed_text <- sapply(input$`Encrypted Text`, function(x) paste(rev(strsplit(x, "")[[1]]), collapse = ""))
matrix_formed <- matrix(unlist(strsplit(reversed_text, "")), ncol = 5, byrow = TRUE)
transposed_matrix <- t(matrix_formed)
concatenated_rows <- apply(transposed_matrix, 1, paste, collapse = "")
result_base <- paste(concatenated_rows, collapse = "")

Approach 3: data.table

input_dt <- data.table(input)

input_dt[, reversed := sapply(`Encrypted Text`, function(x) paste(rev(strsplit(x, "")[[1]]), collapse = ""))]
char_matrix <- matrix(unlist(strsplit(input_dt$reversed, "")), ncol = 5, byrow = TRUE)
transposed_matrix <- t(char_matrix)
result_dt <- paste(apply(transposed_matrix, 1, paste, collapse = ""), collapse = "")


identical(result, test$`Decrypted Text`)
# [1] TRUE

identical(result_base, test$`Decrypted Text`)
# [1] TRUE

identical(result_dt, test$`Decrypted Text`)
# [1] TRUE

Puzzle 336

In this case we have two columns of numbers, and we need to find only those pairs that are unique for this table. We have to check if there is no double with reverse order somewhere. So lets find them.

Loading libraries and data


input = read_excel("Unique Pairs.xlsx", range = "A1:B10") %>% janitor::clean_names()
test = read_excel("Unique Pairs.xlsx", range = "D2:E5") 

colnames(test) = colnames(input)
test = test %>% arrange(number2_1)

Approach 1: tidyverse

result = input %>%
  mutate(pair = map2(number2_1, number2_2, ~ sort(c(.x, .y)))) %>%
  group_by(pair) %>%
  filter(n() == 1) %>%
  ungroup() %>%
  select(-pair) %>%

Approach 2: base R

input_df = input

input_df$pair_list <- mapply(function(x, y) list(sort(c(x, y))), input_df$number2_1, input_df$number2_2)
input_df$pair_str <- sapply(input_df$pair_list, function(x) paste(x, collapse = "-"))
grouped_list <- split(input_df, input_df$pair_str)
filtered_df <- do.call(rbind, lapply(grouped_list, function(df) if(nrow(df) == 1) df else NULL))
result_base <- filtered_df[, !(names(filtered_df) %in% c("pair_list", "pair_str"))]
result_base <- result_base[order(result_base$number2_1), ]

Approach 3: data.table

input_dt = as.data.table(input)
input_dt[, pair_list := mapply(function(x, y) list(sort(c(x, y))), number2_1, number2_2)]
input_dt[, pair_str := sapply(pair_list, function(x) paste(x, collapse = "-"))]
result_dt <- input_dt[, .SD[.N == 1], by = pair_str][, `:=`(pair_list = NULL, pair_str = NULL)]
result_dt <- result_dt[order(number2_1), ]
result_dt <- as_tibble(as.matrix(result_dt))


identical(result, test)
# [1] TRUE

identical(result_base, test)
# [1] TRUE

identical(result_dt, test)
# [1] TRUE

Puzzle 337

This puzzle was mastermind. We had two columns of numbers. One represent number of digits (x) and second product of digits (y). And we have to find all numbers with x digits which product of digits is equal to y. Sounds pretty simple… but is really not. We can do it with brute force or find workaround. I tried brute force but looking for each 7-digit number which digits multiplied itself to be 23328, need to generate and process 10 millions of numbers. It is hard and can last very long. But in some of previous puzzles we used divisors, so I tried to get it from that side.

I found all divisors of “product of digits” and limit them for only those which are single digit. And then (let take first line with 3 digits and 8 as a product) we need to make every possible combination (with digit repetitions) of those divisors. In case of 8 those are 1,2,4,8 and we can make numbers like 111, 112, 248 and so on. When we have them all generated, we still have less than 1000 numbers to check. Then we have to check if product of digits in our list is equal to given at puzzle and filter them out.
When we find out final list, we have to count them, get highest and lowest value, and that is it. Why did I told everything? Because I wanted to show my flow of thoughts, which caused reducing computational time from 10 minutes to 0.84 second. And now code.

Load libraries and data


input = read_excel("Product Equal To.xlsx", range = "A2:B7") %>% janitor::clean_names()
test = read_excel("Product Equal To.xlsx", range = "C2:E7")

Approach and validation:

analyze_numbers = function(number_of_digits, products_of_digits) {
  # get divisors of product (only single digit ones)
  divs = divisors(products_of_digits)
  sing_dig_divs = divs[divs < 10]
  # get all possible combinations of digits
  all_combos = expand.grid(rep(list(sing_dig_divs), number_of_digits)) %>%
    # check if any of the combinations are equal to the product
    mutate(prod_of_combo = reduce(., `*`)) %>%
    filter(prod_of_combo == products_of_digits) %>%
    select(-prod_of_combo) %>%
    # combine the digits into a single number
    unite("number", everything(), sep = "") 
  # summarize the results
  summary = all_combos %>%
    summarise(Min = min(as.numeric(number)),
              Max = max(as.numeric(number)),
              Count = n() %>% as.numeric()) 

result = input %>%
  mutate(summary = map2(number_of_digits, product_of_digits, analyze_numbers)) %>%
  unnest(summary) %>%
  select(-number_of_digits, -product_of_digits) 

identical(result, test)  
#> [1] TRUE

Puzzle 338

In this puzzle we need to check if control numbers for each longer numbers are correct using Damm Algorithm. It is always basing on some kind of coding matrix and consecutive values of calculations.

Lets check it!

Load libraries and data


input = read_excel("Damm Algorithm.xlsx", range = "A1:A10")
test = read_excel("Damm Algorithm.xlsx", range = "B1:B10")

code_table = read_excel("Damm Algorithm.xlsx", range = "D2:N12", col_names = T) %>%
  column_to_rownames("...1") %>%


compute_damm_check_digit <- function(number, damm_matrix) {
  digits <- as.integer(unlist(strsplit(as.character(number), "")))
  accumulate(digits, ~ damm_matrix[.x + 1, .y + 1], .init = 0) %>% 

result = input %>%
  mutate(`Check Digit` = map_dbl(input$`Text Number`, compute_damm_check_digit, damm_matrix = code_table))


identical(result$`Check Digit`, test$`Check Digit`)
#> [1] TRUE

Feel free to comment, share and contact me with advices, questions and your ideas how to improve anything.

R Solution for Excel Puzzles was originally published in Numbers around us on Medium, where people are continuing the conversation by highlighting and responding to this story.

To leave a comment for the author, please follow the link and comment on their blog: Numbers around us - Medium.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)