R Solution for Excel Puzzles

[This article was first published on Numbers around us - Medium, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Puzzles no. 424–418


Author: ExcelBI

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

Puzzle #414

I wonder if you know that big ships has identification number just like cars. This number is called IMO (International Maritime Organization) Number. It has specific structure and last digit is always control sum digit. Our challenge today is all about such numbers. Somehow in each number there is one character (digit in this case) missed. We need to find out and retrieve it.

IMO Number of a Vessel — This is a 7 digit number where last digit is check digit.
Check digit is calculated by multiplying first 6 digits (left to right) from 7 to 2 respectively, sum them and taking the last digit of the result.
Ex. 805353 = 8*7+0*6+5*5+3*4+5*3+3*2 = 114 = Last digit is 4.
Hence, IMO number is 8053534.
From the given IMO numbers, one digit is missing which is denoted by X.
Work out the complete IMO numbers.

Load libraries and data


input = read_excel("Excel/414 IMO Number of a Vessel.xlsx", range = "A1:A10") %>%
  filter(!`IMO Number` %in% c("36X7567", "41X6584")) 
test  = read_excel("Excel/414 IMO Number of a Vessel.xlsx", range = "A1:B10") %>%
  filter(!`IMO Number` %in% c("36X7567", "41X6584"))

# I am filtering those two numbers because they do not have single solution


find_missing_digit = function(x) {
  digits = as.character(x) %>%
    str_split("") %>%

  pos = which(digits == "X")
  mults = 7:1
  if (pos == 7) {
    missing = sum(as.numeric(digits[1:6]) * mults[1:6]) %% 10 %>% as.character()
  else {
    missing_mult = 8 - pos
    checking_number = digits[7]
    df = data.frame(digits = digits[-pos], mults = mults[-pos]) %>%
      mutate(digits = as.numeric(digits)) %>%
      filter(mults != 1) %>%
      mutate(multiplicated = digits * mults) %>%
      summarise(sum = sum(multiplicated)) %>%
    missing = data.frame(digits = 0:9, ch = checking_number, mm = missing_mult, sum = df) %>%
      mutate(sum = (sum + (digits * missing_mult)) %% 10,
             check = sum == ch) %>%
      filter(check) %>%
      select(digits) %>%
      pull() %>%
  result = str_replace(x, "X", missing) %>% as.numeric()

result = input %>%
  mutate(`Answer Expected` = map_dbl(`IMO Number`, find_missing_digit)) 


identical(result, test)
# [1] TRUE

Puzzle #415

You wonder what is this weird ilustration above. This time we have to find cyclops numbers again (meaning that has only one 0 and it is placed in center of number), but not just cyclops number, but triangular cyclops number. What triangular means? Triangular number is a number where you can place this number of objects in triangle (like bowling pins or balls in 8-ball pool). So we need to find numbers that meet both conditions, exactly first 100 of them.

A Cyclops number is a number that has a zero in the center (so, it needs to have odd number of digits and >=3 digits). The 0 should not appear anywhere else other than in center. Hence, 12035 is a Cyclops number but 12005 is not as there are more than one 0s.
Nth Triangular number is calculated by N(N+1)/2. Hence, 1, 3, 6, 10, 15….are Triangular numbers.
Find the list of first 100 Cyclops Triangular numbers i.e. which are both Cyclops as well as Triangular.

Loading libraries and data


test = read_excel("Excel/415 Triangular Cyclops Numbers.xlsx", range = "A1:A101" )


range = 1:1e7

is_triangular <- function(x) {
  n <- (-1 + sqrt(1 + 8 * x)) / 2
  n == floor(n)

r = data.frame(n = range) %>%
  mutate(nchar = nchar(n)) %>%
  filter(nchar %% 2 == 1) %>%
  mutate(zeroes = str_count(n, "0"), 
         central = substr(n, nchar/2+1, nchar/2+1)) %>%
  filter(zeroes == 1, 
         central == "0") %>%
  mutate(triangular = is_triangular(n)) %>%
  filter(triangular == TRUE) %>%
  head(100) %>%
  mutate(n = as.numeric(n))


identical(r$n, test$`Expect Answer`)
# [1] TRUE

Puzzle #416

Books, especially scientific ones, have very complicated multi-level table of contents. Some chapters are divided into subchapters, sub-subchapters or even deeper. This time we have kinda structure of book as an input. If there is one X, we have first level chapter, then two X’s subchapter, and so on. We need to make outline for TOC basing on those X’s. Not really hard I think.

Generate the number outlining.
If single X — 1, 2, 3…
If double X — 1.1, 1.2…
If triple x — 1.1.1. 1.1.2…

Load libraries and data


input = read_excel("Excel/416 Outline Numbering.xlsx", range = "A1:A20")
test  = read_excel("Excel/416 Outline Numbering.xlsx", range = "B1:B20")


result = input %>%
  mutate(level = str_count(Strings, "X")) %>%
  mutate(first_lev = cumsum(level == 1)) %>%
  mutate(second_level = cumsum(level == 2), .by = first_lev) %>%
  mutate(third_level = cumsum(level == 3), .by = c(first_lev, second_level)) %>%
  mutate(`Answer Expected` = case_when(
    level == 1 ~ paste0(first_lev),
    level == 2 ~ paste0(first_lev, ".", second_level),
    level == 3 ~ paste0(first_lev, ".", second_level, ".", third_level)
  )) %>%
  select(`Answer Expected`)


identical(result, test)    
# [1] TRUE

Puzzle #417

Segregation has many conotations, but today we only have to separate digits from letters. Easy peasy. Lets try it out.

Split the given strings whenever a changeover happens between English alphabets and numbers.
Ex. d46c8a — d, 46, c, 8, a

Load libraries and data


input = read_excel("Excel/417 Split Alphabets and Numbers.xlsx", range = "A1:A10")
test  = read_excel("Excel/417 Split Alphabets and Numbers.xlsx", range = "B1:B10")


pattern = ("[A-Za-z]+|[0-9]+")

result = input %>%
  mutate(splitted = map_chr(Data, ~str_extract_all(., pattern) %>% unlist() %>% 
                          str_c(collapse = ", "))) 


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

Puzzle #418

It looks like we need to check how long person works basing on reads from Work Time Registration System. Technically, we need to pivot table to have minimal and maximal time per person and day thrown to columns. Let’s try.

Pivot the given table for Date / Emp ID combinations with Min and Max Time. Min Time and Max Time will appear in alternate rows. First Min time will appear and then Max time in other row will appear.

Load libraries and data


input = read_excel("Excel/418 Pivot on Min and Max .xlsx", range = "A1:C26")
test  = read_excel("Excel/418 Pivot on Min and Max .xlsx", range = "E1:G13") %>%
  mutate(`Min & Max Time` = as_hms(`Min & Max Time`))


result = input %>%
  summarise(Min = min(Time), Max = max(Time), .by = c(Date, `Emp ID`)) %>%
  pivot_longer(cols = c(Min, Max), names_to = "Type", values_to = "Time") %>%
  mutate(`Min & Max Time` = as_hms(Time)) %>%
  select(-c(Type, Time)) %>%
  arrange(Date, `Emp ID`)


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

To leave a comment for the author, please follow the link and comment on their blog: Numbers around us - Medium.

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.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)