R Solution for Excel Puzzles

Puzzles no. 439–443

Puzzles

Author: ExcelBI

All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.

Puzzle #439

From time to time in ExcelBI challenges, hard puzzles come to us. And this time it was one of such situations. Input we were given was matrix with values, and coordinate values as rows and columns names. Didn’t look hard unless I read the task. Then we were given pairs of coordinates to find value for them, but there was one small problem, some of coordinates were not equal with our table. Some of values pointed in “space” between each coordinate. Like on map with meridians and parallels, we have some lines but also vast area just in between them. There comes technique called bilinear interpolation. We need to check what is the difference between lines and find value that is corresponding this fraction. Lets check it out.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/439 - Bilinear Interpolation.xlsx", range = "A1:B5")
lookup = read_excel("Excel/439 - Bilinear Interpolation.xlsx", range = "E1:M7")
test = read_excel("Excel/439 - Bilinear Interpolation.xlsx", range = "C1:C5")

Transformation

lookup = lookup %>%
  column_to_rownames("a/b")

bilinear_interpolation = function(a, b, lookup_table) {
  a_low = floor(a * 10) / 10
  a_high = ceiling(a * 10) / 10
  b_low = floor(b)
  b_high = ceiling(b)
  
  dist_a = a_high - a_low
  dist_b = b_high - b_low
  
  vlook_1 = lookup_table[as.character(b_low), as.character(a_low)]
  vlook_2 = lookup_table[as.character(b_high), as.character(a_low)]
  vlook_3 = lookup_table[as.character(b_low), as.character(a_high)]
  
  x_1 = if_else(dist_b == 0, 0, (vlook_2 - vlook_1) * (b - b_low) / dist_b)
  x_2 = if_else(dist_a == 0, 0, (vlook_3 - vlook_1) * (a - a_low) / dist_a)
  
  value = vlook_1 + x_1 + x_2
  return(round(value, 3))
}

result = input %>%
  mutate(`Answer Expected` = map2_dbl(a, b, ~bilinear_interpolation(.x, .y, lookup)))

Validation

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

Puzzle #440

Today slogan is: “Find numbers by properties”, and we are looking for numbers between 1 and 100 that can be expressed as a sum of two squared numbers that are not equal to each others. Like those snowmen above. It looks like it is really funny and suprisingly easy solution.

Loading libraries and data

library(tidyverse)
library(readxl)

test = read_excel("Excel/440 List of Numbers Expressed as Sum of Two Squares.xlsx", range = "A1:A30")

Transformation

is_sum_of_squares = function(x) {
  squares = (1:floor(sqrt(x)))^2
  any(map_lgl(squares,  ~ any(x == .x + squares[squares != .x])))
}

result = data.frame(numbers = 1:100 %>% as.numeric()) %>%
  filter(map_lgl(numbers, is_sum_of_squares))

Validation

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

Puzzle #441

Sometimes, something are too long to read, too long to write, and we are developing concepts as abbreviations, acronyms, number ranges and so on. We are skipping some characters like the frog from illustration. But our task is to do exactly opposite today. We do not need to skip any elements, but rather to step on each and every waterlily leaf on the pond. If string contains written range of numbers we need to get all numbers from this range. Find out how I did it.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/441 Integer Intervals.xlsx", range = "A1:A7")
test  = read_excel("Excel/441 Integer Intervals.xlsx", range = "B1:B7")

Transformation

result = input %>%
  mutate(rn = row_number()) %>%
  separate_rows(Problem, sep = ", ") %>%
  mutate(Problem = map(Problem, ~{
    if(str_detect(., "-")){
      range = str_split(., "-")[[1]]
      seq(as.numeric(range[1]), as.numeric(range[2]))
    } else {
      as.numeric(.)
    }
  })) %>%
  unnest(Problem) %>%
  summarise(`Answer Expected` = str_c(sort(unique(Problem)), collapse = ", "), .by = rn) %>%
  select(-rn)

Validation

identical(result, test)
# [1] TRUE

Puzzle #442

Ciphers, ciphers, ciphers… I didn’t know that people has so many ideas to hide messages from public visibility. Today we have Columnar Transposition Cipher. We use keyword as kind of template and then we can code even the longest messages. First we need to check our keyword, then rank its letters alphabetically. For example MARS would be ranked as 2134. Then we take text for encoding and wrap it after number of characters equal to length of keyword. In our example every 4 characters should be in separate rows. Then we have to read columns that appeared after folding in order like in ranked keyword, so first we need to read second column, then first, then third and fourth. But this example is easy. Check the solution.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/442 Columnar Transposition Cipher.xlsx", range = "A1:B10")
test  = read_excel("Excel/442 Columnar Transposition Cipher.xlsx", range = "C1:C10")

Transfromation

encode = function(text, keyword){
  keyword = strsplit(keyword, "")[[1]] %>%
    rank(ties.method = "first")
  l_key = length(keyword)
  
  text = str_extract_all(text, "[a-z]")[[1]]
  text_filled = c(text, rep("", l_key - length(text) %% l_key))
  
  matrix_text = matrix(text_filled, ncol = l_key, byrow = TRUE)
  matrix_text = matrix_text[, order(keyword)] %>% t()
  matrix_text = matrix_text %>%
    apply(1, paste, collapse = "") %>%
    paste(collapse = " ")
  
  return(matrix_text)
}

result = input %>%
  mutate(`Answer Expected` = map2_chr(`Plain Text`, Keyword, encode))

Validation

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

Puzzle #443

Do you remember from your childhood those word search riddles. So ExcelBI decided to throw us into those times again. We need to find some names in word search. Fortunately, they are all vertical, all left-to-right, so we have probably the easiest case. But when we were kids, when somebody find word usually crossed it with line or encircle them. What we have to do? Find words and replace all the other positions with “x”. So lets find a bird then.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/443 Birds Search.xlsx", range = "B2:K11", col_names = FALSE)
list  = read_excel("Excel/443 Birds Search.xlsx", range = "M1:M12")
test  = read_excel("Excel/443 Birds Search.xlsx", range = "O2:X11", col_names = FALSE)
colnames(test) = c(1:10)

Transformation

find_bird = function(grid, bird_name) {
  grid = unite(grid, col = "all", everything(), sep = "") %>%
    mutate(nrow = row_number()) %>%
    mutate(coords = str_locate(all, bird_name)) %>%
    na.omit() %>%
    select(-all)
  return(grid)
}

coords = map_dfr(list$Birds, ~find_bird(input, .x)) %>%
  mutate(start = coords[,1], end = coords[,2]) %>%
  select(-coords) %>%
  rowwise() %>%
  mutate(cols = list(seq(start, end))) %>%
  select(-start, -end) %>%
  unnest(cols) %>%
  mutate(check = T)

input2 = input %>% 
  mutate(nrow = row_number()) %>%
  pivot_longer(cols = -nrow, names_to = "col", values_to = "value") %>%
  mutate(col = str_extract(col, "\\d+") %>% as.numeric()) %>%
  left_join(coords, by = c("nrow" = "nrow", "col" = "cols")) %>%
  mutate(check = ifelse(is.na(check), F, T),
         value = ifelse(check, value, 'x')) %>%
  select(-check) %>%
  pivot_wider(names_from = col, values_from = value) %>%
  select(-nrow)

Validation

identical(input2, 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.