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.

Loading libraries and data

library(tidyverse)
library(readxl)
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 %>%
  mutate(`Answer Expected` = map_chr(`Words`, find_palindromes))

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.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/375 Students Grades.xlsx", range = "A1:A20")
test  = read_excel("Excel/375 Students Grades.xlsx", range = "B1:B20")

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 %>%
  mutate(grade = map(Marks, calculate_grade) %>% unlist())

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.

Loading libraries and data

library(tidyverse)
library(readxl)

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

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.

Loading libraries and data

library(tidyverse)
library(readxl)

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.

Loading libraries and data

library(tidyverse)
library(readxl)

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.