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

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)