R Solution for Excel Puzzles
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Puzzles no. 389–393
Puzzles
Author: ExcelBI
All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.
Puzzle #389
Today’s task is again making graphic with numbers. We already made christmas trees, diamonds and similar things, so today we have to make so called quadrant. But I see it as crosshair in rifle’s visor. After being given certain number we have to create matrix which has zero in very center, and sequence of negative values to left and bottom, and positive values to right and up. Lets do it.
Loading libraries and data
library(tidyverse) library(readxl) number = read_excel("Excel/389 Quadrant.xlsx", range = "A1", col_names = FALSE) %>% pull() test = read_excel("Excel/389 Quadrant.xlsx", range = "A2:I10", col_names = FALSE) %>% as.data.frame() colnames(test) = c(as.character(1:ncol(test)))
Transforming
generate_cross = function(size) { full_size = 2*size+1 center = size+1 mat = matrix(NA, full_size, full_size) seq = seq(size, -size) rev_seq = rev(seq) mat[center,] <- rev_seq mat[,center] <- seq mat = as.data.frame(mat) colnames(mat) = c(as.character(1:ncol(mat))) return(mat) } result = generate_cross(number)
Validation
all.equal(test, result) # [1] TRUE
Puzzle #390
Now we have task that is similar to what we solved few weeks ago. Then we had to find all numbers where sum of digits is equal to products of digits, and now we have to find those which has exactly the same number of digits as sum of them. And again I used generative way rather than brute force. But… inspired by another solvers I also prepared another solution for this problem (and I learned some new math). It is based on combinatorics. Details are here.
Loading libraries and data
library(tidyverse) library(readxl) input = read_excel("Excel/390 Digit Equal to Sum of Digits.xlsx", range = "A1:A6") test = read_excel("Excel/390 Digit Equal to Sum of Digits.xlsx", range = "A1:D6")
Transformation #1 — generative
compute = function(number) { df = expand.grid(rep(list(0:number), number)) %>% mutate(sum = rowSums(.)) %>% filter(sum == number, Var1 != 0) %>% select(-sum) %>% unite("NO", everything(), sep = "", remove = TRUE) summary = df %>% summarise(Min = min(NO) %>% as.numeric(), Max = max(NO) %>% as.numeric(), Count = n() %>% as.numeric()) return(summary) } result = input %>% mutate(summary = map_df(Digits, compute)) %>% unnest(summary)
Transformation #2 — combinatorics
res = input %>% mutate(inputs = Digits - 1, Min = 10^(inputs) + inputs, Max = (Digits) * 10^(inputs), Count = choose(2 * (inputs), inputs)) %>% unnest() %>% select(-inputs)
Validation
identical(result, test) # [1] TRUE identical(res, test) # [1] TRUE
Puzzle #391
One of common, but not the easiest topics in our puzzles — palindromes. Sometimes we are making number palindromes, sometimes like today — letter palindromes. We have some strings in the table and task. We need to find shortest possible (that mean we need to add as small number of letters) palindrome but only by adding some letters at the front. If some words are already palindromes that doesn’t need to be transformed. Let’s do it.
Load libraries and data
library(tidyverse) library(readxl) library(stringi) input = read_excel("Excel/391 Palindrome After Adding in the Beginning.xlsx", range = "A1:A10") test = read_excel("Excel/391 Palindrome After Adding in the Beginning.xlsx", range = "B1:B10")
Transformation
is_palindrome = function(x) { x = tolower(x) x == stri_reverse(x) } palindromize = function(string) { if (is_palindrome(string)) { return(string) } string_rev = stri_reverse(string) prefixes = map(1:nchar(string), function(i) { substr(string_rev, 1, i) }) candidates = map(prefixes, function(prefix) { paste0(prefix, string) }) palindromes = data.frame(candidate = unlist(candidates)) %>% mutate( is_palindrome = map_lgl(candidate, is_palindrome)) %>% filter(is_palindrome) %>% select(candidate) %>% arrange(nchar(candidate)) %>% slice(1) %>% pull() return(palindromes) } result = input %>% mutate(palindromized = map_chr(String, palindromize)) %>% cbind(test) %>% mutate(check = palindromized == `Answer Expected`)
Puzzle # 392
Even and odd numbers are like teeth of two big gears interlocking each other. They comes one after another in perfect order. But sometimes somebody decide to destroy this order. Our task is to mess letters up. We have to going from the end of word tear words by odd and even position and then just lay those letter side by side.
Loading libraries and data
library(tidyverse) library(stringi) library(readxl) input = read_excel("Excel/392 Collect Even and Odd from Backwards.xlsx", range = "A1:A10") test = read_excel("Excel/392 Collect Even and Odd from Backwards.xlsx", range = "B1:B10")
Transformation
transform = function(string) { str_rev = stri_reverse(string) chars = str_split(str_rev, "")[[1]] even_chars = chars[seq_along(chars) %% 2 == 0] %>% paste0(collapse = "") odd_chars = chars[seq_along(chars) %% 2 == 1] %>% paste0(collapse = "") return(paste0(even_chars, odd_chars)) } result = input %>% mutate(transformed = map_chr(String, transform))
Validation
identical(result$transformed, test$`Answer Expected`) # [1] TRUE
Puzzle #393
Another cyphering task. Yes. I love them. Today we have so called Autokey Cipher. It needs coding keyword and works following way:
1. We are getting word to code split into letters.
2. Just below we place coding keyword and fill the rest of place (position to the length of first word) with begining of coded one. (Yeah, sounds complicated).
3. We are assigning both rows of letters with its numeric values from 0 (as A) to 25 (as Z).
4. We are adding both rows and get value of Modulo 26 of resulting sum.
5. Now we have value of coded letter which we need to find in numeric values as well.
Let see it first on image:
And code now:
Libraries and data loading
library(tidyverse) library(readxl) input = read_excel("Excel/393 Autokey Cipher.xlsx", range = "A1:B10") test = read_excel("Excel/393 Autokey Cipher.xlsx", range = "C1:C10")
Transformation
recode = function(string, keyword) { alphabet = data.frame(letters = letters, value = 0:25) string_length = nchar(string) keyword_length = nchar(keyword) str_chars = str_split(string, "")[[1]] key_chars = str_split(keyword, "")[[1]] if (keyword_length > string_length) { full_key = key_chars[1:string_length] } else if (keyword_length < string_length) { nchars_to_fill = string_length - keyword_length chars_to_fill = str_chars[1:nchars_to_fill] full_key = c(key_chars, chars_to_fill) } else { full_key = key_chars } code_table = data.frame(string = str_chars, key = full_key) result = code_table %>% left_join(alphabet, by = c("string" = "letters")) %>% left_join(alphabet, by = c("key" = "letters")) %>% mutate(value = value.x + value.y) %>% select(string, key, value) %>% mutate(value_mod = value %% 26) %>% left_join(alphabet, by = c("value_mod" = "value")) %>% pull(letters) %>% paste(collapse = "") return(result) } result = input %>% mutate(answer = map2_chr(`Plain Text`, `Keyword`, recode))
Validation
identical(result$answer, test$`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.
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.
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.