Puzzles no. 464–468

Puzzles

Author: ExcelBI

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

Puzzle #464

As you already now well, Vijay A. Verma aka ExcelBI love finding some unique sequences of numbers and then combine them, and this time is something like this again. Today we have evil numbers that are palindromic sa well. Probably just like me you haven’t heard about evil ones before. They are numbers that if you transform it to binary, will have even number of ones. Palindromic ones are easy. They need to be like in mirror, read from start and end looks exactly the same. Today special is function intToBin() thanks to which we bring binary representation of number painlessly.

Loading libraries and data

library(tidyverse)
library(readxl)
library(stringi)
library(R.utils)

test = read_excel('Excel/464 Palindromic Evil Numbers.xlsx', range = "A1:A1001")

Transformation

is_palindromic = function(x) {
  x_str <- as.character(x)
  x_str == stri_reverse(x_str)
}

is_evil = function(x) {
  str_count(intToBin(x),"1") %% 2 == 0
}

range = tibble(numbers = 1:1000000) %>%
  mutate(palindromic = is_palindromic(numbers),
         evil = is_evil(numbers)) %>%
  filter(palindromic & evil) %>%
  filter(numbers >= 10) %>%
  head(1000)

Validation

all.equal(range$numbers, test$`Answer Expected`)
# [1] TRUE

Puzzle #465

Today we have (for me personally), one of harder challenges, because it is about optimisation of resource allocation. I am not really familiar with it on professional ground, so I only tried to achieve a goal. I hope you will find it interesting and insightful.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/465 Task Assignment.xlsx", range = "A1:E10")

Transformation

task_candidates <- input  %>%
  select(Task_ID = `Task ID`, P1, P2, P3, P4) %>%
  pivot_longer(cols = P1:P4, names_to = "Person", values_to = "Candidate") %>%
  filter(!is.na(Candidate))

assignments <- tibble(Task_ID = integer(), Person = character())

assign_tasks <- function(candidates) {
  task_count <- tibble(Person = unique(candidates$Person), Count = 0)
  
  for (task in unique(candidates$Task_ID)) {
    possible_people <- candidates %>%
      filter(Task_ID == task) %>%
      arrange(task_count$Count[match(Person, task_count$Person)])
    
    chosen_person <- possible_people$Person[1]
    assignments <<- assignments %>% add_row(Task_ID = task, Person = chosen_person)
    task_count$Count[task_count$Person == chosen_person] <- task_count$Count[task_count$Person == chosen_person] + 1
  }
}

assign_tasks(task_candidates)

while (any(assignments %>% count(Person) %>% pull(n) > 3)) {
  assignments <- tibble(Task_ID = integer(), Person = character())
  assign_tasks(task_candidates)
}

assignments %>%
  arrange(Task_ID) %>%
  mutate(Person = case_when(
    Person == "P1" ~ "A",
    Person == "P2" ~ "B",
    Person == "P3" ~ "C",
    Person == "P4" ~ "D"
  ))

Result (because can be different than shown)

Puzzle #466

We had evil numbers and now we have another weird ones. Bouncy like on trampoline. What does it mean? That order of digits in number is not decreasing, not increasing and not being flat. We need to cut them up and check how digits behave in each single number. And surprise… We need them in the number of 10k. Quite a big number so I used technique called memory allocation at the beginning. Function doesn’t need copy previous list and append new value (because it is time and memory consuming). I add vector if size 10k at the very begining, so memory is already having storage and we are just putting in the place, like book on shelves.

Loading libraries and data

library(tidyverse)
library(readxl)

test = read_excel("Excel/466 Bouncy Numbers.xlsx", range = "A1:A10001")

Transformation

is_bouncy = function(n) {
  digits = str_split(as.character(n), "")[[1]] %>% as.integer()
  is_decreasing = all(digits == cummax(digits))
  is_increasing = all(digits == cummin(digits))
  return(!is_decreasing & !is_increasing)
}

find_bouncy_numbers = function(limit) {
  bouncy_numbers = integer(limit)
  count = 0
  num = 100
  
  while (count < limit) {
    if (is_bouncy(num)) {
      count = count + 1
      bouncy_numbers[count] = num
    }
    num = num + 1
  }
  bouncy_numbers
}

bouncy_numbers = find_bouncy_numbers(10000)

Validation

all.equal(as.numeric(test$`Answer Expected`), bouncy_numbers) 
# TRUE

Puzzle #467

Little bit less numbers, litlle bit more cleaning. Some people were planning meetings not discussing about time availability. So as usual, we have a role of “Hey Dude, could you fix it?”. Of course we could. We need to find out which meeting is overlapping another. To find it I used lubridate package and its objects intervals. However one of co-competitors use another very creative solution using non-equi overlapping joins. Check it up.

Open libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/467 Overlapping Times.xlsx", range = "A1:C8")
test  = read_excel("Excel/467 Overlapping Times.xlsx", range = "E2:L9") %>%
  select(`Task ID` = ...1, everything())

Transformation

r1 = input %>%
  mutate(interval = interval(`From Time`, `To Time`)) %>%
  select(-`From Time`, -`To Time`) 

combinations = expand_grid(r1, r1, .name_repair = "unique") %>%
  filter(`Task ID...1` != `Task ID...3`) %>%
  mutate(overlap = ifelse(int_overlaps(interval...2, interval...4), "Y", NA_character_)) %>%
  select(`Task ID` = `Task ID...1`, `Second Task ID` = `Task ID...3`, overlap) %>%
  pivot_wider(names_from = `Second Task ID`, v

Validation

identical(test, combinations)
# [1] TRUE

Puzzle # 468

Last puzzle for today was pretty tricky, and we needed to find rows that has lowest value of column C1, etc. So my approach was to find indices of rows that fulfill our conditions, extract them and bind them together. Check how I use map_int, map_dfr and which.min/which.max.

Loading data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Excel/467 Generate Min and Max Rows.xlsx", range = "A2:F20") 
test  = read_excel("Excel/467 Generate Min and Max Rows.xlsx", range = "I2:N10")

inst = read_excel("excel/467 Generate Min and Max Rows.xlsx", range = "H3:H10", col_names = "Inst")

Transformation

r1 = inst %>%
  mutate(Inst = str_sub(Inst,1,6)) %>%
  separate(Inst, into = c("fun", "column"), sep = " ", remove = F) %>%
  mutate(fun = str_to_lower(fun))

r2 = r1 %>%
  mutate(index = ifelse(fun == "min",
                        map_int(column, ~which.min(input[[.x]])),
                        map_int(column, ~which.max(input[[.x]]))))


result = map_dfr(r2$index, ~input[.x,])

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.
PS. Couple weeks ago, I started uploading on Github not only R, but also in Python. Come and check it.

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.