R Solution for Excel Puzzles

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.