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. 339–343

Puzzles

Author: ExcelBI

Puzzles:
#344: content file
#345: content file
#346: content file
#347: content file
#348: content file

Let dig in those numbers.

Puzzle #344

I am sure that you have heard about palindrome, but did you know katadromes? I haven’t heard about it before this puzzle. And what it is? Number in which digits are decreasing from start to end. And they have to decrease strictly so 432 will be katadrome, but 4332 will not because difference between second and third digit is equal 0.

So let go to puzzle.

Loading data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Katadrome Numbers.xlsx", range = "A1:A10")
test  = read_excel("Katadrome Numbers.xlsx", range = "B1:B5")

Transformations

We are checking if difference for each pair of consecutive digits is strictly lower than 0.

is_katadrome = function(x) {
  digits = x %>% as.character(n) %>%
    str_split("") %>%
    .[[1]] %>%
    map_dbl(as.numeric) 
  
  digits %>% diff() %>% all(. < 0)
  }

result = input %>%
  mutate(`Answer Expected` = map_dbl(Numbers, is_katadrome)) %>%
  filter(`Answer Expected` == 1)  

Verification

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

Puzzle #345

In this puzzle we were given three tables and three values. And we have to make some number geometry acrobatics: add digits of numbers placed on diagonals. So if we need diagonals my first thought was about… matrices.

Lets do it.

Load data and libraries

library(tidyverse)
library(readxl)

M1 = read_excel("Matrix Sum of Diagonal Digits.xlsx", range = "A2:B3", col_names = F) %>% as.matrix()
M2 = read_excel("Matrix Sum of Diagonal Digits.xlsx", range = "A7:D10", col_names = F) %>% as.matrix()
M3 = read_excel("Matrix Sum of Diagonal Digits.xlsx", range = "A13:E17", col_names = F) %>% as.matrix()

A1 = 47
A2 = 205
A3 = 236

Transformation and validation

We have diag() function exactly for what we need.

diagonals_sum_of_digits = function(M) {
  d1 = diag(M)
  d2 = diag(M[, ncol(M):1]) # to get second diagonal we have to flip matrix :)
  s1 = sum(as.numeric(unlist(strsplit(as.character(d1), ""))))
  s2 = sum(as.numeric(unlist(strsplit(as.character(d2), ""))))
  return(s1 + s2)
} 

identical(diagonals_sum_of_digits(M1), A1)
# [1] TRUE
identical(diagonals_sum_of_digits(M2), A2)
# [1] TRUE
identical(diagonals_sum_of_digits(M3), A3)
# [1] TRUE

Puzzle #346

Again we have to mess with some letters. Imagine that all consonants are becoming small black holes, and trying to suck inside but only one closest vowel to fill it. Sounds weird but now we have to code it.

Load data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Vowel Replacement_2.xlsx", range = "A1:A11")
test  = read_excel("Vowel Replacement_2.xlsx", range = "B1:B11")

Tranformation

closest_vowel <- function(word) {
  vowels <- c("a", "e", "i", "o", "u")
  word_chars <- str_split(word, "")[[1]]
  
  find_vowel <- function(char) {
    is_upper <- identical(char, toupper(char))
    char_lower <- tolower(char)
    
    if (char_lower %in% vowels) {
      return(char)
    } else {
      distances <- abs(match(char_lower, letters) - match(vowels, letters))
      closest <- which.min(distances)
      if (length(closest) > 1) {
        closest <- closest[1]
      }
      vowel <- vowels[closest]
      if (is_upper) vowel <- toupper(vowel)
      return(vowel)
    }
  }
  
  transformed_chars <- map_chr(word_chars, find_vowel)
  paste0(transformed_chars, collapse = "")
}

result = input %>%
  mutate(Result = map_chr(String, closest_vowel)) %>%
  select(-String)

Validation

identical(result$Result, test$Result)
# [1] TRUE

Puzzle #347

We are provided with 4 chains of numbers and from each chain we have to extract longest possible chain of consecutive numbers.

Lets do it!

Load data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Max Consecutive Numbers.xlsx", range = "A1:D20")
test  = read_excel("Max Consecutive Numbers.xlsx", range = "F2:I21")

Transformation

find_cons_series = function(column) {
  
  series_df = tibble(
    number = column,
    lagged = lag(column),
    diff = abs(column - lag(column))
  ) %>%
    filter(diff == 1) %>%
    mutate(series_diff = abs(number - lag(number, default = 1)),
           series = cumsum(ifelse(series_diff != 1, 1, 0))
           ) %>%
    group_by(series) %>%
    summarise(start = first(lagged),
              end = last(number),
              length = n()) %>%
    ungroup() %>%
    arrange(desc(length)) 
  
  longest_series = first(series_df)
  sequence = seq(longest_series$start, longest_series$end)
  
  return(sequence)
}

columns = colnames(input)

result = map(columns, ~find_cons_series(input[[.x]])) %>%
  map(~c(., rep(NA, 19 - length(.)))) %>%
  bind_cols() %>%
  set_names(columns) %>%
  mutate_all(as.numeric)

Validation

identical(result, test)
#> [1] TRUE

Puzzle #348

Have you heard of language game of Pig Latin? In this game you are mutilating… sorry modifying words by cutting it by first vowel, putting this first part at the end and adding “ay” at the very end. Looks difficult, but code is suprisingly short.

Load data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Pig Latin Cipher.xlsx", range = "A1:A10") %>% janitor::clean_names()
test = read_excel("Pig Latin Cipher.xlsx", range = "B1:B10") %>% janitor::clean_names()

Modification

pigify = function(word) {
  chars = str_split(word, "")[[1]]
  vowels = c("a", "e", "i", "o", "u")
  first_vowel = which(chars %in% vowels)[1]
  
  if (is.na(first_vowel)) {
    return(paste0(word, "ay"))
  }
  else {
    return(paste0(substr(word, first_vowel, nchar(word)), substr(word, 1, first_vowel - 1), "ay"))
  }
}

result = input %>%
  mutate(answer_expected = str_replace_all(text, "\\w+", pigify)) 

Verification

identical(result$answer_expected, test$answer_expected)

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.

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)