Puzzles no. 429–433

Puzzles

Author: ExcelBI

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

Puzzle #429

We all (I assume) know the Pythagorean theorem, thanks to which we can calculate sides of triangle. But today we have Pythagorean quadruples, which follows similar rules. Not to be too easy, we get 3 numbers, but without pointing which one is the longest. Let’s check how to do it.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/429 Pythagorean Quadruples.xlsx", range = "A1:A10")
test  = read_excel("Excel/429 Pythagorean Quadruples.xlsx", range = "B1:B10")

Transformation

find_quadr_solution = function(sides) {
  numbers = str_split(sides, ", ")[[1]] %>% 
    as.numeric() %>%
    na.omit()
  
  missing1 = sqrt(sum(numbers^2)) # if d side is missing
  
  pot_d = max(numbers)
  others = numbers[numbers != pot_d]
  missing2 = sqrt(pot_d^2 - sum(others^2)) # if a, b or c side is missing

  if (missing1 == floor(missing1)) {
    missing = missing1
  } else if (missing2 == floor(missing2)) {
    missing = missing2
  } else {
    missing = NA
  }

  return(missing)
}

result = input %>%
  mutate(r = map_dbl(Number, find_quadr_solution)) 

Validation

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

Puzzle #430

From time to time we are painting with numbers or characters. And this day is today. For better understanding what our host wanted us to do, I’ll better show you this “beam of light made of letters”.

I was tricky but I managed to do it. Check it out.

Loading libraries and data

library(tidyverse)
library(readxl)

Transformation

shift_left <- function(mat, shift_size) {
  n_cols <- ncol(mat)
  tibble_mat <- as_tibble(mat)
  shifted_df <- tibble_mat %>%
    pmap_dfr(., ~{
      row_values <- c(...)
      shifted_values <- c(row_values[(shift_size + 1):length(row_values)], rep(NA, shift_size))
      return(as_tibble(t(shifted_values)))
    })
  as.matrix(shifted_df)
}


for (i in 26:1) {
  M <- matrix(NA, nrow = 1, ncol = 52)
  M[1, 1:i] <- 1:i
  M <- t(apply(M, 1, rev))
  M = shift_left(M, 53-2*i)
  M[!is.na(M)] <- LETTERS[M[!is.na(M)]]
  
  if (i == 26){
    M_final <- M
  } else {
    M_final <- rbind(M_final, M)
  }
}

Export to check in Excel

mf_df = M_final %>% as.data.frame()

writexl::write_xlsx(mf_df, "430 Excel solution.xlsx")

Puzzle #431

This time we have very interesting ranking to make. We have to find which region in sales how many times was on which step of podium. Pretty crazy to think, but not really to code. Let’s go.

Loading data and libraries

library(tidyverse)
library(readxl)

input = read_excel("Excel/431 Top 3 Rankings.xlsx", range = "A1:H20")
test  = read_excel("Excel/431 Top 3 Rankings.xlsx", range = "J2:K5")

Transformation

result = input %>%
  pivot_longer(cols = -c(1), names_to = "year", values_to = "result") %>%
  mutate(Rank = dense_rank(desc(result)) %>% as.numeric(), .by = year) %>%
  filter(Rank <= 3) %>%
  summarise(n = n_distinct(year), .by = c("Region", "Rank")) %>%
  mutate(check = n == max(n), .by = "Rank") %>%
  filter(check) %>%
  summarise(Regions = paste(Region, collapse = ", "), .by = "Rank") %>%
  arrange(Rank) 

Validation

identical(result, test)
# [1] TRUE

Puzzle #432

Ciphering is always fun, and this time again we have some words to code. Technique for current task is Bifid cipher. We take letter, then look for their coordinate in coding square, take them, fold it like phylo pastry, squeeze together, get those squeezed numbers and match with coding square again to get encoded letter. Again easier to code than to explain :).

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/432 Bifid Cipher_Part 1.xlsx", range = "A1:A10")
test  = read_excel("Excel/432 Bifid Cipher_Part 1.xlsx", range = "B1:B10")

Transformation

create_coding_square <- function() {
  Letters = c(letters[1:9], letters[11:26])
  df = as.data.frame(matrix(Letters, nrow = 5, byrow = TRUE)) %>%
    pivot_longer(cols = everything()) %>%
  mutate(column = as.numeric(str_extract(name, "[0-9]+")),
         row = rep(1:5,each =  5)) %>%
  select(-name)
  return(df)
}

bifid_encode = function(text) {
  coding_square = create_coding_square()
  text = str_replace_all(text, "J", "I")
  chars = str_split(text, "")[[1]]

  coords = map_dfr(chars, function(char) {
    coords = coding_square %>%
      filter(value == char) %>%
      select(row, column)
    return(coords)
  }) 
  coords = paste0(coords$row, coords$column) %>%
    str_split("", simplify = TRUE) %>%
    as.numeric() %>%S
    matrix(ncol = 2, byrow = TRUE) %>%
    as.data.frame()
  
  encoded = coords %>%
    left_join(coding_square, by = c("V1" = "row", "V2" = "column")) %>%
    pull(value) %>%
    paste0(collapse = "")
  
  return(encoded)
}

result = input %>%
  mutate(`Answer Expected` = map_chr(`Plain Text`, bifid_encode)) %>%
  select(`Answer Expected`)

Validation

identical(result, test)
# [1] TRUE

Puzzle #433

My favourite type of puzzles — text manipulation. We get some kind of notes that should be placed in table columns, but are squeezed in one. But never mind, it is easy to clear this mess. Even in three different way even.

Loading libraries and data

library(tidyverse)
library(readxl)
library(unglue)

input = read_excel("Excel/433 Text Split.xlsx", range = "A1:A20")
test  = read_excel("Excel/433 Text Split.xlsx", range = "C1:G20")

First approach — separate()

result = input %>%
  separate(Text, into = c("Levels", "Names"), sep = " : ") %>%
  separate(Levels, into = c("Level1", "Level2", "Level3"), sep = "\\.") %>%
  separate(Names, into = c("First Name", "Last Name"), sep = " ") %>%
  select(-c(...2))

Second approach — RegEx

pattern = "(\\d+)(\\.\\d+)?(\\.\\d+)?\\s*:\\s*(\\w+)\\s+(\\w+)"

result = str_match(input$Text, pattern) %>%
  as_tibble() %>%
  select(-c(1)) %>%
  mutate(across(c("V2", "V3", "V4"), ~ str_replace(.x, pattern = "[:punct:]", replacement = ""))) %>%
  setNames(c("Level1", "Level2", "Level3", "First Name", "Last Name"))

Third approach — unglue

patterns = c("{Level1}.{Level2}.{Level3} : {`First Name`} {`Last Name`}",
             "{Level1}.{Level2} : {`First Name`} {`Last Name`}",
             "{Level1} : {`First Name`} {`Last Name`}")

result = input %>%
  unglue_unnest(Text, patterns = patterns) %>%
  select(Level1,Level2,Level3,`First Name` = `X.First.Name.`,`Last Name`= `X.Last.Name.`)

Validation

identical(result, test)
# [1] TRUE

# for each of three solutions :D

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.