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

Puzzles no. 389–393

### Puzzles

Author: ExcelBI

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

### Puzzle #389

Today’s task is again making graphic with numbers. We already made christmas trees, diamonds and similar things, so today we have to make so called quadrant. But I see it as crosshair in rifle’s visor. After being given certain number we have to create matrix which has zero in very center, and sequence of negative values to left and bottom, and positive values to right and up. Lets do it.

```library(tidyverse)

number = read_excel("Excel/389 Quadrant.xlsx", range = "A1", col_names = FALSE) %>% pull()

as.data.frame()
colnames(test) = c(as.character(1:ncol(test)))```

#### Transforming

```generate_cross = function(size) {
full_size = 2*size+1
center = size+1
mat = matrix(NA, full_size, full_size)
seq = seq(size, -size)
rev_seq = rev(seq)
mat[center,] <- rev_seq
mat[,center] <- seq
mat = as.data.frame(mat)
colnames(mat) = c(as.character(1:ncol(mat)))
return(mat)
}

result = generate_cross(number) ```

#### Validation

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

### Puzzle #390

Now we have task that is similar to what we solved few weeks ago. Then we had to find all numbers where sum of digits is equal to products of digits, and now we have to find those which has exactly the same number of digits as sum of them. And again I used generative way rather than brute force. But… inspired by another solvers I also prepared another solution for this problem (and I learned some new math). It is based on combinatorics. Details are here.

```library(tidyverse)

input = read_excel("Excel/390 Digit Equal to Sum of Digits.xlsx", range = "A1:A6")
test  = read_excel("Excel/390 Digit Equal to Sum of Digits.xlsx", range = "A1:D6")```

#### Transformation #1 — generative

```compute = function(number) {
df =  expand.grid(rep(list(0:number), number)) %>%
mutate(sum = rowSums(.)) %>%
filter(sum == number, Var1 != 0) %>%
select(-sum) %>%
unite("NO", everything(), sep = "", remove = TRUE)

summary = df %>%
summarise(Min = min(NO) %>% as.numeric(),
Max = max(NO) %>% as.numeric(),
Count = n() %>% as.numeric())

return(summary)
}

result = input %>%
mutate(summary = map_df(Digits, compute)) %>%
unnest(summary)```

#### Transformation #2 — combinatorics

```res = input %>%
mutate(inputs = Digits - 1,
Min = 10^(inputs) + inputs,
Max = (Digits)  * 10^(inputs),
Count = choose(2 * (inputs), inputs)) %>%
unnest() %>%
select(-inputs)```

#### Validation

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

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

### Puzzle #391

One of common, but not the easiest topics in our puzzles — palindromes. Sometimes we are making number palindromes, sometimes like today — letter palindromes. We have some strings in the table and task. We need to find shortest possible (that mean we need to add as small number of letters) palindrome but only by adding some letters at the front. If some words are already palindromes that doesn’t need to be transformed. Let’s do it.

```library(tidyverse)
library(stringi)

input = read_excel("Excel/391 Palindrome After Adding in the Beginning.xlsx", range = "A1:A10")
test  = read_excel("Excel/391 Palindrome After Adding in the Beginning.xlsx", range = "B1:B10")```

#### Transformation

```is_palindrome = function(x) {
x = tolower(x)
x == stri_reverse(x)
}

palindromize = function(string) {
if (is_palindrome(string)) {
return(string)
}

string_rev = stri_reverse(string)

prefixes = map(1:nchar(string), function(i) {
substr(string_rev, 1, i)
})
candidates = map(prefixes, function(prefix) {
paste0(prefix, string)
})

palindromes = data.frame(candidate = unlist(candidates)) %>%
mutate( is_palindrome = map_lgl(candidate, is_palindrome)) %>%
filter(is_palindrome) %>%
select(candidate) %>%
arrange(nchar(candidate)) %>%
slice(1) %>%
pull()

return(palindromes)
}

result = input %>%
mutate(palindromized = map_chr(String, palindromize)) %>%
cbind(test) %>%
mutate(check = palindromized == `Answer Expected`)```

### Puzzle # 392

Even and odd numbers are like teeth of two big gears interlocking each other. They comes one after another in perfect order. But sometimes somebody decide to destroy this order. Our task is to mess letters up. We have to going from the end of word tear words by odd and even position and then just lay those letter side by side.

```library(tidyverse)
library(stringi)

input = read_excel("Excel/392 Collect Even and Odd from Backwards.xlsx", range = "A1:A10")
test  = read_excel("Excel/392 Collect Even and Odd from Backwards.xlsx", range = "B1:B10")```

#### Transformation

```transform = function(string) {
str_rev = stri_reverse(string)
chars = str_split(str_rev, "")[[1]]
even_chars = chars[seq_along(chars) %% 2 == 0] %>%
paste0(collapse = "")
odd_chars = chars[seq_along(chars) %% 2 == 1] %>%
paste0(collapse = "")
return(paste0(even_chars, odd_chars))
}

result = input %>%
mutate(transformed = map_chr(String, transform)) ```

#### Validation

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

### Puzzle #393

Another cyphering task. Yes. I love them. Today we have so called Autokey Cipher. It needs coding keyword and works following way:
1. We are getting word to code split into letters.
2. Just below we place coding keyword and fill the rest of place (position to the length of first word) with begining of coded one. (Yeah, sounds complicated).
3. We are assigning both rows of letters with its numeric values from 0 (as A) to 25 (as Z).
4. We are adding both rows and get value of Modulo 26 of resulting sum.
5. Now we have value of coded letter which we need to find in numeric values as well.

Let see it first on image:

And code now:

```library(tidyverse)

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

#### Transformation

```recode = function(string, keyword) {

alphabet = data.frame(letters = letters, value = 0:25)
string_length = nchar(string)
keyword_length = nchar(keyword)
str_chars = str_split(string, "")[[1]]
key_chars = str_split(keyword, "")[[1]]

if (keyword_length > string_length) {
full_key = key_chars[1:string_length]
} else if (keyword_length < string_length) {
nchars_to_fill = string_length - keyword_length
chars_to_fill = str_chars[1:nchars_to_fill]
full_key = c(key_chars, chars_to_fill)
} else {
full_key = key_chars
}

code_table = data.frame(string = str_chars, key = full_key)

result = code_table %>%
left_join(alphabet, by = c("string" = "letters")) %>%
left_join(alphabet, by = c("key" = "letters")) %>%
mutate(value = value.x + value.y) %>%
select(string, key, value) %>%
mutate(value_mod = value %% 26) %>%
left_join(alphabet, by = c("value_mod" = "value")) %>%
pull(letters) %>%
paste(collapse = "")

return(result)
}

result = input %>%
mutate(answer = map2_chr(`Plain Text`, `Keyword`, recode))```

#### Validation

```identical(result\$answer, 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.

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.