R Solution for Excel Puzzles

Puzzles no. 334–338

Puzzles

Author: ExcelBI

Puzzles:
# 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

library(tidyverse)
library(readxl)
library(numbers)

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])
  }
  amicable
}

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

Validation:

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

library(tidyverse)
library(readxl)
library(stringi)
library(data.table)

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 = "")

Validation:

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

library(tidyverse)
library(readxl)
library(data.table)

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) %>%
  arrange(number2_1)

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))

Validation:

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

library(tidyverse)
library(readxl)
library(numbers)

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()) 
  return(summary)
}

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

library(tidyverse)
library(readxl)

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") %>%
  as.matrix()

Approach:

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) %>% 
    tail(1)
}

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

Validate:

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.