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

Puzzles no. 374–378

### Puzzles

Author: ExcelBI

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

### Puzzle #374

Palindromes are pretty common topic in our puzzles, but always there is little twist, and today is not exception. We have “polluted” palindromes, and I want to say that way that if there wouldn’t be certain letter in it, it would be perfect palindrome. So what we have to do? Get the string, try to remove letter by letter and check if any of those strings is palindrome if one of character was removed. Let’s code it.

```library(tidyverse)
library(stringi)

input = read_excel("Excel/374 Palindrome After Removal.xlsx", range = "A1:A10")
test  = read_excel("Excel/374 Palindrome After Removal.xlsx", range = "B1:B10")```

#### Transformation

```is_palindrome = function(word) {
word == stri_reverse(word)
}

find_palindromes = function(string) {
vec = str_split(string, "")[[1]]
n = length(vec)
possible_palindromes = map(1:n, ~ paste0(vec[-.x], collapse = "")) %>%
unlist() %>%
keep(is_palindrome)
if (length(possible_palindromes) == 0) {
return(NA_character_)
}
else{
unique(possible_palindromes) %>% paste0(collapse = ", ")
}
}

result = input %>%

#### Validation

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

### Puzzle #375

For example in Poland right now, first semester of school year had ended and kids have winter break. That also mean that grades for first semester where assigned. So we have similar task today on ExcelBI puzzle. We have point values for each student and we need to recalculate them to grades following specific rules. But additional condition were made for us… To make it as short as possible. Let’s do it.

```library(tidyverse)

#### Transformation

```calculate_grade <- function(marks) {
case_when(
marks >= 90 & marks <= 100 ~ "A+",
marks >= 85 & marks < 90  ~ "A",
marks >= 80 & marks < 85  ~ "A-",
marks >= 70               ~ ifelse(marks %in% 70:72, "B-", ifelse(marks %in% 73:76, "B", "B+")),
marks >= 60               ~ ifelse(marks %in% 60:62, "C-", ifelse(marks %in% 63:66, "C", "C+")),
marks >= 50               ~ ifelse(marks %in% 50:52, "D-", ifelse(marks %in% 53:56, "D", "D+")),
marks < 50                ~ "F"
)
}

result = input %>%

#### Validation

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

### Puzzle #376

We had Fibonacci sequence a lot of times here. Some of its variations as well. But today we have two sequences that has the same mechanism of creating next term, but differing on first two terms. First is classic Fibonacci starting from 0 and 1, and second was Lucas sequence starting with 2 and 1. But this would be to easy. Result of our task is to multiply sequences respectively by their terms (first times first, second times second and so on). Length of sequence was defined to 20 terms.

If mechanism of sequence creating is identical, I thought that we can do it by function. Lets do it.

```library(tidyverse)

test = read_excel("Excel/376 Mult of Lucas and Fibonacci.xlsx", range = "A1:A21") %>%

#### Transformation

```generate_sequence = function(n, first = 1, second = 1) {
if (n == 1)
return(first)
if (n == 2)
return(c(first, second))

sequence = reduce(rep(1, n - 2), function(x, y) {
c(x, sum(tail(x, 2)))
}, .init = c(first, second))

return(sequence)
}

fib = generate_sequence(20, 0, 1)
lucas = generate_sequence(20, 2, 1)

result = tibble(fib = fib,
lucas = lucas,
ratio = lucas * fib) %>%
pull(ratio)```

#### Validation

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

### Puzzle #377

Today we are back to old, good ciphering algorithms. One of the easiest but still working ciphering tools is Keyword Cipher. We are taking our Keyword, add it at the begining of the alphabet (without repetitions) and remove its letters from further order of alphabet. First thing to code for us is function that will rearrange alphabet, and then the rest. Come on.

```library(tidyverse)

input = read_excel("Excel/377 Keyword Cipher.xlsx", range = "A1:B10")
test  = read_excel("Excel/377 Keyword Cipher.xlsx", range = "C1:C10")```

#### Transformation

```prepare_keycode = function(keyword) {
keyword = str_split(keyword, "")[[1]] %>%
unique()
alphabet = letters
keycode = c(keyword, alphabet[!alphabet %in% keyword])
return(keycode)
}

encode = function(sentence, keyword) {
keycode = prepare_keycode(keyword)
code = set_names(keycode, letters)
words = str_split(sentence, " ")[[1]]
words = words %>%
map(str_split, "") %>%
map(function(x) {
x = x %>%
unlist() %>%
code[.] %>%
paste(., collapse = "")
return(x)
})
sentence = paste(words, collapse = " ")
return(sentence)
}

result = input %>%
mutate(`Answer Expected` = map2_chr(`Plain Text`, Keyword, encode))```

#### Validation

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

### Puzzle #378

Today we have table with comma separated series of number. They are not really in any order or system. And we are tasked with cut this random sequence in place where for there first time sum on the left hand would be bigger than sum on there right hand. If it occurs more than once, we only take first from the left. Let’s play with vectors then.

```library(tidyverse)

input = read_excel("Excel/378 Split When Sum of LH is GT RH.xlsx", range = "A1:A10")
test  = read_excel("Excel/378 Split When Sum of LH is GT RH.xlsx", range = "B1:C10") %>%
janitor::clean_names() %>%
select(cut_1test = 1, cut_2test = 2)```

#### Transformation and validation

```find_cut_point = function(n_vec) {
vec = str_split(n_vec, ", ")[[1]] %>% as.numeric()
n = length(vec)
for (i in 1:n) {
if (sum(vec[1:i]) > sum(vec[(i + 1):n])) {
return(i)
}
}
}

cut_vector = function(n_vec) {
vec = str_split(n_vec, ", ")[[1]] %>% as.numeric()
cut_point = find_cut_point(n_vec)
p1 = vec[1:cut_point] %>% str_c(collapse = ", ")
p2 = vec[(cut_point + 1):length(vec)] %>% str_c(collapse = ", ")
return(list(p1, p2))
}

result = input %>%
mutate(cut = map(Numbers, cut_vector)) %>%
unnest_wider(cut, names_sep = "_") %>%
bind_cols(test) %>%
mutate(check_cut1 = cut_1 == cut_1test,
check_cut2 = cut_2 == cut_2test)```

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.