MPMP: Take-Away Triangles

It finally happened! In this weeks Matt Parker’s Maths Puzzles (MPMP), the challenge proposed was finally something I had a quick idea for on how to solve it in R.

If you’re unfamiliar with the MPMP series, or specificially the current challenge (posted on June 24th), here’s the video with the puzzle which I won’t embed because tracking and stuff.

The puzzle submission page with some extra info is located here if you want to give it a go, but I’ll restate the goal here:

Puzzle for Submission: The puzzle this week is to find three starting numbers for a take-away triangle so that eventually each set of the three new numbers generated always adds to 14.

Well then, time to do some takeaways.

For reproducibility (and since I intend to submit this as “extra working out”), here’s the packages I used:

1
2
3
4
5
6
7
8
9

library(purrr)
library(dplyr)
library(tidyr)
library(kableExtra)
library(ggplot2)
library(hrbrthemes)
theme_set(theme_ft_rc())

plot_caption <- glue::glue("@jemus42 // {Sys.Date()}")

takeaway(): The Basic Building Block

First up I’ll define a function to do “one round” of takeaway on a set of 3 numbers, e.g. \(X = \{4, 8, 12\}\). I’ll use the first digit as the left corner, the right digit as the right corner, and the middle digit as the centered corner of the triangles (it makes sense if you’ve watched the video I swear), and using R’s vectorization this is fairly easy to implement:

1
2
3
4
5
6
7
8
9

takeaway <- function(x) {
  # New set = [1st minus 2nd; 1st minus 3rd; 2nd minus 3rd]
  # Also making the results positive integers again
  abs(x[c(1, 1, 2)] - x[c(2, 3, 3)])
}

# Demo:
x <- c(5, 8, 12)
takeaway(x)

1

#> [1] 3 7 4

This should implement the following operation:

I’m not too sure about the notation, but I think if I put it like this should be a roughly correct way to formalize the operation:

\begin{align} \operatorname{takeaway}: \mathbb{N}^3 &\to \mathbb{N}^3 \\ \{a,b,c\} &\mapsto \{|a-b|, |a-c|, |b-c|\} \\ \end{align}

…I can’t tell if that’s helping.

Anyway, now I have a function to do “one step”. The next step (heh) is to iteratively do the take-aways for a set number of steps (I chose 50 here) while also starting off with a random set of integers between 1 and 100 (arbitrarily enough).
It turns out this is one of the few cases where you need (I think) a for loop in R, because you need the \(n\)th result to calculate the \(n+1\)th result — but if anyone manages a more functional-progamming-y solution via purrr::map, I’d be curious to see it.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18

takeway_run <- function(steps = 50, max_num = 100) {
  xls <- vector("list", steps)
  
  # 3 random integers between 1 and max_num, with replacement
  xls[[1]] <- sample.int(max_num, size = 3, replace = TRUE)

  # calculate the next step and put it in the next place in the list
  for (i in seq_len(steps)) {
    xls[[i + 1]] <- takeaway(xls[[i]])
  }
  
  # Make it tibbly, add the sum as a column
  tibble::enframe(xls, name = "step", value = "numbers") %>%
    mutate(sum = map_int(numbers, sum))
}

# Looks like this:
takeway_run(10)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

#> # A tibble: 11 × 3
#>     step numbers     sum
#>    <int> <list>    <int>
#>  1     1 <int [3]>   183
#>  2     2 <int [3]>   134
#>  3     3 <int [3]>    82
#>  4     4 <int [3]>    52
#>  5     5 <int [3]>    30
#>  6     6 <int [3]>    22
#>  7     7 <int [3]>    14
#>  8     8 <int [3]>     8
#>  9     9 <int [3]>     6
#> 10    10 <int [3]>     4
#> 11    11 <int [3]>     2

Note that the numbers column is actually a list column containing a vector with the numbers at that step. I could have pasted them together as a string after I got their sum, but oh well — I’ll do that later.

Doing Things A Lot

Now that we have a function to generate a random run of 50 steps, we’ll do the classic “computer fast brain slow” approach of “just simulating a bunch” by generating 100 successive runs, each with random starting numbers:

1
2
3
4
5
6

# For reproducibility
set.seed(11235813)
runs <- purrr::map_df(1:100, ~{
  takeway_run(steps = 50) %>%
    mutate(run_id = .x)
})

Let’s take a quick look:

1

runs

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

#> # A tibble: 5,100 × 4
#>     step numbers     sum run_id
#>    <int> <list>    <int>  <int>
#>  1     1 <int [3]>   153      1
#>  2     2 <int [3]>   128      1
#>  3     3 <int [3]>    64      1
#>  4     4 <int [3]>    64      1
#>  5     5 <int [3]>    64      1
#>  6     6 <int [3]>    64      1
#>  7     7 <int [3]>    64      1
#>  8     8 <int [3]>    64      1
#>  9     9 <int [3]>    64      1
#> 10    10 <int [3]>    64      1
#> # … with 5,090 more rows

Well the first run there did not end up with a sequence of 14’s, but oh well, there’s more to examine.
I fiddled around a bit when I tried to find a reliable solution to identify “winning” runs, i.e. those that ended up with 14’s repeating, but I settled for this condition:

• If the last couple steps (i.e. starting at step 45) are all equal to 14, then it’s a winner.

…writing it down it really does not seem terribly hard to come up with, but putting it in code took me a minute, thankfully good old all() is around. So, we check each run for this condition, filter the runs that meet this condition, and then extract the run_id, the numeric identifier I gave to each run earlier.

1
2
3
4
5
6
7
8
9

# Get the run_id with winning condition
winning_runs <- runs %>%
  filter(step >= 45) %>%
  group_by(run_id) %>%
  summarize(ok = all(sum == 14), .groups = "drop") %>%
  filter(ok) %>%
  pull(run_id)

winning_runs

1

#> [1] 65 70 95

Well then, what where the starting numbers? Did they sum to 14? That would disqualify them.

1
2
3
4
5
6

runs %>%
  filter(run_id %in% winning_runs, step == 1) %>%
  mutate(numbers = map_chr(numbers, ~paste(.x, collapse = " + "))) %>%
  select(numbers, sum) %>%
  unite(col = winners, numbers, sum, sep = " = ") %>%
  kable()

Neato, 3 winning runs and each of them qualify. So here’s 3 perfectly fine submission for you, for free ¹.

Bonus Plot

I also couldn’t resist to plot all the runs by their number’s sums at each step, highlighting the 3 winners:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

runs %>%
  ggplot(aes(x = step, y = sum, group = run_id)) +
  geom_step(aes(color = "sadface"), alpha = 1/3) +
  geom_step(
    data = runs %>% filter(run_id %in% winning_runs),
    aes(color = "Yes!"),
    alpha = 1, size = 1
  ) +
  scale_color_manual(values = c("Yes!" = "#EA212D", "sadface" = "#999999")) +
  labs(
    title = "MPMP: Take-Away Triangles",
    subtitle = "Playing 100 games at 50 steps each with random starting numbers and recording the sum",
    x = "Step (1 = Starting numbers)", y = "Sum of the 3 numbers",
    color = "Does it end at 14 repeating?", captioon = plot_caption
  ) +
    theme(legend.position = "top")

And I think that’s about it?
I’m tempted to try the same approach but with large starting numbers and more steps, but I’ll play around with that later for procrastinative reasons.