# Riddler: Can You Roll The Perfect Bowl?

**Posts | Joshua Cook**, 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.

## FiveThirtyEight’s Riddler Express

At the recent World Indoor Bowls Championships in Great Yarmouth,

England, one of the rolls by Nick Brett went viral. Here it is in all

its glory:

12/10 on the mindblowing scale 🤯

#SCtop10(via

@BBCSport)

pic.twitter.com/6pN6ybzVel— SportsCenter (@SportsCenter)

January

23, 2020

In order for Nick’s green bowl to split the two red bowls, he needed

expert precision in both the speed of the roll and its final angle of

approach.

Suppose you were standing in Nick’s shoes, and you wanted to split two

of your opponent’s bowls. Let’s simplify the math a little, and say

that each bowl is a sphere with a radius of 1. Let’s further suppose

that your opponent’s two red bowls are separated by a distance of 3 —

that is, the centers of the red bowls are separated by a distance of

5. Define phi as the angle between the path your bowl is on and the

line connecting your opponent’s bowls.

For example, here’s how you could split your opponent’s bowls when phi

is 75 degrees:

What is the minimum value of phi that will allow your bowl to split

your opponents’ bowls without hitting them?

## Plan

I will approximate the solution to this puzzle by simulating the game

from many different angles. Thankfully, because the game is vertically

and horizontally symmetric, I only need to simulate the green ball

reaching the middle point between the red balls and only need to see if

it collides with the top red ball.

## Setup

knitr::opts_chunk$set(echo = TRUE, comment = "#>", cache = TRUE) library(glue) library(clisymbols) library(ggforce) library(gganimate) library(tidyverse) theme_set(theme_minimal()) # Some standard colors used throughout green <- "#54c761" red <- "#c75454" purple <- "#a06bdb" light_grey <- "grey70" grey <- "grey40" set.seed(0)

## Simulate a single pass

I split the code into two pieces. The first simulates a bowl with a

given angle, and the second decides on the angle to narrow down the

approximation. The following functions take care of the first part:

simulating a bowl.

A single simulation can be run by calling `run_bowl_simulation()`

with

an angle (in degrees). The function works by changing the hypotenuse,

starting with `h_start = 5`

and decreasing it to 0 by `step_size`

steps

(the steps are held in the numeric vector `h_vals`

). The actual position

of the ball is calculated from the length of the hypotenuse and angle

with a bit of trigonometry in `make_green_ball()`

. For each hypotenuse

value, the green ball is positioned and then tested to see if it

collides with the red ball (set at ((x,y) = (0,2.5)) as per the

riddle) using the function `did_balls_collide()`

. This information is

recorded by building a single data frame with the data for each step of

the simulation. The data frame is returned at the end of the simulation.

# Run a simulation of the bowling game. run_bowl_simulation <- function(angle, step_size = 0.1, red_ball_loc = list(x = 0, y = 2.5)) { h_start <- 5 h_vals <- seq(h_start, 0, by = -step_size) angle <- angle * (pi / 180) all_ball_pos <- NULL for (h in h_vals) { green_ball <- make_green_ball(h, angle) collision <- did_balls_collide(green_ball, red_ball_loc, radius = 1) all_ball_pos <- bind_rows( all_ball_pos, tibble(h = h, x = green_ball$x, y = green_ball$y, collision = collision) ) } return(all_ball_pos) } # Make a green ball location from the x-position and angle. make_green_ball <- function(h, angle) { x <- -1 * h * cos(pi/2 - angle) y <- h * sin(pi/2 - angle) list(x = x, y = y) } # Decide wether the two balls of radius `r` collided. did_balls_collide <- function(ball1, ball2, radius) { d <- sqrt((ball1$x - ball2$x)^2 + (ball1$y - ball2$y)^2) return(d <= 2*radius) }

Below are the results from running the simulation at angles between 90

degrees (horizontal) and 0 degrees (vertical) at 10 degree increments.

Each line is an individual simulation, and each point is a round of the

simulation. A red ball is positioned as per the riddle, and the purple

points indicate where the green ball would collide with the red ball.

These example simulations show that the `run_bowl_simulation()`

function

is working as expected.

map(seq(90, 0, -10), run_bowl_simulation, step_size = 0.1) %>% map2(seq(90, 0, -10), ~ .x %>% add_column(angle = .y)) %>% bind_rows() %>% mutate(collision = ifelse(collision, "collision", "safe")) %>% ggplot() + geom_point(aes(x, y, color = collision), size = 2) + geom_circle(aes(x0 = x0, y0 = y0, r = r), data = tibble(x0 = 0, y0 = 2.5, r = 1), color = red, fill = red, alpha = 0.5) + scale_color_manual(values = c(purple, light_grey)) + coord_fixed() + theme( legend.position = c(0.15, 0.9), legend.title = element_blank() ) + labs(x = "x", y = "y", title = "Example paths of the green ball", subtitle = "For the angles between 0 and 90 at 10 degree intervals.")

## Find the smallest angle

The second part of the code is to find the smallest (narrowest) angle at

which there is no collision. Instead of trying every angle between 90

degrees and 0 degrees at some very small increment, I approach this

problem a bit more efficiently. I built an algorithm than starts at 90

degrees and takes large steps until there is an angle that causes a

collision. It then takes a step back an tries again with a progressively

smaller step, until it no longer collides. This continues with the step

size getting smaller and smaller. The algorithm stops when the step size

is small enough for a good approximation and the angle does not cause a

collision. The code chunk below carries out this process, printing the

information for each pass.

The purpose of the `angle`

and `previous_angle`

parameters are fairly

obvious. The `angle_delta`

parameter is the value by which the angle is

reduced at each step. `epsilon`

is used to reduce `angle_delta`

when

there are collisions at an angle. Finally, `min_angle_delta`

is one of

the stopping criteria: when `angle_delta`

gets below this value, the

algorithm is sufficiently close to the correct answer and it stops

trying new angles. *Thus, this parameter determines the precision of the
algorithm.* It is set relatively high for now, because this first pass

is just a demonstration and prints out the results of each iteration.

For efficiency, the while loop uses a memoised version of

`run_bowl_simulation()`

because when the balls collide, the previous

step is tried again. Therefore, memoising the function saves some time

instead of running the simulation from the same angle multiple times.

# The starting angle. angle <- 90 previous_angle <- angle # The "learning rate" paramerters. angle_delta <- 10 epsilon <- 0.5 min_angle_delta <- 0.01 # Start with TRUE, though it doesn't matter. collision <- TRUE memo_bowl_sim <- memoise::memoise(run_bowl_simulation) while (angle_delta >= min_angle_delta | collision) { # Run the bowling simulation with the current angle. sim_res <- memo_bowl_sim(angle = angle, step_size = 0.1) # Were there any collisions? collision <- any(sim_res$collision) # Print results msg <- "collision: {ifelse(collision, symbol$cross, symbol$tick)}" %>% paste("{collision},") %>% paste("angle: {round(angle, 4)},") %>% paste("angle_delta: {round(angle_delta, 4)}") print(glue(msg)) if (!collision) { # Reduce the angle if there is no collision. previous_angle <- angle angle <- angle - angle_delta } else { # Revert to the previous angle and reduce delta if there is a collision. angle_delta <- epsilon * angle_delta angle <- previous_angle } } #> collision: ✔ FALSE, angle: 90, angle_delta: 10 #> collision: ✔ FALSE, angle: 80, angle_delta: 10 #> collision: ✔ FALSE, angle: 70, angle_delta: 10 #> collision: ✔ FALSE, angle: 60, angle_delta: 10 #> collision: ✖ TRUE, angle: 50, angle_delta: 10 #> collision: ✔ FALSE, angle: 60, angle_delta: 5 #> collision: ✔ FALSE, angle: 55, angle_delta: 5 #> collision: ✖ TRUE, angle: 50, angle_delta: 5 #> collision: ✔ FALSE, angle: 55, angle_delta: 2.5 #> collision: ✖ TRUE, angle: 52.5, angle_delta: 2.5 #> collision: ✔ FALSE, angle: 55, angle_delta: 1.25 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 1.25 #> collision: ✖ TRUE, angle: 52.5, angle_delta: 1.25 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 0.625 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.625 #> collision: ✔ FALSE, angle: 53.75, angle_delta: 0.3125 #> collision: ✔ FALSE, angle: 53.4375, angle_delta: 0.3125 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.3125 #> collision: ✔ FALSE, angle: 53.4375, angle_delta: 0.1562 #> collision: ✔ FALSE, angle: 53.2812, angle_delta: 0.1562 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.1562 #> collision: ✔ FALSE, angle: 53.2812, angle_delta: 0.0781 #> collision: ✔ FALSE, angle: 53.2031, angle_delta: 0.0781 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0781 #> collision: ✔ FALSE, angle: 53.2031, angle_delta: 0.0391 #> collision: ✔ FALSE, angle: 53.1641, angle_delta: 0.0391 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0391 #> collision: ✔ FALSE, angle: 53.1641, angle_delta: 0.0195 #> collision: ✔ FALSE, angle: 53.1445, angle_delta: 0.0195 #> collision: ✖ TRUE, angle: 53.125, angle_delta: 0.0195 #> collision: ✔ FALSE, angle: 53.1445, angle_delta: 0.0098

From the print-out above, we can see how the algorithm jumps back an

forth, narrowing in on a solution around 53 degrees.

With that successful proof-of-concept, the following code runs the

algorithm with a smaller `min_angle_delta = 1e-5`

to achieve greater

precision. Instead of printing out the results of each iteration, the

simulation results and parameters are saved to `sim_results_tracker`

and

`sim_parameters_tracker`

, respectively, and are inspected below.

angle <- 90 previous_angle <- angle angle_delta <- 10 epsilon <- 0.7 min_angle_delta <- 1e-5 collision <- TRUE sim_results_tracker <- tibble() sim_parameters_tracker <- tibble() memo_bowl_sim <- memoise::memoise(run_bowl_simulation) while (angle_delta >= min_angle_delta | collision) { sim_res <- memo_bowl_sim(angle = angle, step_size = 0.01) collision <- any(sim_res$collision) sim_results_tracker <- bind_rows(sim_results_tracker, sim_res %>% add_column(angle = angle)) sim_parameters_tracker <- bind_rows(sim_parameters_tracker, tibble(angle, angle_delta, collision, epsilon)) if (!collision) { previous_angle <- angle angle <- angle - angle_delta } else { angle_delta <- epsilon * angle_delta angle <- previous_angle } }

The simulation took 89 steps. The plot below shows the angle and

`angle_delta`

at each step, colored by whether there was a collision or

not.

sim_parameters_tracker %>% mutate(row_idx = row_number()) %>% pivot_longer(-c(row_idx, epsilon, collision)) %>% ggplot(aes(x = row_idx, y = value)) + facet_wrap(~ name, nrow = 2, scales = "free") + geom_point(aes(color = collision), size = 0.9) + scale_color_manual(values = c(light_grey, purple)) + labs(x = "iteration number", y = "value", title = "Simulation parameters")

The following plot shows each of the paths tried, again, coloring the

locations of collisions in purple.

sim_results_tracker %>% mutate(collision = ifelse(collision, "collision", "safe")) %>% ggplot() + geom_point(aes(x = x, y = y, color = collision), size = 0.1) + scale_color_manual(values = c(collision = purple, safe = light_grey)) + coord_fixed() + theme(legend.position = "none") + labs(x = "x", y = "y", title = "Paths of the green ball", subtitle = "Points marked in purple were collisions with the red ball.")

Finally, we can find the approximated angle by taking the smallest angle

tried in the rounds of simulation that did not have any collisions.

smallest_angle <- sim_parameters_tracker %>% filter(collision == FALSE) %>% top_n(1, wt = -angle) %>% pull(angle) %>% unique()

**The algorithm approximates the solution to be: 53.1301 degrees (0.9273
in radians).**

The simulation with this angle is shown in an animated plot below.

final_result <- sim_results_tracker %>% filter(angle == smallest_angle) %>% mutate(row_idx = row_number()) %>% filter(row_idx == 1) bind_rows( final_result, final_result %>% mutate(x = -1 * x, y = -1 * y) ) %>% mutate(row_idx = row_number()) %>% ggplot() + geom_point(aes(x = x, y = y), color = green, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = 1), fill = green, alpha = 0.2, size = 0) + geom_point(aes(x, y), data = tibble(x = 0, y = 2.5), color = red, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = r), data = tibble(x = 0, y = 2.5, r = 1), fill = red, alpha = 0.2, size = 0) + geom_point(aes(x, y), data = tibble(x = 0, y = -2.5), color = red, size = 2) + geom_circle(aes(x0 = x, y0 = y, r = r), data = tibble(x = 0, y = -2.5, r = 1), fill = red, alpha = 0.2, size = 0) + coord_fixed() + labs( x = "x", y = "y", title = glue( "The tightest angle of the perfect bowl: {round(smallest_angle, 3)} deg." )) + transition_states(row_idx, transition_length = 2, state_length = 0, wrap = FALSE) + ease_aes("sine-in-out")

## Acknowledgements

Repetitive tasks were sped up using the

‘memoise’ package for

memoization. Plotting was accomplished using

‘ggplot2’,

‘ggforce’, and

‘gganimate’.

**leave a comment**for the author, please follow the link and comment on their blog:

**Posts | Joshua Cook**.

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.