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.
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.