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. 424–428
Puzzles
Author: ExcelBI
All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.
Puzzle #424
We are playing with numbers very often, and sometimes is just playing for playing. Like today. We are having number which have to be splitted to digits, and between those digits we should place product of them. Finally bring all together to form new number. That is why ilustrated this puzzle with zipper. We have to zip two arrays of numbers.
Loading libraries and data
library(tidyverse) library(readxl) input = read_excel("Excel/424 Insert In Between Multiplication.xlsx", range = "A1:A10") test = read_excel("Excel/424 Insert In Between Multiplication.xlsx", range = "B1:B10")
Transformation
transform_number = function(number){ str_number = as.character(number) digits = strsplit(str_number, "")[[1]] %>% as.numeric() ndigits = length(digits) products = map(1:(ndigits - 1), ~{ digits[.x] * digits[.x+1] }) %>% c(., "") result = map2(digits,products, ~{ c(.x, .y) }) %>% unlist() %>% paste(collapse = "") return(result) } result = input %>% mutate(`Answer Expected` = map_chr(Words, transform_number)) %>% select(-Words)
Validation
identical(result, test) # [1] TRUE
Puzzle #425
All concepts in computer science always can be represented as numbers (at the lowest level as 0 and 1). Of course colours are not exceptions. We have RGB system that represent each colour as levels of Red, Green and Blue. And what we asked to do is to mix two colours together. How is it possible? Just calculate mean of each element respectively. Let’s code it.
Loading libraries and data
library(tidyverse) library(readxl) input = read_excel("Excel/425 Hex Color Blending.xlsx", range = "A1:B10") test = read_excel("Excel/425 Hex Color Blending.xlsx", range = "C1:C10")
Transformation
result = input %>% mutate(Color1 = strsplit(as.character(input$Color1), ", ") %>% map(., ~as.numeric(.x)), Color2 = strsplit(as.character(input$Color2), ", ") %>% map(., ~as.numeric(.x))) %>% mutate(FinalColor = map2(Color1, Color2, ~ceiling((.x + .y) / 2))) %>% mutate(`Answer Expected` = map_chr(FinalColor, ~rgb(.x[1], .x[2], .x[3], maxColorValue = 255))) %>% select(-Color1, -Color2, -FinalColor)
Validation
identical(result, test) #> [1] TRUE
Puzzle #426
There are probably very low percentage of people (at least in western culture), that doesn’t know game of Tic Tac Toe. On board with 9 fields players are trying to construct the line of three X’s or O’s to win. We have to build verification algorithm today. We are getting boards too check for result, if anybody won or if it was a draw. Let’s do it.
Loading libraries and data
library(tidyverse) library(readxl) library(Matrix) board1 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A2:C4", col_names = F) %>% as.matrix() board2 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A6:C8", col_names = F) %>% as.matrix() board3 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A10:C12", col_names = F) %>% as.matrix() board4 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A14:C16", col_names = F) %>% as.matrix() board5 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A18:C20", col_names = F) %>% as.matrix() board6 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "A22:C24", col_names = F) %>% as.matrix() verdict1 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E2:E2", col_names = F) %>% pull() verdict2 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E6:E6", col_names = F) %>% pull() verdict3 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E10:E10", col_names = F) %>% pull() verdict4 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E14:E14", col_names = F) %>% pull() verdict5 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E18:E18", col_names = F) %>% pull() verdict6 = read_excel("Excel/426 Tic Tac Toe Result.xlsx", range = "E22:E22", col_names = F) %>% pull()
Transformation
check_board <- function(board) { row_check = any(apply(board, 1, function(x) length(unique(x)) == 1)) col_check = any(apply(board, 2, function(x) length(unique(x)) == 1)) diag_check = length(unique(diag(board))) == 1 anti_diag_check = length(unique(diag(board[,ncol(board):1]))) == 1 ifelse(row_check | col_check | diag_check | anti_diag_check, "Won", "Draw") }
Validation
check_board(board1) == verdict1 # TRUE check_board(board2) == verdict2 # TRUE check_board(board3) == verdict3 # TRUE check_board(board4) == verdict4 # TRUE check_board(board5) == verdict5 # TRUE check_board(board6) == verdict6 # TRUE
Puzzle #427
Puzzles that I like — ciphering… Today we have double accumulate cipher. We need to get numeric representation of each letter, then accumulative sum it up, then transform it to letter’s numeric representation (by applying modulo 26), repeat last two step, and at the end tranform it to letters back.
Loading libraries and data
library(tidyverse) library(readxl) input = read_excel("Excel/427 Double Accumulative Cipher.xlsx", range = "A1:A10") test = read_excel("Excel/427 Double Accumulative Cipher.xlsx", range = "B1:B10")
Transformation
double_accumulative_cipher = function(word) { result = strsplit(word, "")[[1]] %>% map_dbl(~match(., letters) - 1) %>% accumulate(~(.x + .y) %% 26) %>% accumulate(~(.x + .y) %% 26) %>% map_dbl(~. + 1) %>% map_chr(~letters[.]) %>% paste(collapse = "") return(result) } result = input %>% mutate(`Answer Expected` = map_chr(`Plain Text`, double_accumulative_cipher)) %>% select(-`Plain Text`)
Validation
identical(result, test) #> [1] TRUE
Puzzle #428
Probably all government related numbers have control number and specific structure. In our puzzles we had already South African ID number, IMO numbers, and today we have to validate Chinese ID number. What are its characteristics? After 6 random digits, date of birth occurs, then 3 random digits, and last character is calculated based on certain algorithm. digits are weighted, transformed and modulo 11 of final results give us digit or letter X if it is 10.
So there are 3 things to check:
- if number has 17 digits + X or 18 digits
- if digits 7 to 14 are forming valid date (for example if there is no May 32nd)
- if last character is correct for 17 first digits.
Load libraries and data
library(tidyverse) library(readxl) input = read_excel("Excel/428 Chinese National ID.xlsx", range = "A1:A10") test = read_excel("Excel/428 Chinese National ID.xlsx", range = "B1:B5")
Transformation
general_pattern = "\\d{6}\\d{8}\\d{3}[0-9X]" is_valid_date = function(ID) { str_sub(ID, 7, 14) %>% ymd() if (is.na(date)) { return(FALSE) } else { return(TRUE) } } is_ID_valid = function(ID) { base = str_sub(ID, 1, 17) %>% str_split("") %>% unlist() %>% as.numeric() I = 18:2 WI = 2**(I-1) %% 11 S = sum(base * WI) C = (12 - (S %% 11)) %% 11 C = as.character(C) %>% str_replace_all("10", "X") whole_id = base %>% str_c(collapse = "") %>% str_c(C) return(whole_id == ID) } r1 = input %>% mutate(gen_pattern = str_match(`National ID`, general_pattern)) %>% mutate(dob = str_sub(`National ID`, 7, 14) %>% ymd()) %>% mutate(is_valid = map_lgl(`National ID`, is_ID_valid)) %>% filter(is_valid == TRUE & !is.na(dob) & !is.na(gen_pattern)) %>% select(`Answer Expected` = `National ID`)
Validation
identical(r1, test) # [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.