R Solution for Excel Puzzles

Puzzles no. 394–398

Puzzles

Author: ExcelBI

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

Puzzle #394

As you probably already noticed challenges with palindromes are pretty common here. But usually each one of those riddles has some twist and it is like that today. We need to generate first 15 numbers in which cases not only those numbers, but also their squares are palindrome. Make sure that you are not counting single digit numbers as palindrome. Lets check it now.

Loading libraries and data

library(tidyverse)
library(readxl)

test = read_excel("Excel/394 - First 15 Super Palindrome Numbers.xlsx", range = "A1:A16")

Transformation

is_palindrome = function(x) {
  x = as.character(x)
  x == str_c(rev(str_split(x, "")[[1]]), collapse = "")
}

result = tibble(palindrome = keep(10:1e5, is_palindrome)) %>%
  mutate(square = palindrome^2,
         is_palindrome = map_lgl(square, is_palindrome)) %>%
  filter(is_palindrome) %>%
  slice(1:15) %>%
  select(square)

Puzzle #395

Although our image presents 2D multiline, our task today is little bit less complex. We have coordinates of points and we need to check if they are connected. If you would think one more moment, point cannot be connected if they are not having exactly the same coordinates. I think better for visualization would be traveling along ruler or measuring tape. And coordinates then would be ends of segment. So they are connected if next segment starts in place where previous one just ended. Let’s try this.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/395 Connected Points.xlsx", range = "A1:D8")
test  = read_excel("Excel/395 Connected Points.xlsx", range = "E1:E8")

Transformation

result = input %>%
  mutate(figure = row_number()) %>%
  pivot_longer(-figure, names_to = "Coord", values_to = "value") %>%
  separate(value, into = c("x", "y"), sep = ", ") %>%
  group_by(figure) %>%
  mutate(is_connected = ifelse(x == lag(y), "Yes", "No")) %>%
  na.omit(is_connected) %>%
  summarise(`Answer Expected` = ifelse(all(is_connected == "Yes"), "Yes", "No")) %>%
  select(-figure) %>%
  ungroup()

Validation

identical(result, test)
# [1] TRUE

Puzzle #396

Sometimes we need to check how number’s digits behave. If they are ascending or descending in order and many other properties. Now we have to check how many times left hand digits is bigger than right hand. It mean not only checking digits one after another but also those much earlier in number. And today we are doing it with old good loops.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/396 Count Inversions.xlsx", range = "A1:A10")
test  = read_excel("Excel/396 Count Inversions.xlsx", range = "B1:B10")

Tranformation

check_inversions = function(x) {
  x = as.character(x)
  inversions = 0
  
  for (i in 1:(nchar(x) - 1)) {
    for (j in (i + 1):nchar(x)) {
      if (as.numeric(substr(x, i, i)) > as.numeric(substr(x, j, j))) {
        inversions = inversions + 1
      }
    }
  }
  return(inversions)
}

result = input %>%
  mutate(inversions = map_dbl(String, check_inversions))

Validation

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

Puzzle #397

We have 26 numbers in English alphabet and we need you to give them place in structure that gives them 3 numeral coordinates. My first thought “Rubik’s Cube”. But they have 27 positions. That’s why I added 0 at the end of alphabet. Looks weird, but helps with preparing keycode.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/397 Tri Numeral Alphabets Cipher.xlsx", range = "A1:A10")
test  = read_excel("Excel/397 Tri Numeral Alphabets Cipher.xlsx", range = "B1:B10")

Transformation

ext_letters = c(letters, 0) %>%
  data.frame(chars = .) %>%
  mutate(gr1 = floor((row_number() - 1) %/% 9) + 1) %>%
  group_by(gr1) %>%
  mutate(gr2_rn = row_number(),
         gr2 = floor((gr2_rn - 1) %/% 3) + 1) %>%
  ungroup() %>%
  group_by(gr1, gr2) %>%
  mutate(gr3 = row_number()) %>%
  select(-gr2_rn) %>%
  unite("code",2:4, sep = "")
  
  
process = function(string) {
  chars = str_split(string, "")[[1]] %>%
    data.frame(chars = .)  %>%
    left_join(ext_letters, by = c("chars" = "chars")) %>%
    pull(code) %>%
    paste0(collapse = "")
  return(chars)
}

result = input %>%
  mutate(`Answer Expected` = map_chr(`Plain Text`, process))

Validation

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

Puzzle #398

Today we have some dates magic. We have simple column with dates noted. And the next step we want is to keep find minimal and maximal available date from column for each year and month combination. Adding, rounding, joining… some of each.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/398 Min and Max Dates.xlsx", range = "A1:A25") %>% 
  mutate(Date = as.Date(Date))
test  = read_excel("Excel/398 Min and Max Dates.xlsx", range = "C2:F16") %>%
  mutate(`Min Date` = as.Date(`Min Date`), 
         `Max Date` = as.Date(`Max Date`))

Transformation

seq = seq.Date(from = floor_date(min(input$Date), "month"), 
               to = floor_date(max(input$Date), "month")+1, 
               by = "month") %>%
  data.frame(date = .) %>%
  mutate(month = month(date), 
         year = year(date))

res = input %>%
  mutate(month = month(Date), 
         year = year(Date)) %>%
  left_join(seq, by = c("year", "month")) %>%
  group_by(date, month, year) %>%
  summarise(min = min(Date), 
            max = max(Date)) %>%
  ungroup() %>%
  select(Year = year, Month = month, `Min Date` = min, `Max Date` = max)

Validation

identical(res, test)
# [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.