# 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.