Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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.

```library(tidyverse)
library(tictoc)
library(memoise)

path = "Excel/479 Recaman Sequence.xlsx"

#### 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.

```library(tidyverse)

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)) %>%

#### 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.

```library(tidyverse)
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 %>%
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.

```library(tidyverse)
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.

```library(tidyverse)

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.