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.

Loading libraries and data

library(tidyverse)
library(readxl)

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 %>%
  mutate(`Answer Expected` = map_chr(Numbers, ~process_string(.x)))

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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 %>% 
  mutate(short = map_chr(`IPv6 Addresses`, shorten_ipv6))

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load data and libraries

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.

Load libraries and data

library(tidyverse)
library(readxl)

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.