Puzzles no. 339–343

Puzzles

Author: ExcelBI

Puzzles:
#339: content file
#340: content file
#341: content file
#342: content file
#343: content file

Lets dive into solutions!
Short disclaimer: This weeks riddles were well designed and I found out that very good but also readable solutions will not have different approaches this time. It would only overcomplicate the code. So let started.

Puzzle #339

Puzzles focused on Fibonacci sequence are frequent guests on our puzzles. This time we are taking regular Fibonacci sequence and have “only” to return nth term of sequence. We did it several times, but today I am adding little twist.

Load libraries and data

library(tidyverse)
library(readxl)
library(memoise)

input = read_excel("Nth Fibonacci Number.xlsx", range = "A1:A10")
test = read_excel("Nth Fibonacci Number.xlsx", range = "B1:B10") %>%janitor::clean_names()

Prepare and run function

What is the twist here? We use one technique that I learned not long time ago — memoization. Function with this feature just storing new results in cache and if find out that such computation was already done, do not make calculation, but take result from cache. In our case for example if we do it without memoization line 9 (with 73rd term) would need 72 recursive additions, while if we do it that way: we would have one read from cache, because fib(68) was already stored in cache, and 5 recursive additions.
It will significantly improve data processing time.

fib <- memoise(function(n) {
  if (n <= 2) {
    return(1)
  } else {
    return(fib(n - 1) + fib(n - 2))
  }
})

result = input %>%
  mutate(fib = map_dbl(input$N, fib)) %>%
  select(fib)

Validation

identical(result$fib, test$answer_expected)
#> [1] TRUE

Puzzle 340

This puzzle is extremely easy when approaching it with tidyverse, but goal for “Excel” solvers where to use newly added functions. So let see how lubridate is doing job for us.

Loading libraries and data

library(tidyverse) # lubridate is loading with tidyverse
library(readxl)

input = read_excel("Date Min Max.xlsx", range = "A1:A20")
test = read_excel("Date Min Max.xlsx", range = "C2:F8")

Transformation

result = input %>%
  mutate(Year = year(Date),
         Half = str_c(semester(Date),"H")) %>%
  group_by(Year, Half) %>%
  summarise(`Min Date` = min(Date),
            `Max Date` = max(Date)) %>%
  ungroup()

Validation

identical(test, result)
#> [1] TRUE

Puzzle 341

We have to sort some things… against all odds. Or maybe not. We have to sort only digits in given numbers that are on odd positions (1,3,5 and so on). Let’s try it out.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Sort Alternate.xlsx", range = "A1:A11") %>% janitor::clean_names()
test = read_excel("Sort Alternate.xlsx", range = "B1:B11") %>% janitor::clean_names()

Transforming data

sort_odd_digits = function(number) {
  digits = strsplit(as.character(number), "")[[1]]
  if (length(digits) < 2) {
    return(as.numeric(paste0(digits, collapse = "")))
  }
  odd_digits = digits[seq(1, length(digits), 2)]
  even_digits = digits[seq(2, length(digits), 2)]
  sorted_odd = sort(odd_digits)
  digits[seq(1, length(digits), 2)] = sorted_odd
  number = digits %>% paste0(collapse = "")
  return(number)
}

result  = input %>%
  mutate(answer_expected = map(number_string, sort_odd_digits))

Validation

identical(unlist(result$answer_expected), test$answer_expected)
#> [1] TRUE

Puzzle 342

Tsamina mina, eh, eh
Waka waka, eh, eh
Tsamina mina zangalewa
This time for Africa

I realized that I still remember World Cup in South Africa 2010. And this puzzle take us to South Africa. We have to check some IDs to find out who has illegally forged documents. ID number in South Africa has certain structure which can be checked and confirmed, but it is not that easy. There is an algorithm called Luhn Algorithm used. It is deeply described in puzzle content and on Wikipedia for example so let’s try this challenge.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("South Africa National ID Validation.xlsx", range = "A1:A10") %>% janitor::clean_names()
test  = read_excel("South Africa National ID Validation.xlsx", range = "B1:B4") %>% janitor::clean_names()

Data transformation

validate_id = function(number) {
  digits = strsplit(as.character(number), "")[[1]]
  odd_digits = digits[seq(1, 12, 2)]
  even_digits = digits[seq(2, 12, 2)]
  
  dob = str_sub(number, 1, 6) %>% as.Date(format = "%y%m%d")
  
  A = sum(as.numeric(odd_digits))
  B = str_c(even_digits, collapse = "") %>% as.numeric()
  B2 = B * 2
  C = strsplit(as.character(B2), "")[[1]] %>% as.numeric() %>% sum()
  D = A + C
  Dmod = D %% 10
  Z13 = str_sub(number, 13, 13) %>% as.numeric()
  Z = ifelse(Dmod == 0, 0, 10 - D %% 10)
  
  is_Z_valid = Z == Z13
  is_status_valid = str_sub(number, 11, 11) %>% as.numeric() %>% between(0, 1)
  is_valid_length = length(digits) == 13
  is_date_valid = !is.na(dob)
  final_check = is_Z_valid & is_date_valid & is_valid_length & is_status_valid
  
  return(final_check)
}

result  = input %>%
  mutate(answer_expected = map(sa_i_ds, validate_id)) %>%
  filter(answer_expected == TRUE)identical(result$sa_i_ds, test$answer_expected)

Validation

identical(result$sa_i_ds, test$answer_expected)
#> [1] TRUE

Puzzle 343

Palindromes are all about symetry, and I wonder if giving palindromic puzzle on no. 343 was intentional or just coincidence. Nonetheless we had some numbers given, some of them were already palindromes, some of them not. Our goal was to find nearest palindromic number. What is really interesting if you are looking for nearest palindrome from palindrome itself, there is a chance that you will find two on the same distance.

Load libraries and data

library(tidyverse)
library(readxl)
library(stringi)

input = read_excel("Nearest Palindrome.xlsx", range = "A1:A10") %>% janitor::clean_names()
test  = read_excel("Nearest Palindrome.xlsx", range = "B1:B10") %>% janitor::clean_names()

Data transformation

find_closest_palindromes <- function(number) {
  num_str <- as.character(number)
  len <- nchar(num_str)
  is_odd <- len %% 2 == 1
  half_len <- (len + 1) %/% 2
  
  first_half <- substr(num_str, 1, half_len)stat

  candidates <- map_dbl(c(1, 0, -1), ~ {
    modified_first_half <- as.numeric(first_half) + .x
    modified_first_half_str <- as.character(modified_first_half)
    if (nchar(modified_first_half_str) < half_len) {
      modified_first_half_str <- str_pad(modified_first_half_str, half_len, pad = "0")
    }
    second_half <- substr(modified_first_half_str, 1, half_len - is_odd)
    as.numeric(paste0(modified_first_half_str, stri_reverse(second_half)))
  })
  
  differences <- abs(number - candidates) 
  valid_differences <- differences[differences != 0]
  closest_values <- candidates[differences == min(valid_differences)]
  
  return(paste(closest_values, collapse = ", "))
}

result = input %>%
  mutate(result = map(number, find_closest_palindromes) %>% unlist())

Validation

identical(result$result, test$answer_expected)
#> [1] TRUE

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.