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.

```library(tidyverse)

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.

```library(tidyverse)

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.

```library(tidyverse)
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.

```library(tidyverse)

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.

```library(tidyverse)

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)) %>%

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