Puzzles no. 409–413

Puzzles

Author: ExcelBI

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

Puzzle #409

This puzzle is like splitting rock. Sometimes tables in Excel and other documents have merged cells or headers. It is not really comfortable for R, because we love clear tabular view the most. But nature of readxl package is useful for us. If we have merged row headers (like one header for multiple rows, we get first row with value, and the rest with NA’s. And that is easy to fix. Let’s do it.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/409 Table_Regular.xlsx", range = "A1:E12")
test  = read_excel("Excel/409 Table_Regular.xlsx", range = "G1:K29")

Transformation

result = input %>%
  fill(c(1,5), .direction = "down") %>%
  mutate(Items = str_split(Items, ", ")) %>%
  unnest_longer(Items)

Validation

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

Puzzle #410

Today’s puzzle is not really hard. We already had both elements of the story in our journey. We had converting to Roman Numerals and detecting palindromes. Let’s mix it together to find palindromic Roman Numerals.

Loading libraries and data

library(tidyverse)
library(readxl)
library(stringi)

input = read_excel("Excel/410 Palindromic Roman Numerals.xlsx", range = "A2:A10")
test  = read_excel("Excel/410 Palindromic Roman Numerals.xlsx", range = "B2:C5")

Transformation

to_roman <- function(number) {
  if (!is.numeric(number) || number <= 0 || number != as.integer(number)) {
    return(NA)
  }
  
  roman_symbols <- c("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")
  arabic_values <- c(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
  
  numeral <- ""
  for (i in seq_along(roman_symbols)) {
    while (number >= arabic_values[i]) {
      numeral <- paste0(numeral, roman_symbols[i])
      number <- number - arabic_values[i]
    }
  }
  
  return(numeral)
}

is_palindrome = function(string) {
  string == stri_reverse(string)
}

result = input %>%
  mutate(roman = map_chr(`Decimal Number`, to_roman)) %>%
  mutate(palindrome = map_lgl(roman, is_palindrome)) %>%
  filter(palindrome) %>%
  select(`Decimal Number`, `Roman Number` = roman)

Validation

identical(result, test)
# [1] TRUE

Puzzle #411

We already splitted text on many ocassions, but today we have one twist. We need to cut sentence on spaces, but… except of spaces that are quoted. It complicate case a little, but not extremely.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/411 Split String at other than Space.xlsx", range = "A1:A10")
test  = read_excel("Excel/411 Split String at other than Space.xlsx", range = "B1:E10") %>%
  set_names(c("1", "2", "3", "4"))

Transformation

extract = function(input) {
  
pattern = "([^\\s\"]+|\"[^\"]*\")"
  
input %>% 
    str_extract_all(pattern) %>% 
    unlist() %>%
    tibble(string = .)  
}

result = input %>%
  mutate(extracted = map(Sentences, extract)) %>%
  unnest_longer(extracted) %>%
  group_by(Sentences) %>%
  mutate(row = row_number()) %>%
  pivot_wider(names_from = row, values_from = extracted) %>%
  ungroup() %>%
  select(-Sentences) %>%
  as.matrix() %>%
  as.data.frame() %>%
  mutate(across(everything(), ~str_remove_all(., "\"")))

Puzzle #412

On image we see some kind of cyclic transformation and that what we are doing in this puzzle. For each inputed number we have to make cycle of: squaring digits separately and sum it up, then the same for result and so on until we reach only one digit. Pretty nice task, but one input produced wrong result at the beginning, single digit input. To wrangle this edge case I added a portion of code, causing that if we get single digit input we have to square it before moving a loop.
Let’s get into.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/412 Square Sum Iterate till a Single Digit .xlsx", range = "A2:A11")
test  = read_excel("Excel/412 Square Sum Iterate till a Single Digit .xlsx", range = "B2:C11")

Transformation

sum_square <- function(x) {
  iter <- 0
  
  if (nchar(x) == 1) {
    y <- x^2
    iter <- iter + 1
  } else {
    y <- x
  }
  
  while (nchar(y) > 1) {
    digits <- as.numeric(strsplit(as.character(y), "")[[1]])
    y <- sum(digits^2)
    iter <- iter + 1
  }
  return(c(iter, y))
}

result = input %>%
  mutate( r = map(Number, sum_square), 
          FSD = map_dbl(r, 2),
          Iterations = map_dbl(r, 1)) %>%
  select(-c(r, Number))

Validation

all.equal(result, test, check.attributes = FALSE, ignore.names = TRUE)
# [1] TRUE

Puzzle #413

Pivoting in R is little bit tricky, but also really pleasant thing to do. At least for me. And this puzzle was like walk in the park after hard week. Pivot it.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/413 Pivot.xlsx", range = "A1:B15")
test  = read_excel("Excel/413 Pivot.xlsx", range = "D1:I5")

Transformation

result = input %>%
  group_by(ID) %>%
  mutate(rn = row_number()) %>%
  pivot_wider(names_from = rn, names_prefix = "Num ", values_from = Num) %>%
  ungroup() %>%
  arrange(ID)

Validation

identical(result, 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.

Puzzles no. 409–413 was originally published in Numbers around us on Medium, where people are continuing the conversation by highlighting and responding to this story.