[This article was first published on Numbers around us - Medium, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Puzzles no. 514–518

### Puzzles

Author: ExcelBI

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

### Puzzle #514

Today we are searching for treasure. Exactly what we need is to find highest 2×2 submatrix within 5×5 matrix. Manually it would take maybe a minute, but we need to code it somehow. Not the easiest task but managable. Lets look at this problem.

```library(tidyverse)

path = "Excel/514 Sub Grid Maximum Sum.xlsx"
input = read_excel(path, range = "B2:F6", col_names = F) %>% as.matrix()
test  = read_excel(path, range = "H1:H4") %>% arrange(`Answer Expected`)```

#### Transformation

```indices = expand.grid(i = 1:(nrow(input) - 1), j = 1:(ncol(input) - 1))
results = indices %>%
pmap(function(i, j) {
sub_mat = input[i:(i + 1), j:(j + 1)]
list(matrix = sub_mat, sum = sum(sub_mat, na.rm = TRUE))
})
max_sum = max(map_dbl(results, "sum"))
max_subs = keep(results, ~ .x\$sum == max_sum)
max_subs_str = map_chr(max_subs, ~ paste(apply(.x\$matrix, 1, paste, collapse = ", "), collapse = " ; ")) %>%
tibble(`Answer Expected` = .) %>%

#### Validation

```identical(max_subs_str, test)
#> [1] TRUE```

### Puzzle #515

Sometimes data notation is exactly like in “matryoshka” doll from Russia. It is concatenated, then some rows are bind together and it is not the last level of depth. But if something is wrapped, can be unfolded again, just as our data. Check it out.

```library(tidyverse)

path = "Excel/515 Normalization of Data.xlsx"
input = read_excel(path, range = "A2:B7")
test  = read_excel(path, range = "D2:F20")```

#### Transformation

```result = input %>%
separate_rows(Data, sep = "(?=[A-Z])") %>%
separate(Data, into = c("Name", "Seq"), sep = ":") %>%
separate_rows(Seq, sep = ",") %>%
filter(!is.na(Seq)) %>%
mutate(Seq = as.numeric(Seq),
Name = trimws(Name)) %>%
select(Seq, Name, State) %>%
arrange(Seq)          ```

#### Validation

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

### Puzzle #516

Sometimes we are checking different types and differently named numbers. Today we need to find out what is the smallest possible number (if possible at all), which product of digits give us our number. Diving deep into properties of numbers is what we like the most. Lets find it out.

```library(tidyverse)

path = "Excel/516 Product of Digits of Result is Equal to Number.xlsx"
input = read_excel(path, range = "A1:A10")
test  = read_excel(path, range = "B1:B10") %>%

#### Transformation

```find_smallest_number_with_digit_product = function(n) {
if (n == 0) return(10)
if (n == 1) return(1)
factors = c()
for (i in 9:2) {
while (n %% i == 0) {
factors = c(factors, i)
n = n / i
}
}
if (n > 1) return("NP")
return(paste(sort(factors), collapse = ""))
}

result = input %>%
mutate(`Answer Expected` = map_chr(Number, find_smallest_number_with_digit_product)) %>%
select(2)```

#### Validation

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

### Puzzle #517

Again we are fighting with power of exponentiation, but little bit another way. We do not need to calculate squares or cubes, we just need to add some numbers together to get squares. Just like laying down domino, we have to find order of numbers in which each consecutive pair gives square as sum. There is more than two solution for this task, but I managed to get one we have in possible answers. Easy math in not easy task… Let’s do it.

```library(tidyverse)
library(combinat)

path = "Excel/517 Arrange Numbers to Form Square Chains.xlsx"
input = read_excel(path, range = "A1:A10") %>% unlist()
test  = read_excel(path, range = "B1:B10") %>% unlist()```

#### Transformation

```is_perfect_square <- function(x) {
sqrt_x <- sqrt(x)
sqrt_x == floor(sqrt_x)
}

is_valid_sequence <- function(nums) {
all(map2_lgl(nums[-length(nums)], nums[-1], ~ is_perfect_square(.x + .y)))
}

find_valid_permutation <- function(nums) {
permutations <- permn(nums)
valid_perm <- keep(permutations, is_valid_sequence)
if (length(valid_perm) > 0) {
return(valid_perm[[1]])
} else {
return(NULL)
}
}

result = find_valid_permutation(input)```

#### Validation

```all.equal(unname(result), unname(test))
# [1] TRUE```

### Puzzle #518

And nice “almost” real-life task. We need to rank students based on the grades. But we have American grades, and they are not making this task easy, because they are letters, not numbers. So we will use benefit of factors this time. And we need to ignore F’s into ranking. Let’s go.

```library(tidyverse)

path = "Excel/518 Rank Students.xlsx"
input = read_excel(path, range = "A1:B20")
test  = read_excel(path, range = "C1:C20")```

#### Transformation

```input\$Grades <- factor(input\$Grades,
levels = c("A+", "A", "A-", "B+", "B", "B-", "C+", "C", "C-", "D+", "D", "D-"),
ordered = TRUE)

result <- input %>%
mutate(rank = ifelse(Grades == "F",
NA,

#### Validation

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

To leave a comment for the author, please follow the link and comment on their blog: Numbers around us - Medium.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

# Never miss an update! Subscribe to R-bloggers to receive e-mails with the latest R posts.(You will not see this message again.)

Click here to close (This popup will not appear again)