Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Puzzles no. 529–533
Puzzles
Author: ExcelBI
All files (xlsx with puzzle and R with solution) for each and every puzzle are available on my Github. Enjoy.
Puzzle #529
Today we need to look for some numbers and sum it up. So what is the problem? We have numbers without signs, but also some with minuses and pluses both before number and after it. So we need to make some conditional assumptions. Check it out.
Loading libraries and data
library(tidyverse) library(readxl) path = "Excel/529 Sum with Signs.xlsx" input = read_excel(path, range = "A1:A10") test = read_excel(path, range = "B1:B10")
Transformation
pattern <- "(?<=\\D)[+-]?\\d+[+-]?" result = input %>% mutate(numbers = str_extract_all(Strings, pattern)) %>% mutate(adj_num = map_dbl(numbers, ~sum(as.numeric(str_replace_all(.x, "[+-]", "")) * ifelse(str_detect(.x, "-"), -1, 1)), na.rm = TRUE))
Validation
identical(result$adj_num, test$`Answer Expected`) #> [1] TRUE
Puzzle #530
Money again… We need to summarise amount earned by each person, but emphasize only days and amounts that was maximal per person. So lets do some fast pivoting and summarizing.
Loading libraries and data
library(tidyverse) library(readxl) path = "Excel/530 Dates for Max Sales.xlsx" input = read_excel(path, range = "A2:I11") test = read_excel(path, range = "J2:K11")
Transformation
result <- input %>% pivot_longer(cols = -Name, names_to = c(".value", ".type"), names_pattern = "(Date|Amount)(.*)") %>% fill(Date, .direction = "down") %>% fill(Amount, .direction = "up") %>% select(-c(2)) %>% distinct() %>% group_by(Name) %>% filter(Amount == max(Amount)) %>% summarise(Date = paste(Date, collapse = ", "), Amount = first(Amount)) %>% ungroup()
Puzzle #531
Number mixing in progress. We need to find first 500 numbers that have following properties. They can not be divisible by 10, it have to be divisible by number created by removing one digit from number. We also have to list those dividers. It is very hard calculation to do and very time consuming process. I don’t like if my code is running slow, so I tried to optimize it. And that’s why I post here both solutions.
Loading libraries and data
library(charcuterie) library(tidyverse) library(readxl) path = "Excel/531 Numbers Divisible after Removing a Digit.xlsx" test = read_excel(path, range = "A2:B502")
Transformation v1 — slow
transform_number <- function(number) { num_str <- as.character(number) num_split <- chars(num_str) len <- length(num_split) result <- character(len) for (i in seq_along(num_split)) { result[i] <- paste0(num_split[-i], collapse = "") } result <- paste(result, collapse = ", ") return(result) } transform_number <- Vectorize(transform_number) numbers <- data.frame(number = 101:1000000) %>% filter(number %% 10 != 0) n1 = numbers %>% mutate(new_number = map_chr(number, transform_number)) %>% separate_rows(new_number, sep = ", ") %>% distinct() %>% mutate(new_number = as.numeric(new_number)) %>% filter(number %% new_number == 0, new_number != 1) %>% summarise(divisors = paste(new_number, collapse = ", "), .by = "number") %>% head(500)
Transformation v2 — faster
find_divisors = function(n) { digits = strsplit(as.character(n), NULL)[[1]] divisors = integer(0) for (i in seq_along(digits)) { reduced_number = as.integer(paste0(digits[-i], collapse = "")) if (reduced_number > 1 && n %% reduced_number == 0) { divisors = c(divisors, reduced_number) } } return(divisors) } find_numbers = function(count = 500, start = 101) { result = list() number = start while (length(result) < count) { if (number %% 10 != 0) { divisors = find_divisors(number) if (length(divisors) > 0) { result[[as.character(number)]] = divisors } } number = number + 1 } return(result) } numbers_with_divisors = find_numbers() numbers_with_divisors = map(numbers_with_divisors, unique) df = tibble( Number = names(numbers_with_divisors) %>% as.numeric(), Divisors = I(unname(numbers_with_divisors)) ) %>% mutate(Divisors = map_chr(Divisors, ~ paste(.x, collapse = ", ")))
Validation
all.equal(n1, test, check.attributes = FALSE) #> [1] TRUE identical(df, test) # TRUE
Puzzle #532
If you think cummulating numbers what do you see in your mind? Sometimes I think about Ebenezer Scrooge stacking coins. And numbers provided in table looks alike as well. We have matrix that starts with one number: 1 in left top corner, and we need to step further always writing down sum of all available at this moment surrounding numbers. And they are cummulates very fast. Let’s do it.
Loading libraries and data
library(tidyverse) library(readxl) path = "Excel/532 Grid where each is sum of already filled in surrounding cells.xlsx" test = read_excel(path, range = "B2:K11", col_names = FALSE) %>% as.matrix()
Transformation
matrix_size <- 10 m <- matrix(0, nrow = matrix_size, ncol = matrix_size) m[1, 1] <- 1 for (i in 1:matrix_size) { for (j in 1:matrix_size) { if (i != 1 || j != 1) { m[i, j] <- sum(m[pmax(i - 1, 1):pmin(i + 1, matrix_size), pmax(j - 1, 1):pmin(j + 1, matrix_size)]) } } }
Validation
all.equal(m, test, check.attributes = FALSE) # TRUE
Puzzle #533
And again we are drawing, this time some stars. We are suppose to draw eight-arm star with odd number of length of arm. And as you already guessed, if we need to make some graphic, I will probably use matrix. And you are right.
Loading libraries and data
library(tidyverse) library(readxl) path = "Excel/533 ASCII Star.xlsx" test5 = read_excel(path, range = "F3:J7", col_names = FALSE) test7 = read_excel(path, range = "E9:K15", col_names = FALSE) test9 = read_excel(path, range = "D17:L25", col_names = FALSE) test11 = read_excel(path, range = "C27:M37", col_names = FALSE)
Transformation
draw_ascii_star = function(number) { matrix = matrix(NA, nrow = number, ncol = number) for (i in 1:number) { matrix[i, number %/% 2 + 1] = "*" matrix[number %/% 2 + 1, i] = "*" matrix[i, i] = "*" matrix[i, number - i + 1] = "*" } result = as.data.frame(matrix) colnames(result) = NULL rownames(result) = NULL return(result) }
Validation
a5 = draw_ascii_star(5) all.equal(a5, test5, check.attributes = FALSE) # TRUE a7 = draw_ascii_star(7) all.equal(a7, test7, check.attributes = FALSE) # TRUE a9 = draw_ascii_star(9) all.equal(a9, test9, check.attributes = FALSE) # TRUE a11 = draw_ascii_star(11) all.equal(a11, test11, check.attributes = FALSE) # 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.
On my Github repo there are also solutions for the same puzzles in Python. Check it out!
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.