Puzzles no. 479–483

Puzzles

Author: ExcelBI

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

Puzzle #479

Today we have pretty weird sequence to generate — Recaman’s sequence. It doesn’t make any sense in real life, it is just mathematical concept linked to recursion. Nonetheless we have done more not really practical things here, so let get into the task.
I wanted this generator to be efficient, so I measured time for it. We had 10k of elements to generate, and it tooks only 0.05 sec. One of secrets is pre-allocations of memory. Object storing sequence is not increasing size while working, because we have already created object with N empty slots at the beginning and we are only populating it.

Loading libraries and data

library(tidyverse)
library(readxl)
library(tictoc)
library(memoise)

path = "Excel/479 Recaman Sequence.xlsx"
test = read_excel(path)

Transformation

recaman_sequence <- function(n) {
  recaman <- integer(n)
  recaman[1] <- 0
  seen <- setNames(logical(n * 3), 0:(n * 3 - 1))
  seen[1] <- TRUE
  
  for (i in 2:n) {
    prev_value <- recaman[i - 1]
    next_value <- prev_value - (i - 1)
    
    if (next_value > 0 && !seen[next_value + 1]) {
      recaman[i] <- next_value
    } else {
      next_value <- prev_value + (i - 1)
      recaman[i] <- next_value
    }
    
    seen[recaman[i] + 1] <- TRUE
  }
  
  return(recaman)
}

tic()
recaman_sequence(10000)
toc()
#  0.05 sec elapsed

result = recaman_sequence(10000)

Validation

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

Puzzle #480

We already had ciphered text with many different codes, and also deciphered some. Today is time to decipher Ceasar’s Cipher. We have encrypted text and base shift for characters. Little bit tricky, because we need to have it case sensitive. But of course not impossible.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/480 Caesar's Cipher_Decrypter.xlsx"
input = read_excel(path, range = "A1:B10")
test  = read_excel(path, range = "C1:C10")

Transformation

decrypt_caesar <- function(encrypted_text, shift) {
  shift_char <- function(char, shift_value) {
    if (char %in% letters) {
      base <- 97
      char_val <- utf8ToInt(char) - base
      shifted_val <- (char_val - shift_value) %% 26
      intToUtf8(shifted_val + base)
    } else if (char %in% LETTERS) {
      base <- 65
      char_val <- utf8ToInt(char) - base
      shifted_val <- (char_val - shift_value) %% 26
      intToUtf8(shifted_val + base)
    } else {
      char
    }
  }
  decrypt_char <- Vectorize(shift_char, "char")
  decrypted_text <- map2_chr(str_split(encrypted_text, "")[[1]], 0:(nchar(encrypted_text) - 1), 
                             ~ decrypt_char(.x, shift + .y))
  paste0(decrypted_text, collapse = "")
}

result = input %>%
  mutate(`Answer Expected` = map2_chr(`Encrypted Text`, Shift, decrypt_caesar)) %>%
  select(`Answer Expected`)

Validation

identical(result, test)
# [1] TRUE

Puzzle #481

Today’s challenge is a proof that mathematicians think differently. There is a story about two professors Godfrey Hardy and Srinivasa Ramanujan. One was visiting the other and came with taxi. And one of topic of their discussion was number of this cab. Number 1729 was first discovered by them Taxicab number, which has this interesting property, that it can be written as sum of two cubes, but in more than one way. And we have to check if given numbers are Taxicab ones. It can be very memory and time consuming so I measured it as well.

Loading libraries and data

library(tidyverse)
library(readxl)
library(tictoc)

path = "Excel/481 Taxicab Numbers.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B10")

Transformation

tic()
is_taxicab = function(number) {
  x = ceiling(number^(1/3))

  df = tibble(a = 1:x, b = 1:x) %>%
    expand.grid() %>%
    filter(a <= b,
           a^3 + b^3 == number)
  check = ifelse(nrow(df) >= 2, "Y", "N")
  return(check)
}

result = input %>%
  mutate(`Answer Expected` = map_chr(Numbers, is_taxicab)) 
toc()
# 0.03 sec elapsed

Validation

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

Puzzle #482

Soccer is hot topic right now at least in Europe thanks to EURO 2024. So we have soccer related task to do. We have something looking like Champions League table, and we need to transform it into crosstable with results. We need to do some reversing to have it all correct, but it is only looking hard. Check it out.

If I would have to recommend one trick to note here, it is regex replacement with capturing group. Pretty smart solution.

Loading libraries and data

library(tidyverse)
library(readxl)
library(janitor)

path = "Excel/482 Soccer Result Grid.xlsx"

input = read_excel(path, range = "A2:C12") %>% clean_names() 
test  = read_excel(path, range = "E2:J7")

Transformation

rev_input = data.frame(team_1 = input$team_2, team_2 = input$team_1, result = input$result) %>%
  mutate(result = str_replace(result, "([0-9]+)-([0-9]+)", "\\2-\\1"))

all = bind_rows(input, rev_input) %>%
  pivot_wider(names_from = team_2, values_from = result) %>%
  arrange(team_1) %>%
  select(sort(c("team_1", colnames(.)[-1]))) %>%
  select(Team = team_1, everything()) %>%
  mutate(across(everything(), ~ifelse(is.na(.), "X", .)))

Validation

identical(all, test)
# [1] TRUE

Puzzle #483

Again we have some “drawing”. We need to populate sectors of matrix 20x20 with different but reccurent small sequences. I did it more verbatim way with every step widely written. And later I decided to make it little bit shorter and smarter using purrr functions.

Loading libraries and data

library(tidyverse)
library(readxl)

path = "Excel/483 Generate Matrix.xlsx"

test = read_excel(path, range = "A2:T21", col_names = F)

Transformation — approach 1

seg1 = 5:9
seg2 = 0:4
seg3 = rev(seg1)
seg4 = rev(seg2)

pattern1 <- c(seg3, seg2, seg1, seg4)
pattern2 <- c(seg4, seg1, seg2, seg3)
pattern3 <- c(seg1, seg4, seg3, seg2)
pattern4 <- c(seg2, seg3, seg4, seg1)

block1 <- matrix(rep(pattern1, 5), nrow = 5, byrow = TRUE)
block2 <- matrix(rep(pattern2, 5), nrow = 5, byrow = TRUE)
block3 <- matrix(rep(pattern3, 5), nrow = 5, byrow = TRUE)
block4 <- matrix(rep(pattern4, 5), nrow = 5, byrow = TRUE)

final_matrix <- rbind(block1, block2, block3, block4) %>% as.data.frame()

Validation — approach 1

all.equal(test, final_matrix, check.attributes = F)
# # [1] TRUE

Transformation — approach 2

a = 0:4
b = 5:9

patterns = list(c(rev(b),a, b, rev(a)),
                 c(rev(a),b, a, rev(b)),
                 c(b, rev(a), rev(b), a),
                 c(a, rev(b), rev(a), b))

final_matrix = patterns %>%
  map( ~ matrix(rep(.x, 5), nrow = 5, byrow = TRUE)) %>%
  reduce(rbind) %>%
  as.data.frame()

Validation — approach 2

all.equal(test, final_matrix, check.attributes = F)
# [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.