R Solution for Excel Puzzles

Puzzles no. 544–548

Puzzles

Author: ExcelBI

All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.

Puzzle #544

Wake up Cinderellas, we have some cleaning to do. To be exact we need to pick up numbers from random strings and then add them up. It shouldn’t be hard. What do you think?

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/544 Sum of First and Last Numbers.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B2")

Transformation

result = input %>%
  mutate(numbers = map(Strings, str_extract_all, "\\d+")) %>%
  unnest(numbers) %>%
  unnest(numbers) %>%
  mutate(rn = row_number(), 
         min = min(rn),
         max = max(rn),
         .by = Strings) %>%
  filter(rn == min | rn == max) %>%
  summarise(sum = sum(as.numeric(numbers)))

Validation

identical(result$sum, test$`Answer Expected`)
# [1] TRUE

Puzzle #545

Game in this riddle is weird, but I imagined it can be some kind of group scissors-paper-rock, where there is more than 2 players, and a way to log a match is to write down winners with capital letters and losers with lower case. And we need to check what is the point balance for each player, assuming that each capital letter is plus 1, and lower case is minus 1. Let’s count them down.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/545 Ranking the Players.xlsx"
input = read_excel(path, range = "A2:A11")
test  = read_excel(path, range = "C2:E8")

Transformation

result = input %>%
  separate_rows(`Match Results`, sep = "") %>%
  filter(`Match Results` != "") %>%
  mutate(Players = str_to_lower(`Match Results`),
         case_point = if_else(`Match Results` == toupper(`Match Results`), 1, -1)) %>%
  summarise(Points = sum(case_point), .by = Players) %>%
  mutate(Rank = dense_rank(desc(Points)) %>% as.numeric()) %>%
  arrange(Rank, Players)

Validation

identical(result, test)
# [1] TRUE

Puzzle #546

We have some matrices of digits today, and we need to scan all horizontal and vertical lines. If we meet situation that digits forms odd number concatenated, we need to write it down. Does it sound hard? Not really, but lets try to make it dynamical, scalable and short in code at the same moment.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/546 Pick the Odd Numbers in a Grid.xlsx"
input1 = read_excel(path, range = "A2:B3", col_names = FALSE) %>% as.matrix()
test1  = read_excel(path, range = "G2:G2", col_names = FALSE) %>% pull()

input2 = read_excel(path, range = "A5:C7", col_names = FALSE) %>% as.matrix()
test2  = read_excel(path, range = "G5:G5", col_names = FALSE) %>% pull()

input3 = read_excel(path, range = "A9:C11", col_names = FALSE) %>% as.matrix()
test3  = read_excel(path, range = "G9:G9", col_names = FALSE) %>% pull()

input4 = read_excel(path, range = "A13:D16", col_names = FALSE) %>% as.matrix()
test4  = read_excel(path, range = "G13:G13", col_names = FALSE) %>% pull()

input5 = read_excel(path, range = "A18:E22", col_names = FALSE) %>% as.matrix()
test5  = read_excel(path, range = "G18:G18", col_names = FALSE) %>% pull()

Transformation

pick_odds <- function(M) {
  all <- as.numeric(apply(rbind(M, t(M)), 1, paste0, collapse = ""))
  paste(all[all %% 2 == 1], collapse = ", ")
}

Validation

all.equal(pick_odds(input1), test1) # TRUE
all.equal(pick_odds(input2), test2) # TRUE
all.equal(pick_odds(input3), test3) # could not pull "no cells", byt result of function is also empty
all.equal(pick_odds(input4), test4) # TRUE
all.equal(pick_odds(input5), test5) # TRUE

Puzzle #547

We met triangular numbers quite a few times before, but we have “hyper” triangular number today. Just to remind what triangular number is, imagine pool balls or bowling pins. At the beginning of the game they are forming triangle. Each triangular number if taken as set of physical objects (coins, bowling pins etc.) can be formed into nice equilateral triangle.

Today we have to find pairs of triangular numbers for which both sum and difference are also triangular. We need to find first 20 such pairs. I will show you two of many possible ways to achieve the goal. First correct, but showing another set of numbers, and second made to meet exact result as given. It differs in number generation method. In first I took all triangular numbers below certain numbers, in second only first 2000 elements. Check it out.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/547 Sum and Diff both Triangular Numbers.xlsx"
test  = read_excel(path, range = "A1:A21")

Transformation v1

generate_triangular_numbers <- function(limit) {
  n <- 1
  triangulars <- c()
  
  while (TRUE) {
    t_n <- n * (n + 1) / 2
    if (t_n > limit) break
    triangulars <- c(triangulars, t_n)
    n <- n + 1
  }
  return(triangulars)
}

is_triangular_number <- function(n) {
  return((sqrt(8 * n + 1) - 1) %% 2 == 0)
}


tr = generate_triangular_numbers(1000000)

tr_pairs = expand.grid(tr, tr) %>%
  as_tibble() %>%
  filter(Var1 != Var2,
         Var1 < Var2,
         is_triangular_number(Var1 + Var2),
         is_triangular_number(abs(Var1 - Var2))) %>%
  arrange(Var1, Var2) %>%
  head(20) %>%
  unite("result", c(Var1, Var2), sep = ", ", remove = T)

print(tr_pairs)

Transformation v2

generate_triangular_numbers <- function(n) {
  triangulars <- numeric(n)
  for (i in 1:n) {
    triangulars[i] <- i * (i + 1) / 2 
  }
  return(triangulars)
}

is_triangular_number <- function(n) {
  return((sqrt(8 * n + 1) - 1) %% 2 == 0)
}

tr = generate_triangular_numbers(2000)


tr_pairs = expand.grid(tr, tr) %>%
  as_tibble() %>%
  filter(Var1 != Var2,
         Var1 < Var2,
         is_triangular_number(Var1 + Var2),
         is_triangular_number(abs(Var1 - Var2))) %>%
  arrange(Var1, Var2) %>%
  head(20) %>%
  unite("result", c(Var1, Var2), sep = ", ", remove = T)

Validation (for version v2)

identical(test$`Answer Expected`, tr_pairs$result)
#> [1] TRUE

Puzzle #548

It looks like we have Morse code today, but not it only looks like it from certain distance. Tap Code Cypher is based on grid of numbers. If we need to code something we need to tap coordinates of each letter separately. Pretty nice. Let’s do it.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/548 Tap Code Cipher.xlsx"
input1 = read_excel(path, range = "A1:F6")
input2 = read_excel(path, range = "H1:H10")
test  = read_excel(path, range = "I1:I10")

Transformation

coding_table = input1 %>%
  pivot_longer(-1, names_to = "letter", values_to = "code") %>%
  select(row = 1, col = 2, letter = 3) %>%
  separate_rows(letter, sep = "/") %>%
  mutate(letter = str_to_lower(letter))

encrypt  = function(word) {
  characters = str_split(word, "") %>% unlist()

  coord = map_dfr(characters, ~{
    row = coding_table %>% filter(letter == .x) %>% pull(row)
    col = coding_table %>% filter(letter == .x) %>% pull(col)
    tibble(row = row, col = col) 
  }) %>%
    unite("coord", row, col, sep = " ") %>%
    pull(coord) %>%
    paste(collapse = " ")
  
  coord = str_split(coord, " ") %>% unlist() %>%
    map_dfr(~{
      dots = str_c(rep(".", .x), collapse = "")
      tibble(dots = dots)
    }) %>%
    pull(dots) %>%
    paste(collapse = " ")
    
  return(coord)
}

result = input2 %>%
  mutate(`Answer Expected` = map_chr(Words, encrypt))

Validation

identical(test$`Answer Expected`, result$`Answer Expected`)
#> [1] TRUE

Feel free to comment, share and contact me with advices, questions and your ideas how to improve anything. Contact me on Linkedin if you wish as well.
On my Github repo there are also solutions for the same puzzles in Python. Check it out!

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.