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

Puzzles no. 379–388

### Puzzles

Author: ExcelBI

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

Last week I were on my winter holiday and with refreshed mind, it is time to get back to work, to everyday routines, to our puzzles and challenges. I owe you my solutions for challenges for two weeks now. So If you are asking me, if I’m back, look below …

### Puzzle #379

In this puzzle we have string with sequence of numbers comma separated. Just a series of numbers but our host doesn’t really like them, because they are not really tidy. To make more order in them we have to get only those parts of string that present only numbers followed by larger one. We are checking if for each number next number is greater, and if not drop the number. Let’s code it.

```library(tidyverse)

input = read_excel("Excel/379 All Elements Larger than Preceding one.xlsx", range = "A1:A10")
test  = read_excel("Excel/379 All Elements Larger than Preceding one.xlsx", range = "B1:B10")```

#### Transformation

```check_succeeding <- function(numbers, index) {
current <- numbers[index]
succeeding <- numbers[(index + 1):length(numbers)]
all(succeeding > current)
}

process_string <- function(string) {
numbers <- str_split(string, ",\\s*")[[1]] %>%
as.numeric()

result <- map_lgl(seq_along(numbers), ~check_succeeding(numbers, .)) %>%
which() %>%
map_chr(~ as.character(numbers[.])) %>%
paste(collapse = ", ")

result = ifelse(result == "", NA_character_, result)

return(result)
}

result = input %>%

#### Validation

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

### Puzzle #380

In this puzzle we need to create matrix made from “x’s” instead of numbers, but only sides and diagonals should be filled with “x’s” and the rest should be empty. And all we have to use for this generations have to be side length. So let’s do it.

```library(tidyverse)

test1 = read_excel("Excel/380 Draw NxN Squares.xlsx", range = "A2:H9",   col_names = FALSE) %>%
as.matrix() %>% {attr(., "dimnames") <- NULL; .}
test2 = read_excel("Excel/380 Draw NxN Squares.xlsx", range = "A11:G17", col_names = FALSE) %>%
as.matrix() %>% {attr(., "dimnames") <- NULL; .}
test3 = read_excel("Excel/380 Draw NxN Squares.xlsx", range = "A19:E23", col_names = FALSE) %>%
as.matrix() %>% {attr(., "dimnames") <- NULL; .}
test4 = read_excel("Excel/380 Draw NxN Squares.xlsx", range = "A25:D28", col_names = FALSE) %>%
as.matrix() %>% {attr(., "dimnames") <- NULL; .}```

#### Transformation

```draw_sides_and_diag = function(matrix_size) {
mat = matrix(NA, nrow = matrix_size, ncol = matrix_size)
mat[1,] = "x"
mat[matrix_size,] = "x"
mat[,1] = "x"
mat[,matrix_size] = "x"
diag(mat) = "x"
diag(mat[,ncol(mat):1]) = "x"

return(mat)
}

draw_sides_and_diag(8)

[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] "x"  "x"  "x"  "x"  "x"  "x"  "x"  "x"
[2,] "x"  "x"  NA   NA   NA   NA   "x"  "x"
[3,] "x"  NA   "x"  NA   NA   "x"  NA   "x"
[4,] "x"  NA   NA   "x"  "x"  NA   NA   "x"
[5,] "x"  NA   NA   "x"  "x"  NA   NA   "x"
[6,] "x"  NA   "x"  NA   NA   "x"  NA   "x"
[7,] "x"  "x"  NA   NA   NA   NA   "x"  "x"
[8,] "x"  "x"  "x"  "x"  "x"  "x"  "x"  "x" ```

#### Validation

```all.equal(draw_sides_and_diag(8), test1)
#> [1] TRUE
all.equal(draw_sides_and_diag(7), test2)
#> [1] TRUE
all.equal(draw_sides_and_diag(5), test3)
#> [1] TRUE
all.equal(draw_sides_and_diag(4), test4)
#> [1] TRUE```

### Puzzle #381

In IPv6 addressing system there are some nice tricks that allows to write it shorter in some cases. For example four zeroes can be written as one etc. Let cite those rules from the task:

IPv6 address is represented as x:x:x:x:x:x:x:x (total 8 x) where x consists of 1 to 4 Hexadecimal digits. Following rules to be followed to shorted an IPv6 address -
1. Leading 0s should be omitted. Hence, 00A6 should be written as A6.
2. Double colons (::) should be used in place of a series of contiguous zeros. For example, IPv6 address CD34:0000:0000:0000:0000:0000:0000:A4 can be written as CD34::A4.
3. Double colons should be used only once in an IP address. Since, we are looking at shortest possible IPv6, hence double colon in this case should be used where more number of series of contiguous 0s are there.
CD34:0000:0000:2AB6:0000:0000:0000:A4 can be written as CD34:0:0:2AB6::A4 not as CD34::2AB6:0:0:0:A4.

And what we have to do? Of course shorten given addresses in all possible way.

```library(tidyverse)

input = read_excel("Excel/381 IPv6 Shortening.xlsx", range = "A1:A11")
test  = read_excel("Excel/381 IPv6 Shortening.xlsx", range = "B1:B11")```

#### Transformation

```shorten_ipv6 = function(ipv6) {
blocks = str_split(ipv6, ":")[[1]] %>%
str_replace( "^0+", "") %>%
str_replace("^\$", "0")

zeros = blocks %>%
str_detect("^0+\$") %>%
which() %>%
unlist()  %>%
data.frame(x = .) %>%
mutate(group = cumsum(x - lag(x, default = 0) > 1)) %>%
group_by(group) %>%
mutate(n = n(),
min_index = min(x),
max_index = max(x)) %>%
ungroup() %>%
arrange(desc(n), group) %>%
slice(1)

first_zero = zeros\$min_index
last_zero = zeros\$max_index

block_df = data.frame(blocks = blocks,
index = 1:length(blocks),
stringsAsFactors = FALSE)

block_df\$blocks[block_df\$index >= first_zero & block_df\$index <= last_zero] = ""

result = block_df\$blocks %>%
str_c(collapse = ":")  %>%
str_replace(., ":{2,}", "::")

return(result)
}

result = input %>%

#### Validation

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

### Puzzle #382

This is one of two puzzles concerning “Kamasutra Cipher” in today’s episode. This kind of cipher is based on randomly mixing set of characters used in cipher, dividing into two equally long groups and then stack it like sandwich. Sandwich -> Kamasutra, your imagination will know what to do with it. 🙂 First puzzle are coding only English alphabet letters. We are not validating anything, because every shuffling is unique.

```library(tidyverse)

input = read_excel("Excel/382 Kamasutra Cipher.xlsx", range = "A1:A10")```

#### Transformation

```generate_code = function() {
shuffled_alph = sample(letters)
sh_p1 = shuffled_alph[1:(length(shuffled_alph)/2)]
sh_p2 = shuffled_alph[(length(shuffled_alph)/2 + 1):length(shuffled_alph)]
sh_p1 = setNames(sh_p1, sh_p2)
sh_p2 = setNames(sh_p2, sh_p1)
code = c(sh_p1, sh_p2)
return(code)
}

code = function(string){
code = generate_code()
string = tolower(string)
words = str_split(string, " ")[[1]]
chars = map(words, str_split, "") %>%
map(unlist)
coded_chars = map(chars, function(x) code[x])
coded_words = map(coded_chars, paste, collapse = "")
coded_string = paste(coded_words, collapse = " ")
return(coded_string)
}

result = input %>%
mutate(coded = map_chr(`Plain Text`, code))```

### Puzzle #383

In this puzzle we need to extract numbers from given string and divide them into positive and negative numbers. Looks like piece of cake. Let’s check it.

```library(tidyverse)

input = read_excel("Excel/383 Extract Positive and Negative Numbers.xlsx", range = "A2:A10")
test  = read_excel("Excel/383 Extract Positive and Negative Numbers.xlsx", range = "B2:C10")```

#### Transformation

```extract = function(input, sign) {
numbers = input %>%
str_extract_all(paste0(sign, "(\\d+)")) %>%
unlist() %>%
as.numeric() %>%
abs() %>%
unique() %>%
str_c(collapse = ", ")

if (numbers == "") {
numbers = NA_character_
} else {
numbers = numbers
}
}

result = input %>%
mutate(positive = map_chr(Strings, extract, "\\+"),
negative = map_chr(Strings, extract, "\\-")) ```

#### Validation

```identical(result\$positive, test\$`Positive Numbers`)
# [1] TRUE

identical(result\$negative, test\$`Negative Numbers`)
# [1] TRUE```

### Puzzle #384

This puzzle is looking for increasing numbers as well, but different way. We have long numbers and what we need to do is:
- get first digit and,
- check if second digit is greater than first
- if not check if two following are greater (and do it unless we find one)
- if yes slice off first digit and get the number we found above.

It is rather difficult to explain it in simple words. But it is much more difficult to code it. We are using recursive function here.

```library(tidyverse)

input = read_excel("Excel/384 Extract Increasing Numbers.xlsx", range = "A1:A12")
test  = read_excel("Excel/384 Extract Increasing Numbers.xlsx", range = "B1:B12")```

#### Transformation

```recursive_append <- function(n, p = 0, c = 1, a = 0) {
if (p + c > nchar(n)) {
return("")
} else {
v <- as.numeric(substr(n, p + 1, p + c))
if (!is.na(v) && v > a) {
b <- paste(", ", v, recursive_append(n, p + c, 1, v), sep = "")
} else {
b <- recursive_append(n, p, c + 1, a)
}
return(b)
}
}

result = input %>%
rowwise() %>%
mutate(R = substring(recursive_append(as.character(Numbers)), 1)) %>%
mutate(R = str_sub(R, 3, -1))```

#### Validation

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

### Puzzle #385

Matrices again. And job can be divided into two parts: populate first matrix (harder one) and create larger matrix by transforming and binding matrices (much easier one).
First matrix has size 5x5 in which we have first row from 0 to 4 and in others this row is shifted once at the time. Then we need to make matrix with elements bigger by 5 in each cell, and then combine it to matrix given in puzzle.

```library(tidyverse)

test = read_excel("Excel/385 Generate the Grid.xlsx", range = "C3:L12", col_names = FALSE) %>%
as.matrix() %>%
{attr(., "dimnames") <- NULL; .}```

#### Transformation

```generate = function(n){
grid_df <- expand.grid(i = 1:n, j = 1:n) %>%
mutate(value = (i + j - 2) %% n) %>%
pull(value)

matrix(grid_df, nrow = n, ncol = n)
}

a = generate(5)

b = a + 5

c = cbind(a,b)
d = cbind(b,a)

result = rbind(c,d) %>% {attr(., "dimnames") <- NULL; .}```

#### Validation

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

### Puzzle #386

Today we have to extract all numbers that are comfortly hugged by parentheses from both sides. Numbers that has parenthesis only from one side are not important this time. Let’s find them.

```library(tidyverse)

input = read_excel("Excel/386 Extract Numbers in Parentheses.xlsx", range = "A1:A10")
test  = read_excel("Excel/386 Extract Numbers in Parentheses.xlsx", range = "B1:B10")```

#### Transformation

```extract = function(x) {
x = str_extract_all(x, "\\((\\d+)\\)") %>%
unlist() %>%
str_remove_all("\\D") %>%
str_c(collapse = ", ")
if (x == "") x = NA_character_
return(x)
}

result = input %>%
rowwise() %>%
mutate(result = map_chr(String, extract))```

#### Validation

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

### Puzzle #387

Now we have to construct some weird kind of calendar. Basing on given date we have to make month chart that has weekdays in normal order but weeks upside down so first days of month are at the bottom of months and last ones at the top.
Weird but not impossible. Let’s do it.

```library(tidyverse)

test = read_excel("Excel/387 Fill in the Last Dates.xlsx", range = "B1:H6") %>%
mutate(across(everything(), as.Date))

date = read_excel("Excel/387 Fill in the Last Dates.xlsx", range = "A1", col_names = FALSE) %>%
pull()```

#### Transformation

```df = data.frame(date = seq(floor_date(date, "month"),
ceiling_date(date, "month") - days(1),
by = "day") %>%
as.Date()) %>%
mutate(week = week(date),
wday = wday(date, label = T, abbr = T,  week_start = 1, locale = "US_us")) %>%
pivot_wider(names_from = wday, values_from = date) %>%
select(week, Mon, Tue, Wed, Thu, Fri, Sat, Sun) %>%
arrange(desc(week)) %>%
select(-week)```

#### Validation

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

### Puzzle #388

And as I said before second puzzle about Kamasutra Cipher comes here. This time not only letters, but also digits come to game.

```library(tidyverse)

input = read_excel("Excel/388 Kamasutra Cipher_2.xlsx", range = "A1:A10")```

#### Transformation

```generate_code = function() {
shuffled_alph = sample(letters)
sh_p1 = shuffled_alph[1:(length(shuffled_alph)/2)]
sh_p2 = shuffled_alph[(length(shuffled_alph)/2 + 1):length(shuffled_alph)]
sh_p1 = setNames(sh_p1, sh_p2)
sh_p2 = setNames(sh_p2, sh_p1)
code = c(sh_p1, sh_p2)

shuffled_digits = sample(0:9)
sh_d1 = shuffled_digits[1:(length(shuffled_digits)/2)]
sh_d2 = shuffled_digits[(length(shuffled_digits)/2 + 1):length(shuffled_digits)]
sh_d1 = setNames(sh_d1, sh_d2)
sh_d2 = setNames(sh_d2, sh_d1)
code = c(code, sh_d1, sh_d2)
return(code)
}

code = function(string){
code = generate_code()
string = tolower(string)
words = str_split(string, " ")[[1]]
chars = map(words, str_split, "") %>%
map(unlist)
coded_chars = map(chars, function(x) code[x])
coded_words = map(coded_chars, paste, collapse = "")
coded_string = paste(coded_words, collapse = " ")
return(coded_string)
}

result = input %>%
mutate(coded = map_chr(`Plain Text`, code))```

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.