Puzzles no. 539–543

Puzzles

Author: ExcelBI

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

Puzzle #539

Many companies have to diversify their source of resources, to optimize prices etc. So they usually have their orders somehow mixed between vendors. In this case we need to assume that if there is more then one vendor we need to calculate adjusted price based on average between vendors. That looks hard, but really isn’t that much.

Loading libraries and data

library(tidyverse)
library(readxl)

path = 'Excel/539 Total Amount Per Item.xlsx'
input1 = read_excel(path, range = "A2:F11")
input2 = read_excel(path, range = "H2:I10")
test   = read_excel(path, range = "J2:J10")

Transformation

r1 = input1 %>%
  pivot_longer(cols = -c(Item, Supplier), names_to = "Range", values_to = "Price")

r2 = input2 %>%
  mutate(Range = case_when(
    Quantity > 0 & Quantity <= 5 ~ "0-5",
    Quantity > 5 & Quantity <= 10 ~ "6-10",
    Quantity > 11 & Quantity <= 20 ~ "11-20",
    Quantity > 20 ~ "20+"
  ))

r3 = r2 %>%
  left_join(r1, by = c("Item","Range")) %>%
  summarise(avg_price = mean(Price, na.rm = TRUE), .by = c("Item", "Quantity")) %>%
  mutate(Amount = round(Quantity * avg_price,1), .keep = "unused")

Validation

all.equal(r3$Amount, test$Amount)
#> [1] TRUE

Puzzle #540

Pythagorean theorem is part of math curriculum early on at least in Polish school. Thanks to this theorem we know how to calculate sides of right angled triangle and this is just beginning of fun with geometry. Today we are given area of triangle and hypotenuse of such triangle. (For those for whom English is not first language, hypotenuse is side laying just opposite from right angle. And we need to find out if given those we can calculate other sides or not. Let’s find out.

Loading libraries and data

library(tidyverse)
library(readxl)
library(numbers)

path =  "Excel/540 Right Angled Triangles.xlsx"
input = read_excel(path, range = "A2:B10")
test = read_excel(path, range = "C2:D10")

Transformation

process_triangle <- function(area, hypotenuse) {
  ab_divisors <- divisors(2 * area)
  expand_grid(a = ab_divisors, b = ab_divisors) %>%
    filter(a * b == 2 * area, hypotenuse^2 == a^2 + b^2, a < b) %>%
    transmute(base = a, perpendicular = b)
}

result = input %>%
  mutate(res = map2(Area, Hypotenuse, process_triangle)) %>%
  unnest_wider(res) %>%
  select(-Area, -Hypotenuse) %>%
  mutate(across(everything(), as.character),
         across(everything(), ~replace_na(., "NP")))

Validation

all.equal(result, test, check.attributes = FALSE)
# [1] TRUE

Puzzle #541

We have quest to look for relax… Or maybe to much said. We need to find all months from 2000 to 3000 AD that have 5 Fridays, Saturdays and Sundays. There are two conditions needed to achieve such a result. Month have to have 31 days and have to start on Friday. So as we know it, lets find it out.

Loading libraries and data

library(tidyverse)
library(readxl)

path = 'Excel/541 Months Having 5 Fri Sat Sun.xlsx'
test = read_xlsx(path)

Transformation

years  = 2000:2999
months = 1:12

dates = expand.grid(year = years, month = months) %>%
  mutate(diy = days_in_month(make_date(year, month)),
         wday = wday(make_date(year, month, 1), label = TRUE, locale = 'en'),
         month_abbr = month(make_date(year, month, 1), label = TRUE, locale = "en"), 
         date = paste0(month_abbr,"-",year)) %>%
  filter(diy == 31, wday == "Fri") %>%
  summarise(`Expected Answer` = paste(date, collapse = ", "), .by = year) %>%
  arrange(year) %>%
  select(-year)

Validation

all.equal(test, dates, check.attributes = FALSE)
#> [1] TRUE

Puzzle #542

You know that I love drawing with matrices, and today we need to make magic frame. It have to be build so first row is opposite to last, and first column to last column, and of course we are getting word to put on the frame. Let’s do some matrix carpentery.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/542 Squares from Strings.xlsx"
test_abc = read_excel(path, range = "C2:E4", col_names = FALSE) %>% as.matrix()
test_abcd = read_excel(path, range = "C6:F9", col_names = FALSE) %>% as.matrix()
test_microsoft = read_excel(path, range = "C11:K19", col_names = FALSE) %>% as.matrix()

Transformation

make_word_frame <- function(word) {
  n <- nchar(word)
  chars <- str_split(word, "")[[1]]
  M <- matrix(NA, n, n)
  
  M[1, ] <- M[, 1] <- chars
  M[n, ] <- M[, n] <- rev(chars)
  
  return(M)
}

Validation

all.equal(make_word_frame("abc"), test_abc, check.attributes = FALSE) # TRUE
all.equal(make_word_frame("abcd"), test_abcd, check.attributes = FALSE) # TRUE
all.equal(make_word_frame("microsoft"), test_microsoft, check.attributes = FALSE) # TRUE

Puzzle #543

Money, money, money… As ABBA was singing back in their days. All world revolve somehow about them, and today we need to find highest paid employees in each of given department. Let’s find out who’s the luckiest.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/543 Top 2 Salaries.xlsx"
input = read_excel(path, range = "A1:C20")
test  = read_excel(path, range = "E2:F5", col_names = FALSE)
names(test) = c("Department", "emps")

Transformation

result <- input %>%
  slice_max(Salary, n = 2, by = Department) %>%
  arrange(Department, desc(Salary), `Emp Name`) %>%
  summarise(emps = paste(`Emp Name`, collapse = ", "), .by = Department)

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.