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.