# R Solution for Excel Puzzles

**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. 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.

**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.