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

Puzzles no. 499–413

### Puzzles

Author: ExcelBI

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

### Puzzle #499

Interesting numbers are pretty often in scope of our puzzles. Today we have Lynch-Bell Numbers, and we need to find first 500 of them. Why they are special? Because of 4 conditions: none of digits repeat, there is no 0 in it, is at least 2 digits long and it is divisible by all of its digits. So many conditions to code as well. It is case we have pretty memory consuming calculation and it took code about 1.5 to 2 minutes to get 500 hundred of them. Look at it and at the end I will show another solution that is much faster.

```library(tidyverse)
library(tictoc)

path = "Excel/499 Lynch Bell Numbers.xlsx"
test = read_excel(path, range = "A1:A501")```

#### Transformation (with time measuring)

```contains_zero <- function(number) {
any(strsplit(number, "")[[1]] == "0")
}

has_unique_digits <- function(number) {
digits <- strsplit(number, "")[[1]]
length(unique(digits)) == length(digits)
}

is_self_dividing <- function(number) {
digits <- as.numeric(strsplit(number, "")[[1]])
all(digits != 0 & as.numeric(number) %% digits == 0)
}

get_numbers <- function(number_of_digits) {
start <- 10^(number_of_digits - 1)
end <- 10^number_of_digits - 1
range <- as.character(start:end)

result <- range %>%
keep(~ !contains_zero(.x) && has_unique_digits(.x) && is_self_dividing(.x))

return(tibble(number = result))
}

tic()
result = map_dfr(2:7, ~ get_numbers(.x)) %>% head(500)
toc()
# 119.52 sec elapsed```

#### Validation

```identical(as.numeric(result\$number), test\$`Answer Expected`)
#> [1] TRUE
Extra solution in Python: only 3 seconds to run

import pandas as pd
import time

path = "499 Lynch Bell Numbers.xlsx"

def check_lynchbell(n):
s = str(n)
if "0" in s or len(set(s)) < len(s) or n <= 10: return False
return all(n%int(d) == 0 for d in s)

start_time = time.time()
numbers = [k for k in range(9876543) if check_lynchbell(k)][:500]
end_time = time.time()

execution_time = end_time - start_time

print("Execution time:", execution_time, "seconds") # Execution time: 3.345 seconds
print(test == numbers) # TruePuzzle #500```

Sometimes people are not calculating thing regularly, and then need to do much more job at once. And this is how we see this problem table in our task. Person responsible for it just noted total amount, but we need exact number for each point each day. Fortunatelly it is easier that it seems.

And guess what? We already did this task before. Because of some mistake we have this doubled. Solutions are ready here:
https://github.com/kgryczan/excelbi_puzzles/blob/main/Power%20Query/PQ_Challenge_194.R
https://github.com/kgryczan/excelbi_puzzles/blob/main/Power%20Query/PQ_194.py

PowerQuery Puzzle solved with R

### Puzzle #501

In today’s matrix we have some hidden patterns, some numbers like golden threads are used couple of times in line. And we need to find them either horizontally or vertically. Let’s check it.

```library(tidyverse)

path = "Excel/501 Find Consecutives in Grid.xlsx"
input = read_excel(path, range = "B2:M10", col_names = FALSE)
test  = read_excel(path, range = "O1:O6")```

#### Transformation

```i1 = as.matrix(input)
i2 = t(i1)

find_repeats_in_rows <- function(matrix) {
unique(unlist(apply(matrix, 1, function(row) {
row[which(diff(row) == 0)]
})))
}

result = union(find_repeats_in_rows(i1),
find_repeats_in_rows(i2)) %>%
sort() %>%
as_tibble() %>%

#### Validation

```identical(result, test)
# [1] True                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           1] TRUE                                                                                                                                                                                                                                                                                                                                                                          ```

### Puzzle #502

Sometimes to construct something new we have to deconstruct something old. And we need to remove some digits to find maximal number that is cube, but is also contains digits from given numbers. But we can also remove some digit if it helps achieving goal. And as result we need to show this max cube and digits we are removing. Find out how to do it.

```library(tidyverse)

path = "Excel/502 Remove Minimum Digits to Make a Cube.xlsx"
input = read_excel(path, range = "A2:A10")
test  = read_excel(path, range = "B2:C10")```

#### Transformation

```cube_number <- function(number) {
str_nums <- str_split(as.character(number), "")[[1]]
digits_combinations <- map(1:(length(str_nums) - 1), ~combn(str_nums, ., simplify = FALSE))
all_combinations <- flatten(digits_combinations) %>% map_chr(~paste(.x, collapse = ""))

cube <- keep(all_combinations, ~ round(as.numeric(.x)^(1/3))^3 == as.numeric(.x)) %>%
as.numeric() %>%
max(., na.rm = TRUE, finite = TRUE)

if (!is.na(cube)) {
digits_left <- setdiff(str_nums, str_split(as.character(cube), "")[[1]])
unique_digits <- unique(digits_left)
return(list(unique_digits, cube))
} else {
return(list("", ""))
}
}

result <- input %>%
mutate(result = map(Numbers, cube_number)) %>%
mutate(`Removed Digits` = map_chr(result, ~ pluck(.x, 1) %>% sort(.) %>% paste(collapse = ", ")),
`Cube Number` = map_chr(result, ~ pluck(.x, 2) %>% as.character)) %>%
mutate(`Removed Digits` = if_else(nchar(Numbers) == str_count(`Removed Digits`, "\\d"), NA, `Removed Digits`),
`Cube Number` = if_else(`Removed Digits` == "", NA, as.numeric(`Cube Number`))) %>%
select(-c(result, Numbers))```

#### Validation

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

### Puzzle #503

What we have here? Probably records from American receipts. Why American, because in other (at least western) countries taxes are included in shelf prices, unlike in USA. So today we have amounts without taxes, we know that tax is 10% except some groceries. So we need to calculate how much each customer have to pay. Let’s do it.

```library(tidyverse)

path = "Excel/503 Payments Calculations.xlsx"
input1 = read_excel(path, range = "A1:B9")
input2 = read_excel(path, range = "D1:D9") %>% pull()
test = read_excel(path, range = "F1:L9")
colnames(test)[1] = "Customer"```

#### Transformation

```result = input1 %>%
separate_rows(`Purchase product (Tax not included)`, sep = ", ") %>%
separate(`Purchase product (Tax not included)`, into = c("Product","Amount"), sep = ": ") %>%
mutate(Amount = str_remove_all(Amount, ",") %>% as.numeric(),
amount_with_tax = ifelse(Product %in% input2, Amount, Amount * 1.1)) %>%
summarise(SUM = sum(Amount),
AVERAGE = mean(Amount),
MAX = max(Amount),
MIN = min(Amount),
COUNT = n() %>% as.numeric(),
Payment = sum(amount_with_tax),
.by = Customer)```

#### Validation

```all.equal(result, test)
# Column Payment has wrong value in test data```

### Puzzle #504

Finally some text manipulation. But pretty easy. Among list of all U.S. Presidents we need to find those whose initials are all the same.

```library(tidyverse)

path = "Excel/504 US Presidents All First Chars Same.xlsx"
input = read_excel(path, range = "A1:A47")
test = read_excel(path, range = "B1:B5")```

#### Transformation

```result = input %>%
filter(map(`US Presidents`,  ~ length(str_extract_all(., "[A-Z]") %>%
unlist() %>% unique())) == 1)```

#### Validation

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

### Puzzle #505

Sometimes our task is to build structure of numbers or letters. And today we are placing whole English alphabet on pyramid. As usual in such cases I prefer do it using matrices.

```library(dplyr)
library(purrr)```

#### Transformation

```create_triangular_dataframe <- function(letters) {
n <- max(which((1:10 * (1:10 + 1)) / 2 <= length(letters)))
num_rows <- n + 1
num_cols <- n * 2 + 1

df <- data.frame(matrix("", nrow = num_rows, ncol = num_cols))

letters_idx <- 1

fill_row <- function(row_num, num_letters) {
start_col <- (num_cols - (2 * num_letters - 1)) %/% 2 + 1
df[row_num, seq(start_col, by = 2, length.out = num_letters)] <<- letters[letters_idx:(letters_idx + num_letters - 1)]
letters_idx <<- letters_idx + num_letters
}

walk(1:n, ~ fill_row(.x, .x))

fill_row(num_rows, length(letters) - (n * (n + 1)) / 2)

colnames(df) <- LETTERS[1:ncol(df)]
print(df, row.names = FALSE)
}

df = create_triangular_dataframe(LETTERS)```

### Puzzle #506

Imagine that 5 people assigned with letters A to E, are taking numbers from drawers. Some numbers are in ranges so we need to expand them, but then each person in order is placing its first number, then second number in next round and so on untill end of numbers. Doesn’t have sense in reality, but as excercise of mind it is pretty nice. Let’s do it.

```library(tidyverse)

path = "Excel/506 Align Concated Alphabets & Numbers.xlsx"
input = read_excel(path, range = "A1:B6")
test = read_excel(path, range = "C1:C22")```

#### Transformation

```replace_range <- function(input) {
input %>%
str_split(", ") %>%
unlist() %>%
map_chr(~ if (str_detect(.x, "-")) {
range <- str_split(.x, "-")[[1]] %>%
as.numeric()
paste(seq(range[1], range[2]), collapse = ", ")
} else {
.x
}) %>%
paste(collapse = ", ")
}

result = input %>%
mutate(Numbers = map_chr(Numbers, replace_range) %>% str_split(., ", ")) %>%
unnest_wider(Numbers, names_sep = "_") %>%
pivot_longer(cols = starts_with("Numbers"), values_to = "Value", names_to = NULL,  cols_vary = "slowest") %>%
filter(!is.na(Value)) %>%
unite("Expected Answer", c("Alphabets", "Value"), sep = "") %>%

#### Validation

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

### Puzzle #507

Numbers are a part of language and culture. So today we have task to sort elements of dates spoken out as words, and then check if they are sorted alphabetically. Check it.

```library(tidyverse)
library(english)

path = "Excel/507 Lexically Sorted MDY Dates.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B4")  ```

#### Transformation

```result = input %>%
mutate(parts = str_match(Dates, '(\\d{2})(\\d{2})(\\d{4})'),
lit_month = month.name[as.integer(parts[,2])],
lit_day = as.character(english(as.integer(parts[,3]))),
lit_year = as.character(english(as.integer(parts[,4])))) %>%
mutate(
is_alphabetical = pmap_lgl(list(lit_month, lit_day, lit_year),
~ {
lit_date <- c(..1, ..2, ..3)
identical(lit_date, sort(lit_date))
})
) %>%
filter(is_alphabetical) %>%

#### Validation

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

### Puzzle #508

Again we have some number generation. Now we need numbers that are perfect square and square of its digits also sums up to perfect square. Those number are just oversquared 😀 But it is not that hard as it could. Although generating sequences can be time consuming, this time it is pretty fast. Check it out.

```library(tidyverse)

path = "Excel/508 Number is Perfect Square and Sum of Squares of Digits is also a Perfect Square.xlsx"
test = read_excel(path, range = "A1:A501")```

#### Transformation

```is_perfect_square <- function(n) {
sqrt_n <- sqrt(n)
sqrt_n == floor(sqrt_n)
}

result <- integer(0)
i <- 1

while (length(result) < 500) {
if (nchar(as.character(test[i, 1])) > 1) {
if (is_perfect_square(test[i, 1]) && is_perfect_square(sum(as.numeric(strsplit(as.character(test[i, 1]), "")[[1]])^2))) {
result <- c(result, test[i, 1])
}
}
i <- i + 1
}

result = data.frame(Result =  unlist(result))```

#### Validation

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

### Puzzle #509

If you are interested in computer science or math, I am almost sure that you know what Pascal’s Triangle is. But today we don’t need to simply generate such triangle, but also calculate sum of columns of numbers that are creating it. So we need to create two function for it. Look at it.

```library(tidyverse)

path = "Excel/509 Pascal Triangle Column Sums.xlsx"
input = read_excel(path, range = "A1:A5")
test = read_excel(path, range = "B1:B5") %>%

#### Transformation

```generate_pascal_triangle = function(n) {
triangle = matrix(0, n, 2*n - 1)
triangle[1, n] = 1

for (i in 2:n) {
for (j in 1:(2*n - 1)) {
if (j == 1) {
triangle[i, j] <- triangle[i - 1, j + 1]
} else if (j == 2*n - 1) {
triangle[i, j] <- triangle[i - 1, j - 1]
} else {
triangle[i, j] <- triangle[i - 1, j - 1] + triangle[i - 1, j + 1]
}
}
}
return(triangle)
}

colsum_pascal_triangle = function(n) {
triangle = generate_pascal_triangle(n)
colsum = colSums(triangle) %>%
paste(collapse = ", ")
return(colsum)
}

result = input %>%
mutate(`Answer Expected` = map_chr(Rows, colsum_pascal_triangle)) %>%

#### Validation

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

### Puzzle #510

I like this task a lot. It is probably one of my favourite. We just need to split random string and count how many characters of each class are there. How many capital letters, how many digits, punctuators and specials and of course lower letters. Enjoy!

```library(tidyverse)

path = "Excel/510 Find Upper, Lower, Numbers & Special Chars Count.xlsx"
input = read_excel(path, range = "A2:A12")
test  = read_excel(path, range = "B2:E12")```

#### Transformation

```result = input %>%
mutate(
Data = ifelse(is.na(Data), "", Data),
`Upper Case` = str_count(Data, "[A-Z]"),
`Lower Case` = str_count(Data, "[a-z]"),
Numbers = str_count(Data, "[0-9]"),
`Special Chars` = str_count(Data, "[^A-Za-z0-9]")
) %>%
select(-Data) %>%
mutate(across(everything(), as.numeric))```

#### Validation

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

### Puzzle # 511

Pig Latin is form of encrypting messages by cutting word in certain place, change the order of parts, and then adding “ay” at the end. But today we don’t have to code it, but to decrypt it. As many people spotted, reverse logic for Pig Latin is not best. Decrypted words can be different that encoded. So I find another way and decided to look for all possible real words that could be encoded. Find out my solution.

```library(tidyverse)
library(hunspell)

path = "Excel/511 Pig Latin Decrypter.xlsx"
input = read_excel(path, range = "A1:A10")
test = read_excel(path, range = "B1:B10")```

#### Transformation

```rotate_word <- function(word, n) {
len <- nchar(word)
if (n >= len) return(word)
substr(word, n + 1, len) %>% paste0(substr(word, 1, n))
}
decrypt_pig_latin <- function(sentence) {
words <- str_split(sentence, " ")[[1]]
decrypted_words <- words %>% map_chr(~ {
word <- str_remove(.x, "ay[[:punct:]]?\$")
punctuation <- str_extract(.x, "[[:punct:]]\$")
len <- nchar(word)
possible_words <- map_chr(0:(len - 1), ~ rotate_word(word, .x))
valid_words <- possible_words %>% keep(hunspell_check)
if (length(valid_words) > 0) {
concatenated_valid_words <- paste(valid_words, collapse = "/")
if (!is.na(punctuation)) {
return(paste0(concatenated_valid_words, punctuation))
} else {
return(concatenated_valid_words)
}
} else {
return(.x)
}
})
paste(decrypted_words, collapse = " ")
}

result = input %>%
mutate(`Answer Expected` = map_chr(`Encrypted Text`, decrypt_pig_latin)) %>%

#### Validation

```result == test
# [1,]            TRUE
# [2,]            TRUE
# [3,]            TRUE
# [4,]            TRUE
# [5,]            TRUE
# [6,]            TRUE
# [7,]            TRUE
# [8,]            FALSE who/how was your weekend?
# [9,]            TRUE```

### Puzzle #512

This task was one of the most suprising to me, and one when I first time used binary manipulations. We need to find first sparse number that is bigger than given number. What sparse means? That in its binary representations we do not find any pair, triplet or bigger set of adjacent 1s. I will provide you with 2 solutions, but first is only working for smaller numbers (it didn’t manage to make last to numbers in reasonable time) and second one using binary calculations which is very fast and don’t have problem with largest numbers.

```library(tidyverse)

path = "Excel/512 Next Sparse Number.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B10")```

#### Transformation — slow method

```next_sparse_number_slow <- function(n) {
is_sparse <- function(n) {
binary_n <- intToBits(n)
for (i in 2:length(binary_n)) {
if (binary_n[i] == 1 && binary_n[i - 1] == 1) {
return(FALSE)
}
}
return(TRUE)
}
detect((n + 1):(2 * n + 1), is_sparse)
}

result = input %>%

#### Transformation — fast binary method

```next_sparse_number_fast <- function(n) {
repeat {
m <- n
k <- 0
change_required <- FALSE

while (m > 0) {
if ((m %% 4) == 3) {
change_required <- TRUE
break
}
m <- m %/% 2
k <- k + 1
}

if (!change_required) break

n <- (n %/% (2^(k + 1))) * (2^(k + 1)) + (2^(k + 1))
}
return(n)
}

result = input %>%

# Code explanation for those not familiar with binary manipulations.
Initialize Variables:
Set k to 0, which keeps track of the bit position.
Set a flag change_required to FALSE, indicating whether we need to modify the number.
Loop Until Sparse:
We enter a loop that continues until we find a sparse number.
Check for Consecutive '1's:
For each bit in m:
If the last two bits are both '1' (checked using (m %% 4) == 3), it means the number isn't sparse.
We set change_required to TRUE and exit the inner loop.
If not, move to the next bit by dividing m by 2 and incrementing k.
If change_required is TRUE (i.e., we found consecutive '1's):
Calculate the new n by clearing bits from position k onwards and setting the next higher bit.
Return the Sparse Number:
Once we have a number without consecutive '1's (change_required is FALSE), the loop stops, and we return the number n.

In Short:
The function checks each bit of the number to find if there are two '1's in a row.
If it finds them, it changes the number to remove these consecutive '1's and tries again.
This continues until the number is "sparse" (has no consecutive '1's), and then it returns that number.```

#### Validation

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

### Puzzle #513

And usually after having hard one, there is easy puzzle. Today we need to sort given number by their last digit, and if there was more than one with identical, go in order of original. Check it out.

```library(tidyverse)
library(stringi)

path = "Excel/513 Sort by Unit Digit.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B10")```

#### Transformation

```result = input %>%
arrange(str_sub(Numbers, -1)) ```

#### Validation

```identical(result\$Numbers, test\$`Answer Expected`)
# 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.