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