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. 444–448

Puzzles

Author: ExcelBI

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

Puzzle #444

This time we were spelling numbers. Yes, you heard it right. We were taking multidigit number, spell it one by one, counting how many of them were present in digit. Like: there are two ones, one three and so on. Of course after we wrote it back exactly like above and that activity four times per number. I don’t know if it has any real-life equivalent, but it is surely great challenge.

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/443 Look and Say Sequence.xlsx", range = "A1:A10")
test  = read_excel("Excel/443 Look and Say Sequence.xlsx", range = "B1:B10")

Transfromation

generate_next = function(number) {
  number_str = as.character(number)
  digits = str_split(number_str, "")[[1]]
  
  unique_digits = unique(digits)
  
  result = map_chr(unique_digits, function(digit) {
    count = sum(digits == digit)
    paste0(count, digit)
  }) %>% paste0(collapse = "")
  
  as.numeric(result)
}

generate_sequence = function(start_digit, iter = 4) {
  result = start_digit
  
  for (i in 1:iter) {
    next_number = generate_next(result[length(result)])
    result = c(result, next_number)
  }
  
  all = result %>%
    setdiff(., start_digit) %>%
    paste0(collapse = ", ")
  
  return(all)
}

result = input %>%
  mutate(`Answer Expected` = map_chr(Numbers, generate_sequence))

Validation

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

Puzzle #445

We’ve already drawn flags, triangles and other objects, but what? Eiffel Tower? I met some problems with doing it exactly like in task, but I did my best. (Excel has nice text centering in cells, while R doesn’t). Let see my tower.

Loading libraries and data

library(tidyverse)
library(gt)

Transformation

df = data.frame(Eiffel = c("|", "/\\", "00",
                           "XX","XX","XX",
                           "XXXX","XXXX","XXXX",
                           "XXXXXXX","XXXXXXX","XXXXXXX",
                           "XXXXXXXXX","XXXXXXXXX","XXXXXXXXX",
                           paste0(strrep("X", 4), strrep("_", 6), strrep("X", 4)),
                           paste0(strrep("X", 4), strrep("_", 8), strrep("X", 4)),
                           strrep("X", 18),
                           paste0(strrep("X", 5), strrep("_", 12), strrep("X", 5)),
                           paste0(strrep("X", 6), strrep("_", 16), strrep("X", 6))
                  ))

df_gt = df %>% 
  gt() %>% 
  cols_align(align = "center") 
df_gt

Puzzle #446

We get crosstable with many airports and distances between them. It is nice version to present it, but we need 3 longest distances from city to city. And do not understand me wrong, not 3 flights, but distances, so if we have a tie, it can be 4 or more flights. Find them…

Loading libraries and data

library(tidyverse)
library(readxl)

input = read_excel("Excel/446 Top 3 Min Distance.xlsx", range = "A1:H8")
test  = read_excel("Excel/446 Top 3 Min Distance.xlsx", range = "J2:M6")

Transformation

result = input %>%
  pivot_longer(-Cities, names_to = "City 2", values_to = "Distance") %>%
  filter(Distance != 0) %>%
  unite("Cities", Cities, `City 2`, sep = " - ") %>%
  mutate(Cities = str_split(Cities, " - ")) %>%
  mutate(Cities = map(Cities, sort)) %>%
  distinct() %>%
  mutate(rank = dense_rank(Distance) %>% as.numeric()) %>%
  filter(rank <= 3) %>%
  arrange(rank) %>%
  mutate(`From City` = map_chr(Cities, ~ .x[1]),
         `To City` = map_chr(Cities, ~ .x[2])) %>%
  select(Rank = rank, `From City`, `To City`, Distance)

Validation

identical(result, test)  
# [1] TRUE

Puzzle #447

Weird, unique, special, nice etc. are one of the easiest and the simplest names for numbers. Today we have to find some more complex numbers called penholodigital. What does it mean?
They are the numbers that consist of all digits except 0’s exactly once, but at the same time are perfect squares, which means that root of the square is integer. Lets find them.

Loading data and libraries

library(gtools)
library(tictoc)
library(tidyverse)
library(readxl)

test = read_excel("Excel/447 Penholodigital Squares.xlsx", range = "A1:A31")
test$`Answer Expected` = as.numeric(test$`Answer Expected`)

Transformation — Approach #1

penholodigital_numbers <- apply(permutations(9, 9, 1:9, set = FALSE), 1, function(x) {
  num <- as.numeric(paste0(x, collapse = ""))
  root <- sqrt(num)
  if (root == floor(root)) num else NA
})
penholodigital_numbers <- na.omit(penholodigital_numbers)
toc() # 3.59 sec


p1 = penholodigital_numbers %>%
  tibble(`Answer Expected` = .)
attributes(p1$`Answer Expected`) <- NULL

Transformation — Approach #2

tic()
penholodigital_numbers2 = permutations(9,9,1:9) %>%
  as_tibble() %>%
  unite(num, V1:V9, sep = "") %>%
  mutate(num = as.numeric(num)) %>%
  filter(sqrt(num) == floor(sqrt(num)))
toc() # 3.3 sec

Validation

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

identical(penholodigital_numbers2$num, test$`Answer Expected`)
# [1] TRUE

Puzzle #448

Do we see pyramids on image? Upside down? Do not worry, we just need to construct upside down triangles filled with mirrored numbers. Easy peasy, I will just juggle one way or another, and it will be easy..

Loading libraries and data

library(tidyverse)
library(readxl)

test2 = read_excel("Excel/448 Draw Inverted Triangle.xlsx", range = "B2:D3", col_names = FALSE) %>%
  as.matrix()
test3 = read_excel("Excel/448 Draw Inverted Triangle.xlsx", range = "B5:F7", col_names = FALSE) %>%
  as.matrix()
test4 = read_excel("Excel/448 Draw Inverted Triangle.xlsx", range = "B9:H12", col_names = FALSE) %>%
  as.matrix()
test7 = read_excel("Excel/448 Draw Inverted Triangle.xlsx", range = "B14:N20", col_names = FALSE) %>%
  as.matrix()

Transformation

create_sequence_matrix <- function(n) {
  total_elements <- n * (n + 1) / 2 
  max_elements_in_row <- n  
  values <- seq(total_elements)
  mat <- matrix(NA, nrow = n, ncol = max_elements_in_row)
  start_index <- 1
  for (i in 1:n) {
    end_index <- start_index + i - 1
    mat[i, 1:i] <- values[start_index:end_index]
    start_index <- end_index + 1
  }
  mat
}

flip_horizontal <- function(mat) {
  mat[, ncol(mat):1, drop = FALSE]
}

flip_vertical <- function(mat) {
  mat[nrow(mat):1, , drop = FALSE]
}

generate_upsidedown_triangle = function(n) {

mat_or = create_sequence_matrix(n)
mat_fh = flip_horizontal(mat_or)
mat_fv1 = flip_vertical(mat_or)
mat_fv2 = flip_vertical(mat_fh)
mat_fv2 <- mat_fv2[, -ncol(mat_fv2)]
mat_fin <- cbind(mat_fv2, mat_fv1)

mat_fin
}

Validation

all.equal(generate_upsidedown_triangle(2), test2, check.attributes = FALSE) # TRUE
all.equal(generate_upsidedown_triangle(3), test3, check.attributes = FALSE) # TRUE
all.equal(generate_upsidedown_triangle(4), test4, check.attributes = FALSE) # TRUE
all.equal(generate_upsidedown_triangle(7), test7, 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.
PS. Couple weeks ago, I started uploading on Github not only R, but also in Python. Come and check it.


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)