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. 489–493

Puzzles

Author: ExcelBI

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

Puzzle #489

Today we get some kind of schedule of appointments, we have time intervals of various length and names placed on crossing of interval and weekday. Of course designing tables beforehand is not really intuitive to do, that’s why we as analysts will have job at least for next couple of years. Find out how to count hours for each person we have.

Loading libraries and data

library(tidyverse)
library(readxl)
library(hms)

path = "Excel/489 Total Time in a Week.xlsx"
input = read_excel(path, range = "A2:H6")
test  = read_excel(path, range = "J2:K6")

Transformation

result = input %>%
  pivot_longer(-c(`Time Period`), names_to = "wday", values_to = "Name") %>%
  separate(`Time Period`, into = c("start", "end"), sep = " - ") %>%
  mutate(across(c(start, end), ~as_hms(parse_time(.)))) %>%
  mutate(duration = difftime(end, start, units = "hours") %>% as.numeric()) %>%
  na.omit() %>%
  summarise(`Total Hours` = sum(duration), .by = Name)

Validation

identical(result, test)
# [1] TRUE

Puzzle #490

This time we have data structure looking like some chemistry notes or table of content but without proper numbering. We have to create our TOC using rules mentioned in instruction above. Let’s fill empty numbers.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/490 - Fill Down.xlsx"
input = read_xlsx(path, range = "A1:B18")
test  = read_xlsx(path, range = "C1:C18")

Transformation

result = input %>%
  fill(`Level 1`, .direction = "down") %>%
  group_by(group = cumsum(`Level 1` != lag(`Level 1`, default = first(`Level 1`))) + 1) %>%
  mutate(
    nr1 = row_number(),
    L2 = !is.na(`Level 2`) & nr1 != 1,
    L2_n2 = ifelse(L2, cumsum(L2), 0),
    `Answer Expected` = as.numeric(paste0(group, ".", L2_n2))
  ) %>%
  ungroup() %>%
  select(`Answer Expected`)

Validation

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

Puzzle #491

When I saw this task for first time my mind went to the beautiful Masurian Lakes. You should check them at least using Google Maps or Google Street view. Why I was thinking about it? Because result of our efforts should look like cloth on sailboat. So today we are constructing sails. Ahoy fellow analysts.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/491 Draw A Hollow Half Pyramid.xlsx"

test5 = read_excel(path, range = "C1:G6") %>% as.matrix()
test8 = read_excel(path, range = "C8:J16") %>% as.matrix()

Transformation

draw_halfpyramid = function(input) {
  matrix = matrix(NA, nrow = input, ncol = input)  
  for (i in 1:input) {
    matrix[i, 1] = 1
    matrix[i, i] = i
    matrix[input, i] = i
  }
  return(matrix)
}

Validation

all.equal(draw_halfpyramid(5), test5, check.attributes = FALSE) # TRUE
all.equal(draw_halfpyramid(8), test8, check.attributes = FALSE) # TRUE

Puzzle #492

That is one of many ciphering challenges. This one is based on Ceasar Cipher, but not with one common shift, but each number has its own shift based on key which is numeric representation of dates. And today we don’t encode, but decode texts. Let’s try.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/492 Date Shift Cipher Decrypter.xlsx"

input = read_xlsx(path, range = "A1:B7")
test  = read_xlsx(path, range = "C1:C7")

Transformation

decrypt_date_cipher <- function(text, date) {
  key <- str_sub(str_c(rep(date, ceiling(nchar(text) / nchar(date))), collapse = ""), 1, nchar(text))
  text_nums <- utf8ToInt(str_to_lower(text)) - utf8ToInt("a")
  key_nums <- key %>%
    str_split("") %>%
    flatten_chr() %>%
    as.integer()
  decrypted_nums <- map2_int(text_nums, key_nums, ~ (.x - .y + 26) %% 26 + utf8ToInt("a"))
  decrypted_text <- intToUtf8(decrypted_nums)
  return(decrypted_text)
}

output = input  %>%
  mutate(`Answer Expected` = map2_chr(Message, Key, decrypt_date_cipher))

Validation

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

Puzzle #493

Imagine that whe have certain packages of wooden blocks for kids. Each has it is ordinal number and capacity. But we are not allowed to pack them up in boxes with boxes exceeding 100 units. So we need to get new box each time we suppose to cross the line of 100 units, and make a note which bigger box contains which packages and how many small packages we have in. Check it out using accumulate function.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/493 Start End Indexes for a Particular Sum.xlsx"

input = read_excel(path, range = "A2:B21")
test  = read_excel(path, range = "D2:F9")

Transformation

result = input %>%
  mutate(group = accumulate(Number, ~{if(.x + .y > 100) .y else .x + .y}),
         group = cumsum(group == Number)) %>%
  summarise(`Start Index` = min(Index), `End Index` = max(Index), Sum = sum(Number), .by = group) %>%
  select(`Start Index` , `End Index`, Sum)

Validation

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.
On my Github repo there are also solutions for the same puzzles in Python. Check it out!


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)