R Solution for Excel Puzzles

[This article was first published on Numbers around us - Medium, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Puzzles no. 349–353

Puzzles

Author: ExcelBI

Puzzles:
#349: content file
#350: content file
#351: content file
#352: content file
#353: content file

Let dig in those numbers.

Puzzle #349

In this puzzle we have to translate “normal” (Arabic) numbers into Roman numerals. With one twist… Historically roman numerals has its limit (3899 if I recall properly), and we have some bigger numbers, so M (thousands) would be un-naturally repeated. Lets do it.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Numbers to Roman.xlsx", range = "A1:A10")
test = read_excel("Numbers to Roman.xlsx", range = "B1:B10")

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)
}

result = input %>%
 mutate(Roman = map_chr(Number, to_roman))

Validation

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

Puzzle #350

Today we have insolite numbers. Wait what? What kind of number our host dug up from voids of maths? Insolite numbers are such numbers that are divisible by both sum of squares of digits and product of squares of digits. Just another interesting property of number. Can we extract them from given column? Why not.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Insolite Number.xlsx", range = "A1:A10") %>% janitor::clean_names()
test = read_excel("Insolite Number.xlsx", range = "B1:B6") %>% janitor::clean_names()

Transformation

is_insolite = function(number) {
 digits = strsplit(as.character(number), "")[[1]]
 digits = as.numeric(digits)
 
 sum_of_squares = sum(digits^2)
 product_of_squares = prod(digits^2) 
 
 div_by_sum = number %% sum_of_squares == 0
 div_by_prod = number %% product_of_squares == 0
 
 return(div_by_sum & div_by_prod)
}

result = input %>%
 mutate(answer_expected = map(numbers, is_insolite)) %>%
 filter(answer_expected == TRUE) %>%
 select(numbers)

Verification

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

Puzzle #351

Mixing words again, but not all. What we have to do is mix or rather change order of words into reverse one in part of sentence. We get two numbers that point to start and end of reversed section. Results looks little bit like Yoda’s talks.

Load libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Reverse Words between Positions.xlsx", range = "A1:C9")
test  = read_excel("Reverse Words between Positions.xlsx", range = "D1:D9")

Transform

reverse_words <- function(text, start_pos, end_pos) {
  words <- str_split(text, " ")[[1]]
  words[start_pos:end_pos] <- rev(words[start_pos:end_pos])
  words <- words[!is.na(words)]
  paste(words, collapse = " ")
}

result = input %>% 
  mutate(reversed = pmap_chr(list(text = Sentence, 
                                  start_pos = `Word No1`, 
                                  end_pos = `Word No2`), reverse_words)) %>%
  select(reversed)

Validation

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

Puzzle #352

There are more numbers with interesting properties and today we have interprimes. How do we describe them? Numbers that are equally distant from neighbouring primes or if it will be easier to understand, this number is a mean of two consecutive primes

I’ve done this two ways: one with dedicated function, one more in base R syntax involved.

Load libraries and data

library(tidyverse)
library(readxl)
library(numbers)

input = read_excel("Excel/352 Interprime Numbers.xlsx", range = "A1:A10") %>% janitor::clean_names()
test  = read_excel("Excel/352 Interprime Numbers.xlsx", range = "B1:B6") %>% janitor::clean_names()

Transformation

# Version using ready numbers package functions
is_interprime <- function(n) {
  if (!is.integer(n)) {return(FALSE)}
  prev_prime <- previousPrime(n)
  next_prime <- nextPrime(n)
  return(n == (prev_prime + next_prime) / 2)
}

# version with own functions (we are gonna use only is_prime from numbers package)  
next_prime = function(n) {
  repeat {
    n = n + 1
    if (isPrime(n)) {return(n)}
  }
}
previous_prime = function(n) {
  while (n > 2) {
    n = n - 1
    if (isPrime(n)) {return(n)}
  }
}
is_interprime_2 <- function(n) {
  if (!is.integer(n)) {return(FALSE)}
  prev_prime <- previous_prime(n)
  next_prime <- next_prime(n)

  return(n == (prev_prime + next_prime) / 2)
}

result = input %>%
  mutate(number = as.integer(number)) %>%
  mutate(is_interprime = map_lgl(number, is_interprime),
         is_interprime_2 = map_lgl(number, is_interprime_2)) %>%
  filter(is_interprime) %>%
  bind_cols(test)

Validation

identical(as.numeric(result$number), result$answer_expected)
#> [1] TRUE

Puzzle #353

We lost some letters, and there are some holes in it. We have to find what letters are missing in every sequence and give only missing ones.

Try it.

Loading library and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/353 Missing Letters.xlsx", range = "A1:A10")
test  = read_excel("Excel/353 Missing Letters.xlsx", range = "B1:B10")

Transformation

result = input %>%
  mutate(let = strsplit(Letters, ", ")) %>%
  mutate(let = map(let, sort)) %>%
  mutate(min = map(let, min),
         max = map(let, max),
         min_index = map_int(min, ~ which(letters == .x)),
         max_index = map_int(max, ~ which(letters == .x)), 
         seq = map2(min_index, max_index, ~ letters[.x:.y]),
         diff = map2(seq, let, ~ setdiff(.x, .y)),
         answer = map_chr(diff, ~ paste(.x, collapse = ", "))
         ) %>%
  select(Letters, answer) %>%
  mutate(answer = ifelse(answer == "", NA, answer))

Validation

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

Feel free to comment, share and contact me with advices, questions and your ideas how to improve anything.


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.

To leave a comment for the author, please follow the link and comment on their blog: Numbers around us - Medium.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)